[Fortran] Help with STAT= attribute in coarray reference

[Fortran] Help with STAT= attribute in coarray reference

[Alessandro Fanfarillo]

Dear all,

the FAILED IMAGES capability, as defined in the coarray TS 18508,
requires the presence of a "STAT=" attribute on each synchronization
statement and coarray reference in order to detect the possible loss
of one or more images.
So far, GFortran allows to pass to every synchronization statement the
STAT= attribute; the main change involves the coarray reference
syntax.

For example, the following code:

integer,dimension(10) :: a[*]

a = this_image()

sync all

if(this_image == 1) then
  a(:) = a(:)[num_images()]
endif

becomes:

integer,dimension(10) :: a[*]
integer :: stat

a = this_image()

sync all (stat=stat)

if(this_image == 1) then
  a(:) = a(:)[num_images(), stat = stat] <---- !!
endif

Do you have any idea/suggestion on how to implement this in GFortran?

Thank you in advance.

Alessandro

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

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 1523 bytes --]

Dear all,

in attachment there is a working patch for adding the STAT= attribute
to coarray get and put needed by Failed Images (TS 18508).

E.g.:

integer,dimension(10) :: a[*]
integer :: stat

a(:) = a(:)[num_images(),stat=stat]


In order to pass the variable assigned during the coarray reference I
had to modify the gfc_array_ref structure by adding a gfc_expr* field.
By doing so, I'm able to store the stat variable in the descriptor and
pass it to the OpenCoarrays routines at the right moment.

Is there a better way of doing it?

Cheers,

Alessandro

2016-06-06 18:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> Dear all,
>
> the FAILED IMAGES capability, as defined in the coarray TS 18508,
> requires the presence of a "STAT=" attribute on each synchronization
> statement and coarray reference in order to detect the possible loss
> of one or more images.
> So far, GFortran allows to pass to every synchronization statement the
> STAT= attribute; the main change involves the coarray reference
> syntax.
>
> For example, the following code:
>
> integer,dimension(10) :: a[*]
>
> a = this_image()
>
> sync all
>
> if(this_image == 1) then
>   a(:) = a(:)[num_images()]
> endif
>
> becomes:
>
> integer,dimension(10) :: a[*]
> integer :: stat
>
> a = this_image()
>
> sync all (stat=stat)
>
> if(this_image == 1) then
>   a(:) = a(:)[num_images(), stat = stat] <---- !!
> endif
>
> Do you have any idea/suggestion on how to implement this in GFortran?
>
> Thank you in advance.
>
> Alessandro

[-- Attachment #2: stat_get_send.diff --]
[-- Type: text/plain, Size: 7360 bytes --]

commit 1db7977a0f867bbb3a1fe5db9a29311e5a8b77dc
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Mon Jun 13 11:03:15 2016 -0600

    Working patch for stat= in get and send

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 1430e80..232bae7 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)
+	ar->stat = tmp;
+      else
+	ar->stat = NULL;
+
       if (gfc_match_char (']') == MATCH_YES)
 	{
 	  ar->codimen++;
@@ -237,6 +243,11 @@ coarray:
 	    }
 	  if (ar->codimen > corank)
 	    {
+	      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/expr.c b/gcc/fortran/expr.c
index d1258cd..34a3557 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref)
   return true;
 }
 
+gfc_expr *
+gfc_find_stat_co(gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.stat;
+  return NULL;
+}
 
 bool
 gfc_is_coindexed (gfc_expr *e)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d87632..2f22c32 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
   int dimen;			/* # of components in the reference */
   int codimen;
   bool in_allocate;		/* For coarray checks. */
+  gfc_expr *stat;
   locus where;
   gfc_array_spec *as;
 
@@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
-
+gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
 bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f56bdf1..54be70e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar)
     }
 
   /* ar->codimen == 0 is a local array.  */
-  if (as->corank != ar->codimen && ar->codimen != 0)
+  if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat)
     {
       gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)",
 		 &ar->where, ar->codimen, as->corank);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 04339a6..1ee548a 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,
         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);
+	integer_type_node, boolean_type_node);
 
       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,
         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);
+	pint_type, boolean_type_node);
 
       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..7d8123b 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,16 @@ 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_conv_expr_val (se, tmp_stat);
+      stat = se->expr;
+      stat = gfc_build_addr_expr (NULL, stat);
+    }
+  else
+    stat = null_pointer_node;
 
   gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
@@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   ASM_VOLATILE_P (tmp) = 1;
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
 			     token, offset, image_index, argse.expr, vec,
-			     dst_var, kind, lhs_kind, may_require_tmp);
+			     dst_var, kind, lhs_kind, stat, may_require_tmp);
   gfc_add_expr_to_block (&se->pre, tmp);
 
   if (se->ss)
@@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 
 static tree
 conv_caf_send (gfc_code *code) {
-  gfc_expr *lhs_expr, *rhs_expr;
+  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-  tree may_require_tmp;
+  tree may_require_tmp, stat;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
 
@@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) {
 		    ? boolean_false_node : boolean_true_node;
   gfc_init_block (&block);
 
+  stat = null_pointer_node;
+
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
   if (lhs_expr->rank == 0)
@@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) {
 
   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
 
+  tmp_stat = gfc_find_stat_co(lhs_expr);
+
+  if(tmp_stat)
+    {
+      gfc_se stat_se;
+      gfc_init_se (&stat_se, NULL);
+      gfc_conv_expr_val (&stat_se, tmp_stat);
+      stat = stat_se.expr;
+      stat = gfc_build_addr_expr (NULL, stat);
+    }
+  else
+    stat = null_pointer_node;
+
   if (!gfc_is_coindexed (rhs_expr))
-    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token,
-			     offset, image_index, lhs_se.expr, vec,
-			     rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp);
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token,
+			       offset, image_index, lhs_se.expr, vec,
+			       rhs_se.expr, lhs_kind, rhs_kind, stat,
+			       may_require_tmp);
   else
     {
       tree rhs_token, rhs_offset, rhs_image_index;

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

[Mikael Morin]

Le 13/06/2016 19:16, Alessandro Fanfarillo a écrit :
> Dear all,
>
> in attachment there is a working patch for adding the STAT= attribute
> to coarray get and put needed by Failed Images (TS 18508).
>
> E.g.:
>
> integer,dimension(10) :: a[*]
> integer :: stat
>
> a(:) = a(:)[num_images(),stat=stat]
>
>
> In order to pass the variable assigned during the coarray reference I
> had to modify the gfc_array_ref structure by adding a gfc_expr* field.
> By doing so, I'm able to store the stat variable in the descriptor and
> pass it to the OpenCoarrays routines at the right moment.
>
> Is there a better way of doing it?
>
Array ref and coarray ref should have been separated when we introduced 
coarrays, as they are really different things.
Appart from that, I think your way is the natural way of doing it.

Comments below about the patch. It's mostly good.


> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
> index 1430e80..232bae7 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)
Add spaces between the tokens to match for optional whitespace.
(tests welcome for this)
An error is missing for multiple stat=
(tests welcome as well)

> +	ar->stat = tmp;
> +      else
> +	ar->stat = NULL;
> +
>        if (gfc_match_char (']') == MATCH_YES)
>  	{
>  	  ar->codimen++;
> @@ -237,6 +243,11 @@ coarray:
>  	    }
>  	  if (ar->codimen > corank)
>  	    {
> +	      if(ar->stat)
> +		{
> +		  ar->codimen--;
> +		  return MATCH_YES;
> +		}
I don't understand this change.
If there are some extra codimension refs and a stat argument, you should 
still emit a "Too many codimensions" error.
(Tests welcome for this)

>  	      gfc_error ("Too many codimensions at %C, expected %d not %d",
>  			 corank, ar->codimen);
>  	      return MATCH_ERROR;
> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
> index d1258cd..34a3557 100644
> --- a/gcc/fortran/expr.c
> +++ b/gcc/fortran/expr.c
> @@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref)
>    return true;
>  }
>
> +gfc_expr *
> +gfc_find_stat_co(gfc_expr *e)
> +{
> +  gfc_ref *ref;
> +
> +  for (ref = e->ref; ref; ref = ref->next)
> +    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
> +      return ref->u.ar.stat;
> +  return NULL;
> +}
>
>  bool
>  gfc_is_coindexed (gfc_expr *e)
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index 6d87632..2f22c32 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
>    int dimen;			/* # of components in the reference */
>    int codimen;
>    bool in_allocate;		/* For coarray checks. */
> +  gfc_expr *stat;
>    locus where;
>    gfc_array_spec *as;
>
> @@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
>  int gfc_get_corank (gfc_expr *);
>  bool gfc_has_ultimate_allocatable (gfc_expr *);
>  bool gfc_has_ultimate_pointer (gfc_expr *);
> -
> +gfc_expr* gfc_find_stat_co (gfc_expr *);
>  gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
>  				    locus, unsigned, ...);
>  bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
> index f56bdf1..54be70e 100644
> --- a/gcc/fortran/resolve.c
> +++ b/gcc/fortran/resolve.c
> @@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar)
>      }
>
>    /* ar->codimen == 0 is a local array.  */
> -  if (as->corank != ar->codimen && ar->codimen != 0)
> +  if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat)
I think stat is irrelevant here.

>      {
>        gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)",
>  		 &ar->where, ar->codimen, as->corank);
> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> index 04339a6..1ee548a 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,
The spec string ".R.RRRW" should be updated as well.

>          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);
> +	integer_type_node, boolean_type_node);
>
>        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);
> +	pint_type, boolean_type_node);
>
>        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..7d8123b 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,16 @@ 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)
Space after if

> +    {
Call gfc_init_se.

> +      gfc_conv_expr_val (se, tmp_stat);
It's better to have one dedicated se per expression, like you did for send.

> +      stat = se->expr;
> +      stat = gfc_build_addr_expr (NULL, stat);
You can use gfc_conv_expr_reference directly.

> +    }
> +  else
> +    stat = null_pointer_node;
>
>    gfc_init_se (&argse, NULL);
>    if (array_expr->rank == 0)
> @@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
>    ASM_VOLATILE_P (tmp) = 1;
>    gfc_add_expr_to_block (&se->pre, tmp);
>
> -  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
> +  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
>  			     token, offset, image_index, argse.expr, vec,
> -			     dst_var, kind, lhs_kind, may_require_tmp);
> +			     dst_var, kind, lhs_kind, stat, may_require_tmp);
>    gfc_add_expr_to_block (&se->pre, tmp);
>
>    if (se->ss)
> @@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
>
>  static tree
>  conv_caf_send (gfc_code *code) {
> -  gfc_expr *lhs_expr, *rhs_expr;
> +  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
>    gfc_se lhs_se, rhs_se;
>    stmtblock_t block;
>    tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
> -  tree may_require_tmp;
> +  tree may_require_tmp, stat;
>    tree lhs_type = NULL_TREE;
>    tree vec = null_pointer_node, rhs_vec = null_pointer_node;
>
> @@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) {
>  		    ? boolean_false_node : boolean_true_node;
>    gfc_init_block (&block);
>
> +  stat = null_pointer_node;
> +
>    /* LHS.  */
>    gfc_init_se (&lhs_se, NULL);
>    if (lhs_expr->rank == 0)
> @@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) {
>
>    rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
>
> +  tmp_stat = gfc_find_stat_co(lhs_expr);
> +
> +  if(tmp_stat)
space after if

> +    {
> +      gfc_se stat_se;
> +      gfc_init_se (&stat_se, NULL);
> +      gfc_conv_expr_val (&stat_se, tmp_stat);
> +      stat = stat_se.expr;
> +      stat = gfc_build_addr_expr (NULL, stat);
gfc_conv_expr_reference
For complex cases (say, pointer-returning functions), you'll need to add 
stat_se's pre block to se's pre block.
(Tests welcome for this)

> +    }
> +  else
> +    stat = null_pointer_node;
> +
>    if (!gfc_is_coindexed (rhs_expr))
> -    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token,
> -			     offset, image_index, lhs_se.expr, vec,
> -			     rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp);
> +    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token,
> +			       offset, image_index, lhs_se.expr, vec,
> +			       rhs_se.expr, lhs_kind, rhs_kind, stat,
> +			       may_require_tmp);
>    else
>      {
>        tree rhs_token, rhs_offset, rhs_image_index;

More tests welcome ;-)

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

[Alessandro Fanfarillo]

Mikael,

thank a lot for the review. Now that I have (in theory) a complete
coverage of the failed images functionalities (including
https://gcc.gnu.org/ml/fortran/2016-06/msg00019.html) the plan is to
produce several tests and add them to the official patch.

Thanks again.

Regards,
Alessandro

2016-06-13 12:31 GMT-06:00 Mikael Morin <mikael.morin@sfr.fr>:
> Le 13/06/2016 19:16, Alessandro Fanfarillo a écrit :
>>
>> Dear all,
>>
>> in attachment there is a working patch for adding the STAT= attribute
>> to coarray get and put needed by Failed Images (TS 18508).
>>
>> E.g.:
>>
>> integer,dimension(10) :: a[*]
>> integer :: stat
>>
>> a(:) = a(:)[num_images(),stat=stat]
>>
>>
>> In order to pass the variable assigned during the coarray reference I
>> had to modify the gfc_array_ref structure by adding a gfc_expr* field.
>> By doing so, I'm able to store the stat variable in the descriptor and
>> pass it to the OpenCoarrays routines at the right moment.
>>
>> Is there a better way of doing it?
>>
> Array ref and coarray ref should have been separated when we introduced
> coarrays, as they are really different things.
> Appart from that, I think your way is the natural way of doing it.
>
> Comments below about the patch. It's mostly good.
>
>
>> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
>> index 1430e80..232bae7 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)
>
> Add spaces between the tokens to match for optional whitespace.
> (tests welcome for this)
> An error is missing for multiple stat=
> (tests welcome as well)
>
>> +       ar->stat = tmp;
>> +      else
>> +       ar->stat = NULL;
>> +
>>        if (gfc_match_char (']') == MATCH_YES)
>>         {
>>           ar->codimen++;
>> @@ -237,6 +243,11 @@ coarray:
>>             }
>>           if (ar->codimen > corank)
>>             {
>> +             if(ar->stat)
>> +               {
>> +                 ar->codimen--;
>> +                 return MATCH_YES;
>> +               }
>
> I don't understand this change.
> If there are some extra codimension refs and a stat argument, you should
> still emit a "Too many codimensions" error.
> (Tests welcome for this)
>
>>               gfc_error ("Too many codimensions at %C, expected %d not
>> %d",
>>                          corank, ar->codimen);
>>               return MATCH_ERROR;
>> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
>> index d1258cd..34a3557 100644
>> --- a/gcc/fortran/expr.c
>> +++ b/gcc/fortran/expr.c
>> @@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref)
>>    return true;
>>  }
>>
>> +gfc_expr *
>> +gfc_find_stat_co(gfc_expr *e)
>> +{
>> +  gfc_ref *ref;
>> +
>> +  for (ref = e->ref; ref; ref = ref->next)
>> +    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
>> +      return ref->u.ar.stat;
>> +  return NULL;
>> +}
>>
>>  bool
>>  gfc_is_coindexed (gfc_expr *e)
>> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
>> index 6d87632..2f22c32 100644
>> --- a/gcc/fortran/gfortran.h
>> +++ b/gcc/fortran/gfortran.h
>> @@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
>>    int dimen;                   /* # of components in the reference */
>>    int codimen;
>>    bool in_allocate;            /* For coarray checks. */
>> +  gfc_expr *stat;
>>    locus where;
>>    gfc_array_spec *as;
>>
>> @@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
>>  int gfc_get_corank (gfc_expr *);
>>  bool gfc_has_ultimate_allocatable (gfc_expr *);
>>  bool gfc_has_ultimate_pointer (gfc_expr *);
>> -
>> +gfc_expr* gfc_find_stat_co (gfc_expr *);
>>  gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const
>> char*,
>>                                     locus, unsigned, ...);
>>  bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
>> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
>> index f56bdf1..54be70e 100644
>> --- a/gcc/fortran/resolve.c
>> +++ b/gcc/fortran/resolve.c
>> @@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar)
>>      }
>>
>>    /* ar->codimen == 0 is a local array.  */
>> -  if (as->corank != ar->codimen && ar->codimen != 0)
>> +  if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat)
>
> I think stat is irrelevant here.
>
>>      {
>>        gfc_error ("Coindex rank mismatch in array reference at %L
>> (%d/%d)",
>>                  &ar->where, ar->codimen, as->corank);
>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>> index 04339a6..1ee548a 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,
>
> The spec string ".R.RRRW" should be updated as well.
>
>>          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);
>> +       integer_type_node, boolean_type_node);
>>
>>        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);
>> +       pint_type, boolean_type_node);
>>
>>        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..7d8123b 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,16 @@ 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)
>
> Space after if
>
>> +    {
>
> Call gfc_init_se.
>
>> +      gfc_conv_expr_val (se, tmp_stat);
>
> It's better to have one dedicated se per expression, like you did for send.
>
>> +      stat = se->expr;
>> +      stat = gfc_build_addr_expr (NULL, stat);
>
> You can use gfc_conv_expr_reference directly.
>
>> +    }
>> +  else
>> +    stat = null_pointer_node;
>>
>>    gfc_init_se (&argse, NULL);
>>    if (array_expr->rank == 0)
>> @@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr
>> *expr, tree lhs, tree lhs_kind,
>>    ASM_VOLATILE_P (tmp) = 1;
>>    gfc_add_expr_to_block (&se->pre, tmp);
>>
>> -  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
>> +  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
>>                              token, offset, image_index, argse.expr, vec,
>> -                            dst_var, kind, lhs_kind, may_require_tmp);
>> +                            dst_var, kind, lhs_kind, stat,
>> may_require_tmp);
>>    gfc_add_expr_to_block (&se->pre, tmp);
>>
>>    if (se->ss)
>> @@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr
>> *expr, tree lhs, tree lhs_kind,
>>
>>  static tree
>>  conv_caf_send (gfc_code *code) {
>> -  gfc_expr *lhs_expr, *rhs_expr;
>> +  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
>>    gfc_se lhs_se, rhs_se;
>>    stmtblock_t block;
>>    tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
>> -  tree may_require_tmp;
>> +  tree may_require_tmp, stat;
>>    tree lhs_type = NULL_TREE;
>>    tree vec = null_pointer_node, rhs_vec = null_pointer_node;
>>
>> @@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) {
>>                     ? boolean_false_node : boolean_true_node;
>>    gfc_init_block (&block);
>>
>> +  stat = null_pointer_node;
>> +
>>    /* LHS.  */
>>    gfc_init_se (&lhs_se, NULL);
>>    if (lhs_expr->rank == 0)
>> @@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) {
>>
>>    rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
>>
>> +  tmp_stat = gfc_find_stat_co(lhs_expr);
>> +
>> +  if(tmp_stat)
>
> space after if
>
>> +    {
>> +      gfc_se stat_se;
>> +      gfc_init_se (&stat_se, NULL);
>> +      gfc_conv_expr_val (&stat_se, tmp_stat);
>> +      stat = stat_se.expr;
>> +      stat = gfc_build_addr_expr (NULL, stat);
>
> gfc_conv_expr_reference
> For complex cases (say, pointer-returning functions), you'll need to add
> stat_se's pre block to se's pre block.
> (Tests welcome for this)
>
>> +    }
>> +  else
>> +    stat = null_pointer_node;
>> +
>>    if (!gfc_is_coindexed (rhs_expr))
>> -    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9,
>> token,
>> -                            offset, image_index, lhs_se.expr, vec,
>> -                            rhs_se.expr, lhs_kind, rhs_kind,
>> may_require_tmp);
>> +    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10,
>> token,
>> +                              offset, image_index, lhs_se.expr, vec,
>> +                              rhs_se.expr, lhs_kind, rhs_kind, stat,
>> +                              may_require_tmp);
>>    else
>>      {
>>        tree rhs_token, rhs_offset, rhs_image_index;
>
>
> More tests welcome ;-)

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

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 10823 bytes --]

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,

Alessandro

2016-06-13 12:31 GMT-06:00 Mikael Morin <mikael.morin@sfr.fr>:
> Le 13/06/2016 19:16, Alessandro Fanfarillo a écrit :
>>
>> Dear all,
>>
>> in attachment there is a working patch for adding the STAT= attribute
>> to coarray get and put needed by Failed Images (TS 18508).
>>
>> E.g.:
>>
>> integer,dimension(10) :: a[*]
>> integer :: stat
>>
>> a(:) = a(:)[num_images(),stat=stat]
>>
>>
>> In order to pass the variable assigned during the coarray reference I
>> had to modify the gfc_array_ref structure by adding a gfc_expr* field.
>> By doing so, I'm able to store the stat variable in the descriptor and
>> pass it to the OpenCoarrays routines at the right moment.
>>
>> Is there a better way of doing it?
>>
> Array ref and coarray ref should have been separated when we introduced
> coarrays, as they are really different things.
> Appart from that, I think your way is the natural way of doing it.
>
> Comments below about the patch. It's mostly good.
>
>
>> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
>> index 1430e80..232bae7 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)
>
> Add spaces between the tokens to match for optional whitespace.
> (tests welcome for this)
> An error is missing for multiple stat=
> (tests welcome as well)
>
>> +       ar->stat = tmp;
>> +      else
>> +       ar->stat = NULL;
>> +
>>        if (gfc_match_char (']') == MATCH_YES)
>>         {
>>           ar->codimen++;
>> @@ -237,6 +243,11 @@ coarray:
>>             }
>>           if (ar->codimen > corank)
>>             {
>> +             if(ar->stat)
>> +               {
>> +                 ar->codimen--;
>> +                 return MATCH_YES;
>> +               }
>
> I don't understand this change.
> If there are some extra codimension refs and a stat argument, you should
> still emit a "Too many codimensions" error.
> (Tests welcome for this)
>
>>               gfc_error ("Too many codimensions at %C, expected %d not
>> %d",
>>                          corank, ar->codimen);
>>               return MATCH_ERROR;
>> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
>> index d1258cd..34a3557 100644
>> --- a/gcc/fortran/expr.c
>> +++ b/gcc/fortran/expr.c
>> @@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref)
>>    return true;
>>  }
>>
>> +gfc_expr *
>> +gfc_find_stat_co(gfc_expr *e)
>> +{
>> +  gfc_ref *ref;
>> +
>> +  for (ref = e->ref; ref; ref = ref->next)
>> +    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
>> +      return ref->u.ar.stat;
>> +  return NULL;
>> +}
>>
>>  bool
>>  gfc_is_coindexed (gfc_expr *e)
>> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
>> index 6d87632..2f22c32 100644
>> --- a/gcc/fortran/gfortran.h
>> +++ b/gcc/fortran/gfortran.h
>> @@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
>>    int dimen;                   /* # of components in the reference */
>>    int codimen;
>>    bool in_allocate;            /* For coarray checks. */
>> +  gfc_expr *stat;
>>    locus where;
>>    gfc_array_spec *as;
>>
>> @@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
>>  int gfc_get_corank (gfc_expr *);
>>  bool gfc_has_ultimate_allocatable (gfc_expr *);
>>  bool gfc_has_ultimate_pointer (gfc_expr *);
>> -
>> +gfc_expr* gfc_find_stat_co (gfc_expr *);
>>  gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const
>> char*,
>>                                     locus, unsigned, ...);
>>  bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
>> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
>> index f56bdf1..54be70e 100644
>> --- a/gcc/fortran/resolve.c
>> +++ b/gcc/fortran/resolve.c
>> @@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar)
>>      }
>>
>>    /* ar->codimen == 0 is a local array.  */
>> -  if (as->corank != ar->codimen && ar->codimen != 0)
>> +  if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat)
>
> I think stat is irrelevant here.
>
>>      {
>>        gfc_error ("Coindex rank mismatch in array reference at %L
>> (%d/%d)",
>>                  &ar->where, ar->codimen, as->corank);
>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>> index 04339a6..1ee548a 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,
>
> The spec string ".R.RRRW" should be updated as well.
>
>>          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);
>> +       integer_type_node, boolean_type_node);
>>
>>        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);
>> +       pint_type, boolean_type_node);
>>
>>        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..7d8123b 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,16 @@ 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)
>
> Space after if
>
>> +    {
>
> Call gfc_init_se.
>
>> +      gfc_conv_expr_val (se, tmp_stat);
>
> It's better to have one dedicated se per expression, like you did for send.
>
>> +      stat = se->expr;
>> +      stat = gfc_build_addr_expr (NULL, stat);
>
> You can use gfc_conv_expr_reference directly.
>
>> +    }
>> +  else
>> +    stat = null_pointer_node;
>>
>>    gfc_init_se (&argse, NULL);
>>    if (array_expr->rank == 0)
>> @@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr
>> *expr, tree lhs, tree lhs_kind,
>>    ASM_VOLATILE_P (tmp) = 1;
>>    gfc_add_expr_to_block (&se->pre, tmp);
>>
>> -  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
>> +  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
>>                              token, offset, image_index, argse.expr, vec,
>> -                            dst_var, kind, lhs_kind, may_require_tmp);
>> +                            dst_var, kind, lhs_kind, stat,
>> may_require_tmp);
>>    gfc_add_expr_to_block (&se->pre, tmp);
>>
>>    if (se->ss)
>> @@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr
>> *expr, tree lhs, tree lhs_kind,
>>
>>  static tree
>>  conv_caf_send (gfc_code *code) {
>> -  gfc_expr *lhs_expr, *rhs_expr;
>> +  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
>>    gfc_se lhs_se, rhs_se;
>>    stmtblock_t block;
>>    tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
>> -  tree may_require_tmp;
>> +  tree may_require_tmp, stat;
>>    tree lhs_type = NULL_TREE;
>>    tree vec = null_pointer_node, rhs_vec = null_pointer_node;
>>
>> @@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) {
>>                     ? boolean_false_node : boolean_true_node;
>>    gfc_init_block (&block);
>>
>> +  stat = null_pointer_node;
>> +
>>    /* LHS.  */
>>    gfc_init_se (&lhs_se, NULL);
>>    if (lhs_expr->rank == 0)
>> @@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) {
>>
>>    rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
>>
>> +  tmp_stat = gfc_find_stat_co(lhs_expr);
>> +
>> +  if(tmp_stat)
>
> space after if
>
>> +    {
>> +      gfc_se stat_se;
>> +      gfc_init_se (&stat_se, NULL);
>> +      gfc_conv_expr_val (&stat_se, tmp_stat);
>> +      stat = stat_se.expr;
>> +      stat = gfc_build_addr_expr (NULL, stat);
>
> gfc_conv_expr_reference
> For complex cases (say, pointer-returning functions), you'll need to add
> stat_se's pre block to se's pre block.
> (Tests welcome for this)
>
>> +    }
>> +  else
>> +    stat = null_pointer_node;
>> +
>>    if (!gfc_is_coindexed (rhs_expr))
>> -    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9,
>> token,
>> -                            offset, image_index, lhs_se.expr, vec,
>> -                            rhs_se.expr, lhs_kind, rhs_kind,
>> may_require_tmp);
>> +    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10,
>> token,
>> +                              offset, image_index, lhs_se.expr, vec,
>> +                              rhs_se.expr, lhs_kind, rhs_kind, stat,
>> +                              may_require_tmp);
>>    else
>>      {
>>        tree rhs_token, rhs_offset, rhs_image_index;
>
>
> More tests welcome ;-)

[-- Attachment #2: stat_get_send_first_rev.diff --]
[-- Type: text/plain, Size: 8138 bytes --]

commit b48d50d60d11f2a0a87ff35481a501b3a9777f20
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Mon Jun 20 13:50:57 2016 -0600

    Second version of stat= patch

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)
+	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. */
+	      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/expr.c b/gcc/fortran/expr.c
index d1258cd..7328898 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4428,6 +4428,23 @@ gfc_ref_this_image (gfc_ref *ref)
   return true;
 }
 
+gfc_expr *
+gfc_find_stat_co(gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.stat;
+
+  if(e->value.function.actual->expr)
+    for(ref = e->value.function.actual->expr->ref; ref;
+	ref = ref->next)
+      if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+	return ref->u.ar.stat;
+
+  return NULL;
+}
 
 bool
 gfc_is_coindexed (gfc_expr *e)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d87632..2f22c32 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
   int dimen;			/* # of components in the reference */
   int codimen;
   bool in_allocate;		/* For coarray checks. */
+  gfc_expr *stat;
   locus where;
   gfc_array_spec *as;
 
@@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
-
+gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
 bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index c2faa0f..89ccddc 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1953,6 +1953,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 
       m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag,
 			       as ? as->corank : 0);
+
       if (m != MATCH_YES)
 	return m;
 
@@ -1961,7 +1962,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	{
 	  tail = extend_ref (primary, tail);
 	  tail->type = REF_ARRAY;
-
+
 	  m = gfc_match_array_ref (&tail->u.ar, NULL, equiv_flag, 0);
 	  if (m != MATCH_YES)
 	    return m;
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,
         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,
         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); */
+    }
+  else
+    stat = null_pointer_node;
 
   gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
@@ -1219,9 +1232,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   ASM_VOLATILE_P (tmp) = 1;
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
 			     token, offset, image_index, argse.expr, vec,
-			     dst_var, kind, lhs_kind, may_require_tmp);
+			     dst_var, kind, lhs_kind, may_require_tmp, stat);
   gfc_add_expr_to_block (&se->pre, tmp);
 
   if (se->ss)
@@ -1237,11 +1250,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 
 static tree
 conv_caf_send (gfc_code *code) {
-  gfc_expr *lhs_expr, *rhs_expr;
+  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-  tree may_require_tmp;
+  tree may_require_tmp, stat;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
 
@@ -1253,6 +1266,8 @@ conv_caf_send (gfc_code *code) {
 		    ? boolean_false_node : boolean_true_node;
   gfc_init_block (&block);
 
+  stat = null_pointer_node;
+
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
   if (lhs_expr->rank == 0)
@@ -1375,10 +1390,26 @@ conv_caf_send (gfc_code *code) {
 
   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
 
+  tmp_stat = gfc_find_stat_co(lhs_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_conv_expr_val (&stat_se, tmp_stat); */
+      /* stat = stat_se.expr; */
+      /* stat = gfc_build_addr_expr (NULL, stat); */
+    }
+  else
+    stat = null_pointer_node;
+
   if (!gfc_is_coindexed (rhs_expr))
-    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token,
-			     offset, image_index, lhs_se.expr, vec,
-			     rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp);
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token,
+			       offset, image_index, lhs_se.expr, vec,
+			       rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp,
+			       stat);
   else
     {
       tree rhs_token, rhs_offset, rhs_image_index;

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

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 11439 bytes --]

All,

in attachment a couple of new tests about the stat= attribute in the
coarray reference. Because caf_get and caf_send have one more argument
I modified also coarray_lib_comm_1.f90 accordingly.



2016-06-20 14:01 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> 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,
>
> Alessandro
>
> 2016-06-13 12:31 GMT-06:00 Mikael Morin <mikael.morin@sfr.fr>:
>> Le 13/06/2016 19:16, Alessandro Fanfarillo a écrit :
>>>
>>> Dear all,
>>>
>>> in attachment there is a working patch for adding the STAT= attribute
>>> to coarray get and put needed by Failed Images (TS 18508).
>>>
>>> E.g.:
>>>
>>> integer,dimension(10) :: a[*]
>>> integer :: stat
>>>
>>> a(:) = a(:)[num_images(),stat=stat]
>>>
>>>
>>> In order to pass the variable assigned during the coarray reference I
>>> had to modify the gfc_array_ref structure by adding a gfc_expr* field.
>>> By doing so, I'm able to store the stat variable in the descriptor and
>>> pass it to the OpenCoarrays routines at the right moment.
>>>
>>> Is there a better way of doing it?
>>>
>> Array ref and coarray ref should have been separated when we introduced
>> coarrays, as they are really different things.
>> Appart from that, I think your way is the natural way of doing it.
>>
>> Comments below about the patch. It's mostly good.
>>
>>
>>> diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
>>> index 1430e80..232bae7 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)
>>
>> Add spaces between the tokens to match for optional whitespace.
>> (tests welcome for this)
>> An error is missing for multiple stat=
>> (tests welcome as well)
>>
>>> +       ar->stat = tmp;
>>> +      else
>>> +       ar->stat = NULL;
>>> +
>>>        if (gfc_match_char (']') == MATCH_YES)
>>>         {
>>>           ar->codimen++;
>>> @@ -237,6 +243,11 @@ coarray:
>>>             }
>>>           if (ar->codimen > corank)
>>>             {
>>> +             if(ar->stat)
>>> +               {
>>> +                 ar->codimen--;
>>> +                 return MATCH_YES;
>>> +               }
>>
>> I don't understand this change.
>> If there are some extra codimension refs and a stat argument, you should
>> still emit a "Too many codimensions" error.
>> (Tests welcome for this)
>>
>>>               gfc_error ("Too many codimensions at %C, expected %d not
>>> %d",
>>>                          corank, ar->codimen);
>>>               return MATCH_ERROR;
>>> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
>>> index d1258cd..34a3557 100644
>>> --- a/gcc/fortran/expr.c
>>> +++ b/gcc/fortran/expr.c
>>> @@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref)
>>>    return true;
>>>  }
>>>
>>> +gfc_expr *
>>> +gfc_find_stat_co(gfc_expr *e)
>>> +{
>>> +  gfc_ref *ref;
>>> +
>>> +  for (ref = e->ref; ref; ref = ref->next)
>>> +    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
>>> +      return ref->u.ar.stat;
>>> +  return NULL;
>>> +}
>>>
>>>  bool
>>>  gfc_is_coindexed (gfc_expr *e)
>>> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
>>> index 6d87632..2f22c32 100644
>>> --- a/gcc/fortran/gfortran.h
>>> +++ b/gcc/fortran/gfortran.h
>>> @@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
>>>    int dimen;                   /* # of components in the reference */
>>>    int codimen;
>>>    bool in_allocate;            /* For coarray checks. */
>>> +  gfc_expr *stat;
>>>    locus where;
>>>    gfc_array_spec *as;
>>>
>>> @@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
>>>  int gfc_get_corank (gfc_expr *);
>>>  bool gfc_has_ultimate_allocatable (gfc_expr *);
>>>  bool gfc_has_ultimate_pointer (gfc_expr *);
>>> -
>>> +gfc_expr* gfc_find_stat_co (gfc_expr *);
>>>  gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const
>>> char*,
>>>                                     locus, unsigned, ...);
>>>  bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
>>> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
>>> index f56bdf1..54be70e 100644
>>> --- a/gcc/fortran/resolve.c
>>> +++ b/gcc/fortran/resolve.c
>>> @@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar)
>>>      }
>>>
>>>    /* ar->codimen == 0 is a local array.  */
>>> -  if (as->corank != ar->codimen && ar->codimen != 0)
>>> +  if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat)
>>
>> I think stat is irrelevant here.
>>
>>>      {
>>>        gfc_error ("Coindex rank mismatch in array reference at %L
>>> (%d/%d)",
>>>                  &ar->where, ar->codimen, as->corank);
>>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>>> index 04339a6..1ee548a 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,
>>
>> The spec string ".R.RRRW" should be updated as well.
>>
>>>          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);
>>> +       integer_type_node, boolean_type_node);
>>>
>>>        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);
>>> +       pint_type, boolean_type_node);
>>>
>>>        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..7d8123b 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,16 @@ 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)
>>
>> Space after if
>>
>>> +    {
>>
>> Call gfc_init_se.
>>
>>> +      gfc_conv_expr_val (se, tmp_stat);
>>
>> It's better to have one dedicated se per expression, like you did for send.
>>
>>> +      stat = se->expr;
>>> +      stat = gfc_build_addr_expr (NULL, stat);
>>
>> You can use gfc_conv_expr_reference directly.
>>
>>> +    }
>>> +  else
>>> +    stat = null_pointer_node;
>>>
>>>    gfc_init_se (&argse, NULL);
>>>    if (array_expr->rank == 0)
>>> @@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr
>>> *expr, tree lhs, tree lhs_kind,
>>>    ASM_VOLATILE_P (tmp) = 1;
>>>    gfc_add_expr_to_block (&se->pre, tmp);
>>>
>>> -  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
>>> +  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
>>>                              token, offset, image_index, argse.expr, vec,
>>> -                            dst_var, kind, lhs_kind, may_require_tmp);
>>> +                            dst_var, kind, lhs_kind, stat,
>>> may_require_tmp);
>>>    gfc_add_expr_to_block (&se->pre, tmp);
>>>
>>>    if (se->ss)
>>> @@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr
>>> *expr, tree lhs, tree lhs_kind,
>>>
>>>  static tree
>>>  conv_caf_send (gfc_code *code) {
>>> -  gfc_expr *lhs_expr, *rhs_expr;
>>> +  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
>>>    gfc_se lhs_se, rhs_se;
>>>    stmtblock_t block;
>>>    tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
>>> -  tree may_require_tmp;
>>> +  tree may_require_tmp, stat;
>>>    tree lhs_type = NULL_TREE;
>>>    tree vec = null_pointer_node, rhs_vec = null_pointer_node;
>>>
>>> @@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) {
>>>                     ? boolean_false_node : boolean_true_node;
>>>    gfc_init_block (&block);
>>>
>>> +  stat = null_pointer_node;
>>> +
>>>    /* LHS.  */
>>>    gfc_init_se (&lhs_se, NULL);
>>>    if (lhs_expr->rank == 0)
>>> @@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) {
>>>
>>>    rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
>>>
>>> +  tmp_stat = gfc_find_stat_co(lhs_expr);
>>> +
>>> +  if(tmp_stat)
>>
>> space after if
>>
>>> +    {
>>> +      gfc_se stat_se;
>>> +      gfc_init_se (&stat_se, NULL);
>>> +      gfc_conv_expr_val (&stat_se, tmp_stat);
>>> +      stat = stat_se.expr;
>>> +      stat = gfc_build_addr_expr (NULL, stat);
>>
>> gfc_conv_expr_reference
>> For complex cases (say, pointer-returning functions), you'll need to add
>> stat_se's pre block to se's pre block.
>> (Tests welcome for this)
>>
>>> +    }
>>> +  else
>>> +    stat = null_pointer_node;
>>> +
>>>    if (!gfc_is_coindexed (rhs_expr))
>>> -    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9,
>>> token,
>>> -                            offset, image_index, lhs_se.expr, vec,
>>> -                            rhs_se.expr, lhs_kind, rhs_kind,
>>> may_require_tmp);
>>> +    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10,
>>> token,
>>> +                              offset, image_index, lhs_se.expr, vec,
>>> +                              rhs_se.expr, lhs_kind, rhs_kind, stat,
>>> +                              may_require_tmp);
>>>    else
>>>      {
>>>        tree rhs_token, rhs_offset, rhs_image_index;
>>
>>
>> More tests welcome ;-)

[-- Attachment #2: stat_tests.diff --]
[-- Type: text/plain, Size: 5456 bytes --]

commit 1b489247485cc7b55fac702fb573dd125b40913a
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Wed Jun 22 10:05:00 2016 -0600

    Two new tests for stat= and adapting old test case

diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
index d23c9d1..7b4d937 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
@@ -38,9 +38,8 @@ B(1:5) = B(3:7)
 if (any (A-B /= 0)) call abort
 end
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0, 0B\\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } }
-
diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_function.f90 b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
new file mode 100644
index 0000000..67751a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program function_stat
+  implicit none
+
+  integer :: me[*],tmp,stat,stat2,next
+
+  me = this_image()
+  next = me + 1
+  if(me == num_images()) next = 1
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) write(*,*) failed_images()
+
+  stat = 0
+  if(me == 1) then
+     tmp = func(me[4,stat=stat])
+     if(stat /= 0) write(*,*) me,failed_images()
+   else if(me == 2) then
+      tmp = func2(me[1,stat=stat2],me[3,stat=stat])
+      if(stat2 /= 0 .or. stat /= 0) write(*,*) me,failed_images()
+  endif
+
+contains
+
+  function func(remote_me)
+    integer func
+    integer remote_me
+    func = remote_me
+  end function func
+
+  function func2(remote_me,remote_neighbor)
+    integer func2
+    integer remote_me,remote_neighbor
+    func2 = remote_me + remote_neighbor
+  end function func2
+  
+end program function_stat
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 4, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 1, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat2\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 3, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_whitespace.f90 b/gcc/testsuite/gfortran.dg/coarray_stat_whitespace.f90
new file mode 100644
index 0000000..7f260b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_stat_whitespace.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Support for stat= in caf reference
+!
+program whitespace
+  implicit none
+
+  integer :: me[*],tmp,stat,i
+
+  me = this_image()
+  stat = 0
+  i = 1
+
+  sync all(stat = stat)
+
+  if(stat /= 0) write(*,*) failed_images()
+
+  stat = 0
+
+  if(me == 1) then
+     tmp = me[num_images(),stat = stat]
+     if(stat /= 0) write(*,*) me,failed_images()
+  else if(me == 2) then
+     tmp = me[i,stat=stat]
+     if(stat /= 0) write(*,*) me,failed_images()
+  endif
+
+end program whitespace

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

[Mikael]

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

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

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 6349 bytes --]

Dear Mikael,

thanks for your review and for the test. The attached patch, built and
regtested for x86_64-pc-linux-gnu, addresses all the suggestions.

The next patch will change the documentation related to the caf_get
and caf_send functions and will add support for STAT= to the sendget
function.

In the meantime, is this patch OK for trunk?


2016-06-23 14:45 GMT-06:00 Mikael <morin-mikael@orange.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
>
>

[-- Attachment #2: stat_get_send_second_rev_and_tests.diff --]
[-- Type: text/plain, Size: 12656 bytes --]

commit 1213a0a0b8d7d35480ea485981cb27cab3c1b7bd
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Wed Jun 29 21:59:29 2016 -0600

    Second review of STAT= patch + tests

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 1430e80..03c8b17 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -156,6 +156,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
 {
   match m;
   bool matched_bracket = false;
+  gfc_expr *tmp;
+  bool stat_just_seen = false;
 
   memset (ar, '\0', sizeof (*ar));
 
@@ -220,12 +222,27 @@ coarray:
 	return MATCH_ERROR;
     }
 
+  ar->stat = NULL;
+
   for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++)
     {
       m = match_subscript (ar, init, true);
       if (m == MATCH_ERROR)
 	return MATCH_ERROR;
 
+      stat_just_seen = false;
+      if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
+	{
+	  ar->stat = tmp;
+	  stat_just_seen = true;
+	}
+
+      if (ar->stat && !stat_just_seen)
+	{
+	  gfc_error ("STAT= attribute in %C misplaced");
+	  return MATCH_ERROR;
+	}
+
       if (gfc_match_char (']') == MATCH_YES)
 	{
 	  ar->codimen++;
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index d1258cd..7328898 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4428,6 +4428,23 @@ gfc_ref_this_image (gfc_ref *ref)
   return true;
 }
 
+gfc_expr *
+gfc_find_stat_co(gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.stat;
+
+  if(e->value.function.actual->expr)
+    for(ref = e->value.function.actual->expr->ref; ref;
+	ref = ref->next)
+      if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+	return ref->u.ar.stat;
+
+  return NULL;
+}
 
 bool
 gfc_is_coindexed (gfc_expr *e)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d87632..2f22c32 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
   int dimen;			/* # of components in the reference */
   int codimen;
   bool in_allocate;		/* For coarray checks. */
+  gfc_expr *stat;
   locus where;
   gfc_array_spec *as;
 
@@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
-
+gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
 bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 04339a6..c7d8160 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.RRRWW", void_type_node, 10,
         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.RRRRW", void_type_node, 10,
         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 c752889..957719e 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);
+    }
+  else
+    stat = null_pointer_node;
 
   gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
@@ -1219,9 +1232,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   ASM_VOLATILE_P (tmp) = 1;
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
 			     token, offset, image_index, argse.expr, vec,
-			     dst_var, kind, lhs_kind, may_require_tmp);
+			     dst_var, kind, lhs_kind, may_require_tmp, stat);
   gfc_add_expr_to_block (&se->pre, tmp);
 
   if (se->ss)
@@ -1237,11 +1250,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 
 static tree
 conv_caf_send (gfc_code *code) {
-  gfc_expr *lhs_expr, *rhs_expr;
+  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-  tree may_require_tmp;
+  tree may_require_tmp, stat;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
 
@@ -1253,6 +1266,8 @@ conv_caf_send (gfc_code *code) {
 		    ? boolean_false_node : boolean_true_node;
   gfc_init_block (&block);
 
+  stat = null_pointer_node;
+
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
   if (lhs_expr->rank == 0)
@@ -1375,10 +1390,25 @@ conv_caf_send (gfc_code *code) {
 
   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
 
+  tmp_stat = gfc_find_stat_co(lhs_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 (&block, &stat_se.pre);
+      gfc_add_block_to_block (&block, &stat_se.post);
+    }
+  else
+    stat = null_pointer_node;
+
   if (!gfc_is_coindexed (rhs_expr))
-    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token,
-			     offset, image_index, lhs_se.expr, vec,
-			     rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp);
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token,
+			       offset, image_index, lhs_se.expr, vec,
+			       rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp,
+			       stat);
   else
     {
       tree rhs_token, rhs_offset, rhs_image_index;
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
index d23c9d1..7b4d937 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
@@ -38,9 +38,8 @@ B(1:5) = B(3:7)
 if (any (A-B /= 0)) call abort
 end
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0, 0B\\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } }
-
diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_function.f90 b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
new file mode 100644
index 0000000..67751a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program function_stat
+  implicit none
+
+  integer :: me[*],tmp,stat,stat2,next
+
+  me = this_image()
+  next = me + 1
+  if(me == num_images()) next = 1
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) write(*,*) failed_images()
+
+  stat = 0
+  if(me == 1) then
+     tmp = func(me[4,stat=stat])
+     if(stat /= 0) write(*,*) me,failed_images()
+   else if(me == 2) then
+      tmp = func2(me[1,stat=stat2],me[3,stat=stat])
+      if(stat2 /= 0 .or. stat /= 0) write(*,*) me,failed_images()
+  endif
+
+contains
+
+  function func(remote_me)
+    integer func
+    integer remote_me
+    func = remote_me
+  end function func
+
+  function func2(remote_me,remote_neighbor)
+    integer func2
+    integer remote_me,remote_neighbor
+    func2 = remote_me + remote_neighbor
+  end function func2
+  
+end program function_stat
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 4, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 1, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat2\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 3, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_whitespace.f90 b/gcc/testsuite/gfortran.dg/coarray_stat_whitespace.f90
new file mode 100644
index 0000000..7f260b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_stat_whitespace.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Support for stat= in caf reference
+!
+program whitespace
+  implicit none
+
+  integer :: me[*],tmp,stat,i
+
+  me = this_image()
+  stat = 0
+  i = 1
+
+  sync all(stat = stat)
+
+  if(stat /= 0) write(*,*) failed_images()
+
+  stat = 0
+
+  if(me == 1) then
+     tmp = me[num_images(),stat = stat]
+     if(stat /= 0) write(*,*) me,failed_images()
+  else if(me == 2) then
+     tmp = me[i,stat=stat]
+     if(stat /= 0) write(*,*) me,failed_images()
+  endif
+
+end program whitespace

[-- Attachment #3: ChangeLog --]
[-- Type: application/octet-stream, Size: 754 bytes --]

2016-06-29  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

	* array.c (gfc_match_array_ref): Add parsing support for
	STAT= attribute in CAF reference.
	* expr.c (gfc_find_stat_co): New function that returns
	the STAT= assignment.
	* gfortran.h (gfc_array_ref): New member.
	* trans-decl.c (gfc_build_builtin_function_decls):
	new attribute for caf_get and caf_send functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Passing
	the stat attribute to external function.
	(gfc_conv_intrinsic_caf_send): Ditto.

gcc/testsuite/gfortran.dg

2016-06-29  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

	* coarray_stat_function.f90: New test.
	* coarray_stat_whitespace.f90: New test.
	* coarray_lib_comm_1: Adapting old test to new interfaces.

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

[Mikael Morin]

Le 30/06/2016 06:05, Alessandro Fanfarillo a écrit :
> Dear Mikael,
>
> thanks for your review and for the test. The attached patch, built and
> regtested for x86_64-pc-linux-gnu, addresses all the suggestions.
>
> The next patch will change the documentation related to the caf_get
> and caf_send functions and will add support for STAT= to the sendget
> function.
>
> In the meantime, is this patch OK for trunk?
>
Yes, thanks.

Mikael

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

[Alessandro Fanfarillo]

Thanks, committed as rev. 238007.

2016-07-04 14:41 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
> Le 30/06/2016 06:05, Alessandro Fanfarillo a écrit :
>>
>> Dear Mikael,
>>
>> thanks for your review and for the test. The attached patch, built and
>> regtested for x86_64-pc-linux-gnu, addresses all the suggestions.
>>
>> The next patch will change the documentation related to the caf_get
>> and caf_send functions and will add support for STAT= to the sendget
>> function.
>>
>> In the meantime, is this patch OK for trunk?
>>
> Yes, thanks.
>
> Mikael
>
>

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

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 1238 bytes --]

Hi all,

the attached patch fixes some style issues in the caf code recently
modified. Furthermore does it correct the function specifications of 
caf_get() and caf_send() that where missing some specifiers.

Bootstrapped and regtested ok on x86_64-linux/F23. If noone objects I
commit this patch as obvious tomorrow.

In my pipeline is a patch that will add stat= support to the libcaf
interface and caf_single.

Regards,
	Andre

On Tue, 5 Jul 2016 09:33:49 -0600
Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:

> Thanks, committed as rev. 238007.
> 
> 2016-07-04 14:41 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
> > Le 30/06/2016 06:05, Alessandro Fanfarillo a écrit :  
> >>
> >> Dear Mikael,
> >>
> >> thanks for your review and for the test. The attached patch, built
> >> and regtested for x86_64-pc-linux-gnu, addresses all the
> >> suggestions.
> >>
> >> The next patch will change the documentation related to the caf_get
> >> and caf_send functions and will add support for STAT= to the
> >> sendget function.
> >>
> >> In the meantime, is this patch OK for trunk?
> >>  
> > Yes, thanks.
> >
> > Mikael
> >
> >  


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: cosmetics_caf.clog --]
[-- Type: application/octet-stream, Size: 412 bytes --]

gcc/fortran/ChangeLog:

2016-07-21  Andre Vehreschild  <vehre@gcc.gnu.org>

	* expr.c (gfc_find_stat_co): Fixed whitespaces.
	* gfortran.texi: Fixed typos and reversed meaning of caf_get()'s
	src and dst description.
	* trans-decl.c (gfc_build_builtin_function_decls): Fixed style
	and corrected fnspec for caf functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fixed style.
	(conv_caf_send): Dito.



[-- Attachment #3: cosmetics_caf.patch --]
[-- Type: text/x-patch, Size: 10885 bytes --]

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7328898..6d0eb22 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4437,9 +4437,9 @@ gfc_find_stat_co(gfc_expr *e)
     if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
       return ref->u.ar.stat;
 
-  if(e->value.function.actual->expr)
-    for(ref = e->value.function.actual->expr->ref; ref;
-	ref = ref->next)
+  if (e->value.function.actual->expr)
+    for (ref = e->value.function.actual->expr->ref; ref;
+	 ref = ref->next)
       if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
 	return ref->u.ar.stat;
 
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 4d288ba..cc80204 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3799,7 +3799,7 @@ compared to the base address of the coarray.
 number.
 @item @var{dest} @tab intent(in) Array descriptor for the remote image for the
 bounds and the size. The base_addr shall not be accessed.
-@item @var{dst_vector} @tab intent(int)  If not NULL, it contains the vector
+@item @var{dst_vector} @tab intent(in)  If not NULL, it contains the vector
 subscript of the destination array; the values are relative to the dimension
 triplet of the dest argument.
 @item @var{src} @tab intent(in) Array descriptor of the local array to be
@@ -3839,7 +3839,7 @@ Called to get an array section or whole array from a a remote,
 image identified by the image_index.
 
 @item @emph{Syntax}:
-@code{void _gfortran_caf_get_desc (caf_token_t token, size_t offset,
+@code{void _gfortran_caf_get (caf_token_t token, size_t offset,
 int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
 gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
 
@@ -3850,13 +3850,13 @@ gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
 compared to the base address of the coarray.
 @item @var{image_index} @tab The ID of the remote image; must be a positive
 number.
-@item @var{dest} @tab intent(in) Array descriptor of the local array to be
-transferred to the remote image
+@item @var{dest} @tab intent(out) Array descriptor of the local array to store
+the data transferred from the remote image
 @item @var{src} @tab intent(in) Array descriptor for the remote image for the
 bounds and the size. The base_addr shall not be accessed.
-@item @var{src_vector} @tab intent(int)  If not NULL, it contains the vector
-subscript of the destination array; the values are relative to the dimension
-triplet of the dest argument.
+@item @var{src_vector} @tab intent(in)  If not NULL, it contains the vector
+subscript of the source array; the values are relative to the dimension
+triplet of the src argument.
 @item @var{dst_kind} @tab Kind of the destination argument
 @item @var{src_kind} @tab Kind of the source argument
 @item @var{may_require_tmp} @tab The variable is false it is known at compile
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 69ddd17..05dfcb4 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3538,38 +3538,38 @@ gfc_build_builtin_function_decls (void)
 	= build_pointer_type (build_pointer_type (pchar_type_node));
 
       gfor_fndecl_caf_init = gfc_build_library_function_decl (
-		   get_identifier (PREFIX("caf_init")),  void_type_node,
-		   2, pint_type, pppchar_type);
+	get_identifier (PREFIX("caf_init")), void_type_node,
+	2, pint_type, pppchar_type);
 
       gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
 
       gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
-		   get_identifier (PREFIX("caf_this_image")), integer_type_node,
-		   1, integer_type_node);
+	get_identifier (PREFIX("caf_this_image")), integer_type_node,
+	1, integer_type_node);
 
       gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
-		   get_identifier (PREFIX("caf_num_images")), integer_type_node,
-		   2, integer_type_node, integer_type_node);
+	get_identifier (PREFIX("caf_num_images")), integer_type_node,
+	2, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
-        size_type_node, integer_type_node, ppvoid_type_node, pint_type,
-        pchar_type_node, integer_type_node);
+	size_type_node, integer_type_node, ppvoid_type_node, pint_type,
+	pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_deregister")), ".WWW", void_type_node, 4,
-        ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);
+	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.RRRWW", void_type_node, 10,
-        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+	get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10,
+	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, pint_type);
 
       gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send")), ".R.RRRRW", void_type_node, 10,
-        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+	get_identifier (PREFIX("caf_send")), ".R.RRRRRRW", void_type_node, 10,
+	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, pint_type);
 
@@ -3606,31 +3606,31 @@ gfc_build_builtin_function_decls (void)
       TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
 
       gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl_with_spec (
-        get_identifier (PREFIX("caf_stop_numeric")), ".R.",
-        void_type_node, 1, gfc_int4_type_node);
+	get_identifier (PREFIX("caf_stop_numeric")), ".R.",
+	void_type_node, 1, gfc_int4_type_node);
       /* CAF's STOP doesn't return.  */
       TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric) = 1;
 
       gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
-        get_identifier (PREFIX("caf_stop_str")), ".R.",
-        void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+	get_identifier (PREFIX("caf_stop_str")), ".R.",
+	void_type_node, 2, pchar_type_node, gfc_int4_type_node);
       /* CAF's STOP doesn't return.  */
       TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str) = 1;
 
       gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_atomic_define")), "R..RW",
 	void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
-        pvoid_type_node, pint_type, integer_type_node, integer_type_node);
+	pvoid_type_node, pint_type, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_atomic_ref")), "R..WW",
 	void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
-        pvoid_type_node, pint_type, integer_type_node, integer_type_node);
+	pvoid_type_node, pint_type, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW",
 	void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node,
-        pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
+	pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
 	integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
@@ -3682,7 +3682,7 @@ gfc_build_builtin_function_decls (void)
       gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_co_reduce")), "W.R.WW",
 	void_type_node, 8, pvoid_type_node,
-        build_pointer_type (build_varargs_function_type_list (void_type_node,
+	build_pointer_type (build_varargs_function_type_list (void_type_node,
 							      NULL_TREE)),
 	integer_type_node, integer_type_node, pint_type, pchar_type_node,
 	integer_type_node, integer_type_node);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c655540..abc1c6d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1122,12 +1122,12 @@ 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);
+  tmp_stat = gfc_find_stat_co (expr);
 
   if (tmp_stat)
     {
       gfc_se stat_se;
-      gfc_init_se(&stat_se, NULL);
+      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);
@@ -1225,7 +1225,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
     may_require_tmp = boolean_false_node;
 
   /* It guarantees memory consistency within the same segment */
-  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
   tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
 		    gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
 		    tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
@@ -1390,7 +1390,7 @@ conv_caf_send (gfc_code *code) {
 
   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
 
-  tmp_stat = gfc_find_stat_co(lhs_expr);
+  tmp_stat = gfc_find_stat_co (lhs_expr);
 
   if (tmp_stat)
     {
@@ -1414,8 +1414,8 @@ conv_caf_send (gfc_code *code) {
       tree rhs_token, rhs_offset, rhs_image_index;
 
       /* It guarantees memory consistency within the same segment */
-      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
-	tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+      tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
+      tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
 			  gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
 			  tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
       ASM_VOLATILE_P (tmp) = 1;
@@ -1438,7 +1438,7 @@ conv_caf_send (gfc_code *code) {
   gfc_add_block_to_block (&block, &rhs_se.post);
 
   /* It guarantees memory consistency within the same segment */
-  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
   tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
 		    gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
 		    tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);

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

[Andre Vehreschild]

[-- Attachment #1: Type: text/plain, Size: 1489 bytes --]

Hi all,

committed the cosmetics patch as r238635.

Regards,
	Andre

On Thu, 21 Jul 2016 14:57:32 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi all,
> 
> the attached patch fixes some style issues in the caf code recently
> modified. Furthermore does it correct the function specifications of 
> caf_get() and caf_send() that where missing some specifiers.
> 
> Bootstrapped and regtested ok on x86_64-linux/F23. If noone objects I
> commit this patch as obvious tomorrow.
> 
> In my pipeline is a patch that will add stat= support to the libcaf
> interface and caf_single.
> 
> Regards,
> 	Andre
> 
> On Tue, 5 Jul 2016 09:33:49 -0600
> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
> 
> > Thanks, committed as rev. 238007.
> > 
> > 2016-07-04 14:41 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:  
> > > Le 30/06/2016 06:05, Alessandro Fanfarillo a écrit :    
> > >>
> > >> Dear Mikael,
> > >>
> > >> thanks for your review and for the test. The attached patch,
> > >> built and regtested for x86_64-pc-linux-gnu, addresses all the
> > >> suggestions.
> > >>
> > >> The next patch will change the documentation related to the
> > >> caf_get and caf_send functions and will add support for STAT= to
> > >> the sendget function.
> > >>
> > >> In the meantime, is this patch OK for trunk?
> > >>    
> > > Yes, thanks.
> > >
> > > Mikael
> > >
> > >    
> 
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 11118 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 238631)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,13 @@
+2016-07-22  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* expr.c (gfc_find_stat_co): Fixed whitespaces.
+	* gfortran.texi: Fixed typos and reversed meaning of caf_get()'s
+	src and dst description.
+	* trans-decl.c (gfc_build_builtin_function_decls): Fixed style
+	and corrected fnspec for caf functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fixed style.
+	(conv_caf_send): Dito.
+
 2016-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/71902
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(Revision 238631)
+++ gcc/fortran/expr.c	(Arbeitskopie)
@@ -4437,9 +4437,9 @@
     if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
       return ref->u.ar.stat;
 
-  if(e->value.function.actual->expr)
-    for(ref = e->value.function.actual->expr->ref; ref;
-	ref = ref->next)
+  if (e->value.function.actual->expr)
+    for (ref = e->value.function.actual->expr->ref; ref;
+	 ref = ref->next)
       if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
 	return ref->u.ar.stat;
 
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi	(Revision 238631)
+++ gcc/fortran/gfortran.texi	(Arbeitskopie)
@@ -3799,7 +3799,7 @@
 number.
 @item @var{dest} @tab intent(in) Array descriptor for the remote image for the
 bounds and the size. The base_addr shall not be accessed.
-@item @var{dst_vector} @tab intent(int)  If not NULL, it contains the vector
+@item @var{dst_vector} @tab intent(in)  If not NULL, it contains the vector
 subscript of the destination array; the values are relative to the dimension
 triplet of the dest argument.
 @item @var{src} @tab intent(in) Array descriptor of the local array to be
@@ -3839,7 +3839,7 @@
 image identified by the image_index.
 
 @item @emph{Syntax}:
-@code{void _gfortran_caf_get_desc (caf_token_t token, size_t offset,
+@code{void _gfortran_caf_get (caf_token_t token, size_t offset,
 int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
 gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
 
@@ -3850,13 +3850,13 @@
 compared to the base address of the coarray.
 @item @var{image_index} @tab The ID of the remote image; must be a positive
 number.
-@item @var{dest} @tab intent(in) Array descriptor of the local array to be
-transferred to the remote image
+@item @var{dest} @tab intent(out) Array descriptor of the local array to store
+the data transferred from the remote image
 @item @var{src} @tab intent(in) Array descriptor for the remote image for the
 bounds and the size. The base_addr shall not be accessed.
-@item @var{src_vector} @tab intent(int)  If not NULL, it contains the vector
-subscript of the destination array; the values are relative to the dimension
-triplet of the dest argument.
+@item @var{src_vector} @tab intent(in)  If not NULL, it contains the vector
+subscript of the source array; the values are relative to the dimension
+triplet of the src argument.
 @item @var{dst_kind} @tab Kind of the destination argument
 @item @var{src_kind} @tab Kind of the source argument
 @item @var{may_require_tmp} @tab The variable is false it is known at compile
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 238631)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -3538,38 +3538,38 @@
 	= build_pointer_type (build_pointer_type (pchar_type_node));
 
       gfor_fndecl_caf_init = gfc_build_library_function_decl (
-		   get_identifier (PREFIX("caf_init")),  void_type_node,
-		   2, pint_type, pppchar_type);
+	get_identifier (PREFIX("caf_init")), void_type_node,
+	2, pint_type, pppchar_type);
 
       gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
 
       gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
-		   get_identifier (PREFIX("caf_this_image")), integer_type_node,
-		   1, integer_type_node);
+	get_identifier (PREFIX("caf_this_image")), integer_type_node,
+	1, integer_type_node);
 
       gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
-		   get_identifier (PREFIX("caf_num_images")), integer_type_node,
-		   2, integer_type_node, integer_type_node);
+	get_identifier (PREFIX("caf_num_images")), integer_type_node,
+	2, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
-        size_type_node, integer_type_node, ppvoid_type_node, pint_type,
-        pchar_type_node, integer_type_node);
+	size_type_node, integer_type_node, ppvoid_type_node, pint_type,
+	pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_deregister")), ".WWW", void_type_node, 4,
-        ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);
+	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.RRRWW", void_type_node, 10,
-        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+	get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10,
+	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, pint_type);
 
       gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send")), ".R.RRRRW", void_type_node, 10,
-        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+	get_identifier (PREFIX("caf_send")), ".R.RRRRRRW", void_type_node, 10,
+	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, pint_type);
 
@@ -3606,14 +3606,14 @@
       TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
 
       gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl_with_spec (
-        get_identifier (PREFIX("caf_stop_numeric")), ".R.",
-        void_type_node, 1, gfc_int4_type_node);
+	get_identifier (PREFIX("caf_stop_numeric")), ".R.",
+	void_type_node, 1, gfc_int4_type_node);
       /* CAF's STOP doesn't return.  */
       TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric) = 1;
 
       gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
-        get_identifier (PREFIX("caf_stop_str")), ".R.",
-        void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+	get_identifier (PREFIX("caf_stop_str")), ".R.",
+	void_type_node, 2, pchar_type_node, gfc_int4_type_node);
       /* CAF's STOP doesn't return.  */
       TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str) = 1;
 
@@ -3620,17 +3620,17 @@
       gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_atomic_define")), "R..RW",
 	void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
-        pvoid_type_node, pint_type, integer_type_node, integer_type_node);
+	pvoid_type_node, pint_type, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_atomic_ref")), "R..WW",
 	void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
-        pvoid_type_node, pint_type, integer_type_node, integer_type_node);
+	pvoid_type_node, pint_type, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW",
 	void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node,
-        pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
+	pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
 	integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
@@ -3682,7 +3682,7 @@
       gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_co_reduce")), "W.R.WW",
 	void_type_node, 8, pvoid_type_node,
-        build_pointer_type (build_varargs_function_type_list (void_type_node,
+	build_pointer_type (build_varargs_function_type_list (void_type_node,
 							      NULL_TREE)),
 	integer_type_node, integer_type_node, pint_type, pchar_type_node,
 	integer_type_node, integer_type_node);
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(Revision 238631)
+++ gcc/fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -1122,12 +1122,12 @@
   dst_var = lhs;
 
   vec = null_pointer_node;
-  tmp_stat = gfc_find_stat_co(expr);
+  tmp_stat = gfc_find_stat_co (expr);
 
   if (tmp_stat)
     {
       gfc_se stat_se;
-      gfc_init_se(&stat_se, NULL);
+      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);
@@ -1225,7 +1225,7 @@
     may_require_tmp = boolean_false_node;
 
   /* It guarantees memory consistency within the same segment */
-  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
   tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
 		    gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
 		    tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
@@ -1390,7 +1390,7 @@
 
   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
 
-  tmp_stat = gfc_find_stat_co(lhs_expr);
+  tmp_stat = gfc_find_stat_co (lhs_expr);
 
   if (tmp_stat)
     {
@@ -1414,8 +1414,8 @@
       tree rhs_token, rhs_offset, rhs_image_index;
 
       /* It guarantees memory consistency within the same segment */
-      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
-	tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+      tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
+      tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
 			  gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
 			  tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
       ASM_VOLATILE_P (tmp) = 1;
@@ -1438,7 +1438,7 @@
   gfc_add_block_to_block (&block, &rhs_se.post);
 
   /* It guarantees memory consistency within the same segment */
-  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
   tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
 		    gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
 		    tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);