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

[Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>]

[-- 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.