Re: [Fortran] Help with STAT= attribute in coarray reference

[Mikael <morin-mikael at orange dot fr>]

Le 20/06/2016 22:01, Alessandro Fanfarillo a Ãcrit :
> Hi Mikael and all,
>
> in attachment the new version of the patch.
> I've addressed all the suggestions except for the stat_se's pre block
> to se's pre block (commented in the patch for caf_get).
> Could you please provide a simple example of a complex case? I've
> already made several test cases and I should be able to produce a
> complete patch in a couple of days.
> Thanks,
Hello,

Second version of comments below.

> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
> index 1430e80..723cc4a 100644
> --- a/gcc/fortran/array.c
> +++ b/gcc/fortran/array.c
> @@ -156,6 +156,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
>  {
>    match m;
>    bool matched_bracket = false;
> +  gfc_expr *tmp;
>
>    memset (ar, '\0', sizeof (*ar));
>
> @@ -226,6 +227,11 @@ coarray:
>        if (m == MATCH_ERROR)
>  	return MATCH_ERROR;
>
> +      if(gfc_match(",stat = %e",&tmp) == MATCH_YES)
Still some mishandled cases, for example:

    tmp = me[i ,  stat=stat]


> +	ar->stat = tmp;
> +      else
> +	ar->stat = NULL;
> +
>        if (gfc_match_char (']') == MATCH_YES)
>  	{
>  	  ar->codimen++;
> @@ -237,6 +243,14 @@ coarray:
>  	    }
>  	  if (ar->codimen > corank)
>  	    {
> +	      /* Entering in this branch means that something bad happened, except
> +	       * when stat has been detected. If this is the case, we need to
> +	       * decrement the codimension by one. */
OK, I said I didn't understand the code, but that was meaning I didn't 
understand why it is not a problem when stat is there, and why we need 
to decrement by one. I could figure out the rest myself.
One example I have in mind is this (currently accepted):

  integer :: ca[*]
  tmp = ca[1,2,stat=foo]

There is also this case (accepted, is it correct?):

  integer :: ca[5, *]
  tmp = ca[1,stat=foo,2]

> +	      if(ar->stat)
> +		{
> +		  ar->codimen--;
> +		  return MATCH_YES;
> +		}
>  	      gfc_error ("Too many codimensions at %C, expected %d not %d",
>  			 corank, ar->codimen);
>  	      return MATCH_ERROR;


> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> index 04339a6..bfffba6 100644
> --- a/gcc/fortran/trans-decl.c
> +++ b/gcc/fortran/trans-decl.c
> @@ -3529,16 +3529,16 @@ gfc_build_builtin_function_decls (void)
>          ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);
>
>        gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
> -	get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 9,
> +	get_identifier (PREFIX("caf_get")), ".R.RRRW.", void_type_node, 10,
Unless you plan to do strange things in the implementation of get, you 
can probably use W as spec character for stat.

>          pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
>  	pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
> -	boolean_type_node);
> +	boolean_type_node, pint_type);
>
>        gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
> -	get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 9,
> +	get_identifier (PREFIX("caf_send")), ".R.RRRR.", void_type_node, 10,
same here.

>          pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
>  	pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
> -	boolean_type_node);
> +	boolean_type_node, pint_type);
>
>        gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
>  	get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRR", void_type_node,
> diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
> index e5cc907..e11a3d6 100644
> --- a/gcc/fortran/trans-intrinsic.c
> +++ b/gcc/fortran/trans-intrinsic.c
> @@ -1100,10 +1100,10 @@ static void
>  gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
>  			    tree may_require_tmp)
>  {
> -  gfc_expr *array_expr;
> +  gfc_expr *array_expr, *tmp_stat;
>    gfc_se argse;
>    tree caf_decl, token, offset, image_index, tmp;
> -  tree res_var, dst_var, type, kind, vec;
> +  tree res_var, dst_var, type, kind, vec, stat;
>
>    gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
>
> @@ -1122,6 +1122,19 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
>    dst_var = lhs;
>
>    vec = null_pointer_node;
> +  tmp_stat = gfc_find_stat_co(expr);
> +
> +  if (tmp_stat)
> +    {
> +      gfc_se stat_se;
> +      gfc_init_se(&stat_se, NULL);
> +      gfc_conv_expr_reference (&stat_se, tmp_stat);
> +      stat = stat_se.expr;
> +      /* gfc_add_block_to_block (&se->pre, &stat_se.pre); */
> +      /* gfc_add_block_to_block (&se->post, &stat_se.post); */

You can try this as complex case.
From visually inspecting it, the code generated passes an uninitialised 
pointer as stat.

      program p
        integer :: tmp, a(5)
        integer, target :: t
        integer :: ca[*]

        a = 1
        tmp = ca[1,stat=ptr(a + 2)]

      contains
        function ptr(a)
          integer :: a(5)
          integer, pointer :: ptr

          if (all(a == 3)) then
            ptr => t
          else
            ptr => null()
          end if
        end function ptr
      end program p

Mikael