diff mbox

[Fortran] Support static coarrays with "automatic" cobounds

Message ID 4DE38ED2.8010405@net-b.de
State New
Headers show

Commit Message

Tobias Burnus May 30, 2011, 12:34 p.m. UTC 
gfortran currently rejects:

subroutine foo(n)
    integer, SAVE :: foo(500)[n, *]

claiming that as SAVE does not work with automatic arrays. The latter is 
correct. ("C513 An automatic object shall not have the SAVE attribute.") 
However, I would argue that "foo" is not an automatic object and thus 
the code is valid: "An automatic data object is a nondummy data object 
with a type parameter or array bound that depends on the value of a 
specification-expr that is not a constant expression.".  -- Note the 
"bound" not "cobound". Cf. "1.3.27 cobound: bound (limit) of a 
codimension" vs. "1.3.17 bound / array bound: limit of a dimension of an 
array".

(Obviously, the bounds need to be constant for a static array, but the 
cobounds are only "virtual": They just exist to calculate the image from 
the coarray index - and vice versa ("image_index()").)

The test program (cf. patch) also compiles with crayftn, but it is 
rejected by both g95 and ifort 12.0. I think that's a bug in g95 and 
ifort, but if possible: please cross check the standard to ensure that I 
did not misread it.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Comments

Tobias Burnus May 31, 2011, 6:38 p.m. UTC | #1 
Tobias Burnus wrote:
> gfortran currently rejects:
> subroutine foo(n)
>    integer, SAVE :: foo(500)[n, *]
> claiming that as SAVE does not work with automatic arrays.

The patch for this has been committed (Rev. 174503) after approval by 
Daniel Kraft on IRC (#gfortran).


Thomas Koenig wrote:
> To me, that sounds a lot like a mistake in the standard.  Maybe ask on 
> c.l.f?

It is not completely clear to me what you mean by mistake. Coarrays are 
kind of special in several respects. Except of deferred-shape coarrays 
(i.e. allocatable coarrays), the codimension is always assumed site, 
independently whether the dimension makes the coarray a scalar, 
explict-size, assumed-size, or assumed-shape array:
   integer :: A[*]
   integer :: B(:,:,:)[4,5:*]
   integer :: C(*)[1:*]
   integer :: D(5)[1:*]
but
   integer, allocatable :: E(:)[:]

This works as the codimension (coshape) does not influence the storage 
but just the index calculation between coindex and image index, when 
accessing remote images. Thus, there is no reason why one should pose 
restrictions on the coshape for static arrays. (By definition, all 
coarrays are either static ("SAVE") or allocatable.)

I think in some cases, it can be really useful. As the size of the 
codimension is only known at run time (it's num_images()), it can make 
sense to define the coshape only at run time - even if the shape itself 
is a compile-time constant.

Another peculiarity is that for a coarray "integer :: A(10,10)[*]" the 
actual argument remains a coarray in: call proc(A), call proc(A(1,1)), 
call proc(A(:,1)), call proc(2:3,4) etc. (I think the actual argument 
needs to be simply contiguous to make this work by preventing 
copy-in/copy-out.) Note: call proc(A[5]) is coindexed, but not a coarray.

Tobias
diff mbox

Patch

2011-05-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* resolve.c (resolve_fl_variable): Handle static coarrays
	with non-constant cobounds.
	(resolve_symbol): Handle SAVE statement without arguments
	for coarrays.
	* trans-array.c (gfc_trans_array_cobounds): New function.
	(gfc_trans_array_bounds): Place code by call to it.
	* trans-array.h (gfc_trans_array_cobounds): New prototype.
	* trans-decl.c (gfc_get_symbol_decl, gfc_trans_deferred_vars):
	Handle static coarrays with nonconstant cobounds.

2011-05-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* gfortran.dg/coarray/save_1.f90: New.
	* gfortran.dg/coarray_4.f90: Update dg-error.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4b18529..6ca98f2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10118,7 +10118,14 @@  resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 
       /* Also, they must not have the SAVE attribute.
 	 SAVE_IMPLICIT is checked below.  */
-      if (sym->attr.save == SAVE_EXPLICIT)
+      if (sym->as && sym->attr.codimension)
+	{
+	  int corank = sym->as->corank;
+	  sym->as->corank = 0;
+	  no_init_flag = automatic_flag = is_non_constant_shape_array (sym);
+	  sym->as->corank = corank;
+	}
+      if (automatic_flag && sym->attr.save == SAVE_EXPLICIT)
 	{
 	  gfc_error (auto_save_msg, sym->name, &sym->declared_at);
 	  return FAILURE;
@@ -12337,6 +12344,7 @@  resolve_symbol (gfc_symbol *sym)
   if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
        || sym->attr.codimension)
       && !(sym->attr.allocatable || sym->attr.dummy || sym->attr.save
+	   || sym->ns->save_all
 	   || sym->ns->proc_name->attr.flavor == FL_MODULE
 	   || sym->ns->proc_name->attr.is_main_program
 	   || sym->attr.function || sym->attr.result || sym->attr.use_assoc))
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index d83a7a9..0c6c638 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4648,6 +4648,43 @@  gfc_conv_array_initializer (tree type, gfc_expr * expr)
 }
 
 
+/* Generate code to evaluate non-constant coarray cobounds.  */
+
+void
+gfc_trans_array_cobounds (tree type, stmtblock_t * pblock,
+			  const gfc_symbol *sym)
+{
+  int dim;
+  tree ubound;
+  tree lbound;
+  gfc_se se;
+  gfc_array_spec *as;
+
+  as = sym->as;
+
+  for (dim = as->rank; dim < as->rank + as->corank; dim++)
+    {
+      /* Evaluate non-constant array bound expressions.  */
+      lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
+      if (as->lower[dim] && !INTEGER_CST_P (lbound))
+        {
+          gfc_init_se (&se, NULL);
+          gfc_conv_expr_type (&se, as->lower[dim], gfc_array_index_type);
+          gfc_add_block_to_block (pblock, &se.pre);
+          gfc_add_modify (pblock, lbound, se.expr);
+        }
+      ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
+      if (as->upper[dim] && !INTEGER_CST_P (ubound))
+        {
+          gfc_init_se (&se, NULL);
+          gfc_conv_expr_type (&se, as->upper[dim], gfc_array_index_type);
+          gfc_add_block_to_block (pblock, &se.pre);
+          gfc_add_modify (pblock, ubound, se.expr);
+        }
+    }
+}
+
+
 /* Generate code to evaluate non-constant array bounds.  Sets *poffset and
    returns the size (in elements) of the array.  */
 
@@ -4728,26 +4765,8 @@  gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
 
       size = stride;
     }
-  for (dim = as->rank; dim < as->rank + as->corank; dim++)
-    {
-      /* Evaluate non-constant array bound expressions.  */
-      lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
-      if (as->lower[dim] && !INTEGER_CST_P (lbound))
-        {
-          gfc_init_se (&se, NULL);
-          gfc_conv_expr_type (&se, as->lower[dim], gfc_array_index_type);
-          gfc_add_block_to_block (pblock, &se.pre);
-          gfc_add_modify (pblock, lbound, se.expr);
-        }
-      ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
-      if (as->upper[dim] && !INTEGER_CST_P (ubound))
-        {
-          gfc_init_se (&se, NULL);
-          gfc_conv_expr_type (&se, as->upper[dim], gfc_array_index_type);
-          gfc_add_block_to_block (pblock, &se.pre);
-          gfc_add_modify (pblock, ubound, se.expr);
-        }
-    }
+
+  gfc_trans_array_cobounds (type, pblock, sym);
   gfc_trans_vla_type_sizes (sym, pblock);
 
   *poffset = offset;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index fef56ae..f29162e 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -132,6 +132,9 @@  tree gfc_conv_array_stride (tree, int);
 tree gfc_conv_array_lbound (tree, int);
 tree gfc_conv_array_ubound (tree, int);
 
+/* Set cobounds of an array.  */
+void gfc_trans_array_cobounds (tree, stmtblock_t *, const gfc_symbol *);
+
 /* Build expressions for accessing components of an array descriptor.  */
 tree gfc_conv_descriptor_data_get (tree);
 tree gfc_conv_descriptor_data_addr (tree);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 299f224..27eca79 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1349,7 +1349,7 @@  gfc_get_symbol_decl (gfc_symbol * sym)
     }
 
   /* Remember this variable for allocation/cleanup.  */
-  if (sym->attr.dimension || sym->attr.allocatable
+  if (sym->attr.dimension || sym->attr.allocatable || sym->attr.codimension
       || (sym->ts.type == BT_CLASS &&
 	  (CLASS_DATA (sym)->attr.dimension
 	   || CLASS_DATA (sym)->attr.allocatable))
@@ -3485,6 +3485,15 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		      gfc_trans_deferred_array (sym, block);
 		    }
 		}
+	      else if (sym->attr.codimension && TREE_STATIC (sym->backend_decl))
+		{
+		  gfc_init_block (&tmpblock);
+		  gfc_trans_array_cobounds (TREE_TYPE (sym->backend_decl),
+					    &tmpblock, sym);
+		  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
+					NULL_TREE);
+		  continue;
+		}
 	      else if (gfc_option.coarray != GFC_FCOARRAY_LIB)
 		{
 		  gfc_save_backend_locus (&loc);
diff --git a/gcc/testsuite/gfortran.dg/coarray_4.f90 b/gcc/testsuite/gfortran.dg/coarray_4.f90
index 5607ec9..be2bc4e 100644
--- a/gcc/testsuite/gfortran.dg/coarray_4.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_4.f90
@@ -18,7 +18,8 @@  subroutine valid(n, c, f)
   save :: k
   integer :: ii = 7
   block
-    integer, save :: kk[ii, *] ! { dg-error "cannot have the SAVE attribute" }
+    integer :: j = 5
+    integer, save :: kk[j, *] ! { dg-error "Variable .j. cannot appear in the expression" }
   end block
 end subroutine valid
 
@@ -43,10 +44,10 @@  subroutine invalid(n)
   complex, save :: hh(n)[*] ! { dg-error "cannot have the SAVE attribute" }
   integer :: j = 6
 
-  integer, save :: hf1[j,*] ! { dg-error "cannot appear in the expression|cannot have the SAVE attribute" }
-  integer, save :: hf2[n,*] ! { dg-error "cannot have the SAVE attribute" }
+  integer, save :: hf1[j,*] ! { dg-error "cannot appear in the expression" }
+  integer, save :: hf2[n,*] ! OK
   integer, save :: hf3(4)[j,*] ! { dg-error "cannot appear in the expression|cannot have the SAVE attribute" }
-  integer, save :: hf4(5)[n,*] ! { dg-error "cannot have the SAVE attribute" }
+  integer, save :: hf4(5)[n,*] ! OK
 
   integer, allocatable :: a2[*] ! { dg-error "must have deferred shape" }
   integer, allocatable :: a3(:)[*] ! { dg-error "must have deferred shape" }