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

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);