[Patch, Fortran] Support allocatable *scalar* coarrays

[Patch, Fortran] Support allocatable *scalar* coarrays

[Tobias Burnus]

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

This patch implemented the trans*.c part of allocatable scalar coarrays; 
contrary to noncoarray allocatable scalars, they have cobounds and thus 
use an array descriptor.

While there are still some bugs and minor omissions, gfortran slowly 
gets feature compile with regards to single-image coarrays support. 
Still to be done: Fixes to LOCK_TYPE constraint checks, polymorphic 
coarrays, some issues with coarray dummies, some issues with allocatable 
coarray components.

The patch also works with -fcoarray=lib. However, the to-do list for 
libcaf is much longer. On the front-end side, there are additional 
issues with argument passing, deallocate, some minor allocate issues 
("token"), and in particular calling the library for actual 
communication, for locking and for atomic access. Additionally, the 
message-processing loop in the library is still missing.

The attached patch was build and regtested on x86-64-linux.
OK for the trunk?

Tobias

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

2011-07-10  Tobias Burnus  <burnus@net-b.de>

	* expr.c (gfc_ref_this_image): New function.
	(gfc_is_coindexed): Use it.
	* gfortran.h (gfc_ref_this_image): New prototype.
	* resolve.c (resolve_deallocate_expr,
	resolve_allocate_expr): Support alloc scalar coarrays.
	* trans-array.c (gfc_conv_array_ref, gfc_array_init_size,
	gfc_conv_descriptor_cosize, gfc_array_allocate,
	gfc_trans_deferred_array): Ditto.
	* trans-expr.c (gfc_conv_variable) Ditto.:
	* trans-stmt.c (gfc_trans_deallocate): Ditto.
	* trans-types.c (gfc_get_element_type, gfc_get_array_type_bounds
	gfc_get_array_descr_info): Ditto.

2011-07-10  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/coarray_14.f90: Remove dg-error "sorry not implemented".
	* gfortran.dg/coarray_7.f90: Ditto.
	* gfortran.dg/coarray/scalar_alloc_1.f90: New.
	* gfortran.dg/coarray/scalar_alloc_2.f90: New.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6db0836..3bf1e94 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4126,18 +4126,28 @@ gfc_expr_replace_comp (gfc_expr *expr, gfc_component *dest)
 
 
 bool
+gfc_ref_this_image (gfc_ref *ref)
+{
+  int n;
+
+  gcc_assert (ref->type == REF_ARRAY && ref->u.ar.codimen > 0);
+
+  for (n = ref->u.ar.dimen; n < ref->u.ar.dimen + ref->u.ar.codimen; n++)
+    if (ref->u.ar.dimen_type[n] != DIMEN_THIS_IMAGE)
+      return false;
+
+  return true;
+}
+
+
+bool
 gfc_is_coindexed (gfc_expr *e)
 {
   gfc_ref *ref;
 
   for (ref = e->ref; ref; ref = ref->next)
     if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
-      {
-	int n;
-	for (n = ref->u.ar.dimen; n < ref->u.ar.dimen + ref->u.ar.codimen; n++)
-	  if (ref->u.ar.dimen_type[n] != DIMEN_THIS_IMAGE)
-	    return true;
-      }
+      return !gfc_ref_this_image (ref);
 
   return false;
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 328dfbe..eb01b0e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2733,6 +2733,7 @@ void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
 
 bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
 
+bool gfc_ref_this_image (gfc_ref *ref);
 bool gfc_is_coindexed (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b51ae96..07104b8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6460,7 +6460,9 @@ resolve_deallocate_expr (gfc_expr *e)
       switch (ref->type)
 	{
 	case REF_ARRAY:
-	  if (ref->u.ar.type != AR_FULL)
+	  if (ref->u.ar.type != AR_FULL
+	      && !(ref->u.ar.type == AR_ELEMENT && ref->u.ar.as->rank == 0
+	           && ref->u.ar.codimen && gfc_ref_this_image (ref)))
 	    allocatable = 0;
 	  break;
 
@@ -6983,13 +6985,6 @@ check_symbols:
       goto failure;
     }
 
-  if (codimension && ar->as->rank == 0)
-    {
-      gfc_error ("Sorry, allocatable scalar coarrays are not yet supported "
-		 "at %L", &e->where);
-      goto failure;
-    }
-
 success:
   return SUCCESS;
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f4f79f9..4ec892b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2623,12 +2623,20 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   if (ar->dimen == 0)
     {
       gcc_assert (ar->codimen);
-      if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
-	  && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
-	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
 
-      /* Use the actual tree type and not the wrapped coarray. */
-      se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)), se->expr);
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
+	se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
+      else
+	{
+	  if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
+	      && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
+	    se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+	
+	  /* Use the actual tree type and not the wrapped coarray. */
+	  se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)),
+				   se->expr);
+	}
+
       return;
     }
 
@@ -4139,7 +4147,11 @@ gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
 	overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0);
 	stride = stride * size;
       }
+    for (n = rank; n < rank+corank; n++)
+      (Set lcobound/ucobound as above.)
     element_size = sizeof (array element);
+    if (!rank)
+      return element_size
     stride = (size_t) stride;
     overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
     stride = stride * element_size;
@@ -4309,6 +4321,10 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
   /* Convert to size_t.  */
   element_size = fold_convert (size_type_node, tmp);
+
+  if (rank == 0)
+    return element_size;
+
   stride = fold_convert (size_type_node, stride);
 
   /* First check for overflow. Since an array of type character can
@@ -4370,18 +4386,18 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 {
   tree tmp;
   tree pointer;
-  tree offset;
+  tree offset = NULL_TREE;
   tree size;
   tree msg;
-  tree error;
+  tree error = NULL_TREE;
   tree overflow; /* Boolean storing whether size calculation overflows.  */
-  tree var_overflow;
+  tree var_overflow = NULL_TREE;
   tree cond;
   stmtblock_t elseblock;
   gfc_expr **lower;
   gfc_expr **upper;
   gfc_ref *ref, *prev_ref = NULL;
-  bool allocatable, coarray;
+  bool allocatable, coarray, dimension;
 
   ref = expr->ref;
 
@@ -4401,20 +4417,17 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
     {
       allocatable = expr->symtree->n.sym->attr.allocatable;
       coarray = expr->symtree->n.sym->attr.codimension;
+      dimension = expr->symtree->n.sym->attr.dimension;
     }
   else
     {
       allocatable = prev_ref->u.c.component->attr.allocatable;
       coarray = prev_ref->u.c.component->attr.codimension;
+      dimension = prev_ref->u.c.component->attr.dimension;
     }
 
-  /* Return if this is a scalar coarray.  */
-  if ((!prev_ref && !expr->symtree->n.sym->attr.dimension)
-      || (prev_ref && !prev_ref->u.c.component->attr.dimension))
-    {
-      gcc_assert (coarray);
-      return false;
-    }
+  if (!dimension)
+    gcc_assert (coarray);
 
   /* Figure out the size of the array.  */
   switch (ref->u.ar.type)
@@ -4449,16 +4462,20 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
   size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
 			      ref->u.ar.as->corank, &offset, lower, upper,
 			      &se->pre, &overflow);
+  if (dimension)
+    {
 
-  var_overflow = gfc_create_var (integer_type_node, "overflow");
-  gfc_add_modify (&se->pre, var_overflow, overflow);
+      var_overflow = gfc_create_var (integer_type_node, "overflow");
+      gfc_add_modify (&se->pre, var_overflow, overflow);
 
-  /* Generate the block of code handling overflow.  */
-  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
+      /* Generate the block of code handling overflow.  */
+      msg = gfc_build_addr_expr (pchar_type_node,
+		gfc_build_localized_cstring_const
   			("Integer overflow when calculating the amount of "
   			 "memory to allocate"));
-  error = build_call_expr_loc (input_location,
-  			   gfor_fndecl_runtime_error, 1, msg);
+      error = build_call_expr_loc (input_location, gfor_fndecl_runtime_error,
+				   1, msg);
+    }
 
   if (pstat != NULL_TREE && !integer_zerop (pstat))
     {
@@ -4495,14 +4512,20 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 
   gfc_add_expr_to_block (&elseblock, tmp);
 
-  cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-					var_overflow, integer_zero_node));
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, 
-			 error, gfc_finish_block (&elseblock));
+  if (dimension)
+    {
+      cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
+			   boolean_type_node, var_overflow, integer_zero_node));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, 
+			     error, gfc_finish_block (&elseblock));
+    }
+  else
+    tmp = gfc_finish_block (&elseblock);
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
+  if (dimension)
+    gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
 
   if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
 	&& expr->ts.u.derived->attr.alloc_comp)
@@ -7446,7 +7469,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
       gfc_add_expr_to_block (&cleanup, tmp);
     }
 
-  if (sym->attr.allocatable && sym->attr.dimension
+  if (sym->attr.allocatable && (sym->attr.dimension || sym->attr.codimension)
       && !sym->attr.save && !sym->attr.result)
     {
       tmp = gfc_trans_dealloc_allocated (sym->backend_decl);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7383265..55a0fc4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -691,8 +691,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	}
       else if (!sym->attr.value)
 	{
-          /* Dereference non-character scalar dummy arguments.  */
-	  if (sym->attr.dummy && !sym->attr.dimension)
+	  /* Dereference non-character scalar dummy arguments.  */
+	  if (sym->attr.dummy && !sym->attr.dimension
+	      && !(sym->attr.codimension && sym->attr.allocatable))
 	    se->expr = build_fold_indirect_ref_loc (input_location,
 						se->expr);
 
@@ -711,7 +712,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	      && (sym->attr.dummy
 		  || sym->attr.function
 		  || sym->attr.result
-		  || !sym->attr.dimension))
+		  || (!sym->attr.dimension
+		      && (!sym->attr.codimension || !sym->attr.allocatable))))
 	    se->expr = build_fold_indirect_ref_loc (input_location,
 						se->expr);
 	}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 88fdcd1..5aa0ca9 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5104,7 +5104,7 @@ gfc_trans_deallocate (gfc_code *code)
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
-      if (expr->rank)
+      if (expr->rank || gfc_expr_attr (expr).codimension)
 	{
 	  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
 	    {
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 6d384be..d7f1dd5 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1125,8 +1125,9 @@ gfc_get_element_type (tree type)
       gcc_assert (TREE_CODE (element) == POINTER_TYPE);
       element = TREE_TYPE (element);
 
-      gcc_assert (TREE_CODE (element) == ARRAY_TYPE);
-      element = TREE_TYPE (element);
+      /* For arrays, which are not scalar coarrays.  */
+      if (TREE_CODE (element) == ARRAY_TYPE)
+	element = TREE_TYPE (element);
     }
 
   return element;
@@ -1770,6 +1771,16 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
   /* TODO: known offsets for descriptors.  */
   GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
 
+  if (dimen == 0)
+    {
+      arraytype =  build_pointer_type (etype);
+      if (restricted)
+	arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
+
+      GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
+      return fat_type;
+    }
+
   /* We define data as an array with the correct size if possible.
      Much better than doing pointer arithmetic.  */
   if (stride)
@@ -2835,8 +2846,11 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
   etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
   gcc_assert (POINTER_TYPE_P (etype));
   etype = TREE_TYPE (etype);
-  gcc_assert (TREE_CODE (etype) == ARRAY_TYPE);
-  etype = TREE_TYPE (etype);
+
+  /* If the type is not a scalar coarray.  */
+  if (TREE_CODE (etype) == ARRAY_TYPE)
+    etype = TREE_TYPE (etype);
+
   /* Can't handle variable sized elements yet.  */
   if (int_size_in_bytes (etype) <= 0)
     return false;
diff --git a/gcc/testsuite/gfortran.dg/coarray_14.f90 b/gcc/testsuite/gfortran.dg/coarray_14.f90
index 3e3f046..49188d6 100644
--- a/gcc/testsuite/gfortran.dg/coarray_14.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_14.f90
@@ -49,7 +49,7 @@ type t
 end type t
 type(t), allocatable :: a[:]
  allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" }
-allocate (t :: a[*]) ! { dg-error "allocatable scalar coarrays are not yet supported" }
+allocate (t :: a[*]) ! OK
 end program myTest
 
 ! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_7.f90 b/gcc/testsuite/gfortran.dg/coarray_7.f90
index 29af0d1..abbd64d 100644
--- a/gcc/testsuite/gfortran.dg/coarray_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_7.f90
@@ -90,7 +90,7 @@ type(t), allocatable :: b(:)[:], C[:]
 
 allocate(b(1)) ! { dg-error "Coarray specification" }
 allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
-allocate(c[*]) ! { dg-error "Sorry" }
+allocate(c[*]) ! OK
 allocate(a%a(5)) ! OK
 end subroutine alloc
 
@@ -151,9 +151,9 @@ subroutine allocateTest()
   integer :: n, q
   n = 1
   q = 1
-  allocate(a[q,*]) ! { dg-error "Sorry" }
-  allocate(b[q,*]) ! { dg-error "Sorry" }
-  allocate(c[q,*]) ! { dg-error "Sorry" }
+  allocate(a[q,*]) ! OK
+  allocate(b[q,*]) ! OK
+  allocate(c[q,*]) ! OK
 end subroutine allocateTest
 
 
--- /dev/null	2011-07-10 08:01:05.659884893 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90	2011-07-10 20:22:18.000000000 +0200
@@ -0,0 +1,50 @@
+! { dg-do run }
+!
+implicit none
+integer, allocatable :: A[:], B[:,:]
+integer :: n1, n2, n3
+
+if (allocated (a)) call abort ()
+if (allocated (b)) call abort ()
+
+allocate(a[*])
+a = 5 + this_image ()
+if (a[this_image ()] /= 5 + this_image ()) call abort
+
+a[this_image ()] = 8 - 2*this_image ()
+if (a[this_image ()] /= 8 - 2*this_image ()) call abort
+
+if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
+  call abort ()
+deallocate(a)
+
+allocate(a[4:*])
+a[this_image ()] = 8 - 2*this_image ()
+
+if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
+  call abort ()
+
+n1 = -1
+n2 = 5
+n3 = 3
+allocate (B[n1:n2, n3:*])
+if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
+  call abort()
+call sub(A, B)
+
+if (allocated (a)) call abort ()
+if (.not.allocated (b)) call abort ()
+
+! automatically deallocate "B"
+contains
+  subroutine sub(x, y)
+    integer, allocatable :: x[:], y[:,:]
+
+    if (any (lcobound(y) /= [-1, 3]) .or. lcobound(y, dim=2) /= n3) &
+      call abort()
+    if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
+      call abort ()
+    if (x[this_image ()] /= 8 - 2*this_image ()) call abort
+    deallocate(x)
+  end subroutine sub
+end
--- /dev/null	2011-07-10 08:01:05.659884893 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_2.f90	2011-07-10 20:18:11.000000000 +0200
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! Check whether registering allocatable coarrays works
+!
+type position
+  real :: x, y, z
+end type position
+
+integer, allocatable :: a[:]
+type(position), allocatable :: p[:]
+
+allocate(a[*])
+a = 7
+
+allocate(p[*])
+p%x = 11
+p%y = 13
+p%z = 15
+
+if (a /= 7) call abort()
+a = 88
+if (a /= 88) call abort()
+
+if (p%x /= 11) call abort()
+p%x = 17
+if (p%x /= 17) call abort()
+
+ block
+   integer, allocatable :: b[:]
+
+   allocate(b[*])
+   b = 8494
+   
+   if (b /= 8494) call abort()
+ end block
+
+if (a /= 88) call abort()
+call test ()
+end
+
+subroutine test()
+  type velocity
+    real :: x, y, z
+  end type velocity
+
+  real, allocatable :: z[:]
+  type(velocity), allocatable :: v[:]
+
+  allocate(z[*])
+  z = sqrt(2.0)
+
+  allocate(v[*])
+  v%x = 21
+  v%y = 23
+  v%z = 25
+
+  if (z /= sqrt(2.0)) call abort()
+  if (v%x /= 21) call abort()
+
+end subroutine test

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Tobias Burnus]

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

On 07/10/2011 09:56 PM, Tobias Burnus wrote:
> This patch implemented the trans*.c part of allocatable scalar 
> coarrays; contrary to noncoarray allocatable scalars, they have 
> cobounds and thus use an array descriptor.

I found a test case (part of Reinhold Bader's fortran_tests), which gave 
an ICE: Allocatable scalar coarrays with SAVE.

I have fixed that (trans-decl.c) and added a test.

> The attached patch was build and regtested on x86-64-linux.
> OK for the trunk?

Tobias

[-- Attachment #2: caf_alloc_scalar-v2.diff --]
[-- Type: text/x-patch, Size: 17644 bytes --]

2011-07-11  Tobias Burnus  <burnus@net-b.de>

	* expr.c (gfc_ref_this_image): New function.
	(gfc_is_coindexed): Use it.
	* gfortran.h (gfc_ref_this_image): New prototype.
	* resolve.c (resolve_deallocate_expr,
	resolve_allocate_expr): Support alloc scalar coarrays.
	* trans-array.c (gfc_conv_array_ref, gfc_array_init_size,
	gfc_conv_descriptor_cosize, gfc_array_allocate,
	gfc_trans_deferred_array): Ditto.
	* trans-expr.c (gfc_conv_variable) Ditto.:
	* trans-stmt.c (gfc_trans_deallocate): Ditto.
	* trans-types.c (gfc_get_element_type, gfc_get_array_type_bounds
	gfc_get_array_descr_info): Ditto.
	* trans-decl.c (gfc_get_symbol_decl): Ditto.

2011-07-11  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/coarray_14.f90: Remove dg-error "sorry not implemented".
	* gfortran.dg/coarray_7.f90: Ditto.
	* gfortran.dg/coarray/scalar_alloc_1.f90: New.
	* gfortran.dg/coarray/scalar_alloc_2.f90: New.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6db0836..3bf1e94 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4126,18 +4126,28 @@ gfc_expr_replace_comp (gfc_expr *expr, gfc_component *dest)
 
 
 bool
+gfc_ref_this_image (gfc_ref *ref)
+{
+  int n;
+
+  gcc_assert (ref->type == REF_ARRAY && ref->u.ar.codimen > 0);
+
+  for (n = ref->u.ar.dimen; n < ref->u.ar.dimen + ref->u.ar.codimen; n++)
+    if (ref->u.ar.dimen_type[n] != DIMEN_THIS_IMAGE)
+      return false;
+
+  return true;
+}
+
+
+bool
 gfc_is_coindexed (gfc_expr *e)
 {
   gfc_ref *ref;
 
   for (ref = e->ref; ref; ref = ref->next)
     if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
-      {
-	int n;
-	for (n = ref->u.ar.dimen; n < ref->u.ar.dimen + ref->u.ar.codimen; n++)
-	  if (ref->u.ar.dimen_type[n] != DIMEN_THIS_IMAGE)
-	    return true;
-      }
+      return !gfc_ref_this_image (ref);
 
   return false;
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 328dfbe..eb01b0e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2733,6 +2733,7 @@ void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
 
 bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
 
+bool gfc_ref_this_image (gfc_ref *ref);
 bool gfc_is_coindexed (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b51ae96..07104b8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6460,7 +6460,9 @@ resolve_deallocate_expr (gfc_expr *e)
       switch (ref->type)
 	{
 	case REF_ARRAY:
-	  if (ref->u.ar.type != AR_FULL)
+	  if (ref->u.ar.type != AR_FULL
+	      && !(ref->u.ar.type == AR_ELEMENT && ref->u.ar.as->rank == 0
+	           && ref->u.ar.codimen && gfc_ref_this_image (ref)))
 	    allocatable = 0;
 	  break;
 
@@ -6983,13 +6985,6 @@ check_symbols:
       goto failure;
     }
 
-  if (codimension && ar->as->rank == 0)
-    {
-      gfc_error ("Sorry, allocatable scalar coarrays are not yet supported "
-		 "at %L", &e->where);
-      goto failure;
-    }
-
 success:
   return SUCCESS;
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f4f79f9..4ec892b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2623,12 +2623,20 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   if (ar->dimen == 0)
     {
       gcc_assert (ar->codimen);
-      if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
-	  && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
-	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
 
-      /* Use the actual tree type and not the wrapped coarray. */
-      se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)), se->expr);
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
+	se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
+      else
+	{
+	  if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
+	      && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
+	    se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+	
+	  /* Use the actual tree type and not the wrapped coarray. */
+	  se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)),
+				   se->expr);
+	}
+
       return;
     }
 
@@ -4139,7 +4147,11 @@ gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
 	overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0);
 	stride = stride * size;
       }
+    for (n = rank; n < rank+corank; n++)
+      (Set lcobound/ucobound as above.)
     element_size = sizeof (array element);
+    if (!rank)
+      return element_size
     stride = (size_t) stride;
     overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
     stride = stride * element_size;
@@ -4309,6 +4321,10 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
   /* Convert to size_t.  */
   element_size = fold_convert (size_type_node, tmp);
+
+  if (rank == 0)
+    return element_size;
+
   stride = fold_convert (size_type_node, stride);
 
   /* First check for overflow. Since an array of type character can
@@ -4370,18 +4386,18 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 {
   tree tmp;
   tree pointer;
-  tree offset;
+  tree offset = NULL_TREE;
   tree size;
   tree msg;
-  tree error;
+  tree error = NULL_TREE;
   tree overflow; /* Boolean storing whether size calculation overflows.  */
-  tree var_overflow;
+  tree var_overflow = NULL_TREE;
   tree cond;
   stmtblock_t elseblock;
   gfc_expr **lower;
   gfc_expr **upper;
   gfc_ref *ref, *prev_ref = NULL;
-  bool allocatable, coarray;
+  bool allocatable, coarray, dimension;
 
   ref = expr->ref;
 
@@ -4401,20 +4417,17 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
     {
       allocatable = expr->symtree->n.sym->attr.allocatable;
       coarray = expr->symtree->n.sym->attr.codimension;
+      dimension = expr->symtree->n.sym->attr.dimension;
     }
   else
     {
       allocatable = prev_ref->u.c.component->attr.allocatable;
       coarray = prev_ref->u.c.component->attr.codimension;
+      dimension = prev_ref->u.c.component->attr.dimension;
     }
 
-  /* Return if this is a scalar coarray.  */
-  if ((!prev_ref && !expr->symtree->n.sym->attr.dimension)
-      || (prev_ref && !prev_ref->u.c.component->attr.dimension))
-    {
-      gcc_assert (coarray);
-      return false;
-    }
+  if (!dimension)
+    gcc_assert (coarray);
 
   /* Figure out the size of the array.  */
   switch (ref->u.ar.type)
@@ -4449,16 +4462,20 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
   size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
 			      ref->u.ar.as->corank, &offset, lower, upper,
 			      &se->pre, &overflow);
+  if (dimension)
+    {
 
-  var_overflow = gfc_create_var (integer_type_node, "overflow");
-  gfc_add_modify (&se->pre, var_overflow, overflow);
+      var_overflow = gfc_create_var (integer_type_node, "overflow");
+      gfc_add_modify (&se->pre, var_overflow, overflow);
 
-  /* Generate the block of code handling overflow.  */
-  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
+      /* Generate the block of code handling overflow.  */
+      msg = gfc_build_addr_expr (pchar_type_node,
+		gfc_build_localized_cstring_const
   			("Integer overflow when calculating the amount of "
   			 "memory to allocate"));
-  error = build_call_expr_loc (input_location,
-  			   gfor_fndecl_runtime_error, 1, msg);
+      error = build_call_expr_loc (input_location, gfor_fndecl_runtime_error,
+				   1, msg);
+    }
 
   if (pstat != NULL_TREE && !integer_zerop (pstat))
     {
@@ -4495,14 +4512,20 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 
   gfc_add_expr_to_block (&elseblock, tmp);
 
-  cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-					var_overflow, integer_zero_node));
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, 
-			 error, gfc_finish_block (&elseblock));
+  if (dimension)
+    {
+      cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
+			   boolean_type_node, var_overflow, integer_zero_node));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, 
+			     error, gfc_finish_block (&elseblock));
+    }
+  else
+    tmp = gfc_finish_block (&elseblock);
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
+  if (dimension)
+    gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
 
   if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
 	&& expr->ts.u.derived->attr.alloc_comp)
@@ -7446,7 +7469,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
       gfc_add_expr_to_block (&cleanup, tmp);
     }
 
-  if (sym->attr.allocatable && sym->attr.dimension
+  if (sym->attr.allocatable && (sym->attr.dimension || sym->attr.codimension)
       && !sym->attr.save && !sym->attr.result)
     {
       tmp = gfc_trans_dealloc_allocated (sym->backend_decl);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ddc7c36..96aefa3 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1425,7 +1425,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
 	  || gfc_option.flag_max_stack_var_size == 0
 	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
-      && (gfc_option.coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension))
+      && (gfc_option.coarray != GFC_FCOARRAY_LIB
+	  || !sym->attr.codimension || sym->attr.allocatable))
     {
       /* Add static initializer. For procedures, it is only needed if
 	 SAVE is specified otherwise they need to be reinitialized
@@ -1433,7 +1434,9 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	 in this case due to -fmax-stack-var-size=.  */
       DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
 						  TREE_TYPE (decl),
-						  sym->attr.dimension,
+						  sym->attr.dimension
+						  || (sym->attr.codimension
+						      && sym->attr.allocatable),
 						  sym->attr.pointer
 						  || sym->attr.allocatable,
 						  sym->attr.proc_pointer);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7383265..55a0fc4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -691,8 +691,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	}
       else if (!sym->attr.value)
 	{
-          /* Dereference non-character scalar dummy arguments.  */
-	  if (sym->attr.dummy && !sym->attr.dimension)
+	  /* Dereference non-character scalar dummy arguments.  */
+	  if (sym->attr.dummy && !sym->attr.dimension
+	      && !(sym->attr.codimension && sym->attr.allocatable))
 	    se->expr = build_fold_indirect_ref_loc (input_location,
 						se->expr);
 
@@ -711,7 +712,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	      && (sym->attr.dummy
 		  || sym->attr.function
 		  || sym->attr.result
-		  || !sym->attr.dimension))
+		  || (!sym->attr.dimension
+		      && (!sym->attr.codimension || !sym->attr.allocatable))))
 	    se->expr = build_fold_indirect_ref_loc (input_location,
 						se->expr);
 	}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 88fdcd1..5aa0ca9 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5104,7 +5104,7 @@ gfc_trans_deallocate (gfc_code *code)
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
-      if (expr->rank)
+      if (expr->rank || gfc_expr_attr (expr).codimension)
 	{
 	  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
 	    {
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 6d384be..d7f1dd5 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1125,8 +1125,9 @@ gfc_get_element_type (tree type)
       gcc_assert (TREE_CODE (element) == POINTER_TYPE);
       element = TREE_TYPE (element);
 
-      gcc_assert (TREE_CODE (element) == ARRAY_TYPE);
-      element = TREE_TYPE (element);
+      /* For arrays, which are not scalar coarrays.  */
+      if (TREE_CODE (element) == ARRAY_TYPE)
+	element = TREE_TYPE (element);
     }
 
   return element;
@@ -1770,6 +1771,16 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
   /* TODO: known offsets for descriptors.  */
   GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
 
+  if (dimen == 0)
+    {
+      arraytype =  build_pointer_type (etype);
+      if (restricted)
+	arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
+
+      GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
+      return fat_type;
+    }
+
   /* We define data as an array with the correct size if possible.
      Much better than doing pointer arithmetic.  */
   if (stride)
@@ -2835,8 +2846,11 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
   etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
   gcc_assert (POINTER_TYPE_P (etype));
   etype = TREE_TYPE (etype);
-  gcc_assert (TREE_CODE (etype) == ARRAY_TYPE);
-  etype = TREE_TYPE (etype);
+
+  /* If the type is not a scalar coarray.  */
+  if (TREE_CODE (etype) == ARRAY_TYPE)
+    etype = TREE_TYPE (etype);
+
   /* Can't handle variable sized elements yet.  */
   if (int_size_in_bytes (etype) <= 0)
     return false;
diff --git a/gcc/testsuite/gfortran.dg/coarray_14.f90 b/gcc/testsuite/gfortran.dg/coarray_14.f90
index 3e3f046..49188d6 100644
--- a/gcc/testsuite/gfortran.dg/coarray_14.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_14.f90
@@ -49,7 +49,7 @@ type t
 end type t
 type(t), allocatable :: a[:]
  allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" }
-allocate (t :: a[*]) ! { dg-error "allocatable scalar coarrays are not yet supported" }
+allocate (t :: a[*]) ! OK
 end program myTest
 
 ! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_7.f90 b/gcc/testsuite/gfortran.dg/coarray_7.f90
index 29af0d1..abbd64d 100644
--- a/gcc/testsuite/gfortran.dg/coarray_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_7.f90
@@ -90,7 +90,7 @@ type(t), allocatable :: b(:)[:], C[:]
 
 allocate(b(1)) ! { dg-error "Coarray specification" }
 allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
-allocate(c[*]) ! { dg-error "Sorry" }
+allocate(c[*]) ! OK
 allocate(a%a(5)) ! OK
 end subroutine alloc
 
@@ -151,9 +151,9 @@ subroutine allocateTest()
   integer :: n, q
   n = 1
   q = 1
-  allocate(a[q,*]) ! { dg-error "Sorry" }
-  allocate(b[q,*]) ! { dg-error "Sorry" }
-  allocate(c[q,*]) ! { dg-error "Sorry" }
+  allocate(a[q,*]) ! OK
+  allocate(b[q,*]) ! OK
+  allocate(c[q,*]) ! OK
 end subroutine allocateTest
 
 
--- /dev/null	2011-07-11 07:57:37.363888622 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90	2011-07-11 09:31:34.000000000 +0200
@@ -0,0 +1,68 @@
+! { dg-do run }
+!
+implicit none
+integer, allocatable :: A[:], B[:,:]
+integer :: n1, n2, n3
+
+if (allocated (a)) call abort ()
+if (allocated (b)) call abort ()
+
+allocate(a[*])
+a = 5 + this_image ()
+if (a[this_image ()] /= 5 + this_image ()) call abort
+
+a[this_image ()] = 8 - 2*this_image ()
+if (a[this_image ()] /= 8 - 2*this_image ()) call abort
+
+if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
+  call abort ()
+deallocate(a)
+
+allocate(a[4:*])
+a[this_image ()] = 8 - 2*this_image ()
+
+if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
+  call abort ()
+
+n1 = -1
+n2 = 5
+n3 = 3
+allocate (B[n1:n2, n3:*])
+if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
+  call abort()
+call sub(A, B)
+
+if (allocated (a)) call abort ()
+if (.not.allocated (b)) call abort ()
+
+call two(.true.)
+call two(.false.)
+
+! automatically deallocate "B"
+contains
+  subroutine sub(x, y)
+    integer, allocatable :: x[:], y[:,:]
+
+    if (any (lcobound(y) /= [-1, 3]) .or. lcobound(y, dim=2) /= n3) &
+      call abort()
+    if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
+      call abort ()
+    if (x[this_image ()] /= 8 - 2*this_image ()) call abort
+    deallocate(x)
+  end subroutine sub
+
+  subroutine two(init)
+    logical, intent(in) :: init
+    integer, allocatable, SAVE :: a[:]
+
+    if (init) then
+      if (allocated(a)) call abort()
+      allocate(a[*])
+      a = 45
+   else
+      if (.not. allocated(a)) call abort()
+      if (a /= 45) call abort()
+      deallocate(a)
+    end if
+  end subroutine two
+end
--- /dev/null	2011-07-11 07:57:37.363888622 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_2.f90	2011-07-10 20:18:11.000000000 +0200
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! Check whether registering allocatable coarrays works
+!
+type position
+  real :: x, y, z
+end type position
+
+integer, allocatable :: a[:]
+type(position), allocatable :: p[:]
+
+allocate(a[*])
+a = 7
+
+allocate(p[*])
+p%x = 11
+p%y = 13
+p%z = 15
+
+if (a /= 7) call abort()
+a = 88
+if (a /= 88) call abort()
+
+if (p%x /= 11) call abort()
+p%x = 17
+if (p%x /= 17) call abort()
+
+ block
+   integer, allocatable :: b[:]
+
+   allocate(b[*])
+   b = 8494
+   
+   if (b /= 8494) call abort()
+ end block
+
+if (a /= 88) call abort()
+call test ()
+end
+
+subroutine test()
+  type velocity
+    real :: x, y, z
+  end type velocity
+
+  real, allocatable :: z[:]
+  type(velocity), allocatable :: v[:]
+
+  allocate(z[*])
+  z = sqrt(2.0)
+
+  allocate(v[*])
+  v%x = 21
+  v%y = 23
+  v%z = 25
+
+  if (z /= sqrt(2.0)) call abort()
+  if (v%x /= 21) call abort()
+
+end subroutine test

*ping* - Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Tobias Burnus]

*ping*
http://gcc.gnu.org/ml/fortran/2011-07/msg00106.html

On 07/11/2011 09:49 AM, Tobias Burnus wrote:
> On 07/10/2011 09:56 PM, Tobias Burnus wrote:
>> This patch implemented the trans*.c part of allocatable scalar 
>> coarrays; contrary to noncoarray allocatable scalars, they have 
>> cobounds and thus use an array descriptor.
>
> I found a test case (part of Reinhold Bader's fortran_tests), which 
> gave an ICE: Allocatable scalar coarrays with SAVE.
>
> I have fixed that (trans-decl.c) and added a test.
>
>> The attached patch was build and regtested on x86-64-linux.
>> OK for the trunk?
>
> Tobias

Re: *ping* - Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Tobias Burnus]

Sorry for pinging again, but the patch is large enough to block a bit my 
progress ...

Other pending patches - which should be quickly reviewable::
- http://gcc.gnu.org/ml/fortran/2011-07/msg00170.html
- http://gcc.gnu.org/ml/fortran/2011-07/msg00142.html

Tobias

Tobias Burnus wrote:
> *ping*
> http://gcc.gnu.org/ml/fortran/2011-07/msg00106.html
>
> On 07/11/2011 09:49 AM, Tobias Burnus wrote:
>> On 07/10/2011 09:56 PM, Tobias Burnus wrote:
>>> This patch implemented the trans*.c part of allocatable scalar 
>>> coarrays; contrary to noncoarray allocatable scalars, they have 
>>> cobounds and thus use an array descriptor.
>>
>> I found a test case (part of Reinhold Bader's fortran_tests), which 
>> gave an ICE: Allocatable scalar coarrays with SAVE.
>>
>> I have fixed that (trans-decl.c) and added a test.
>>
>>> The attached patch was build and regtested on x86-64-linux.
>>> OK for the trunk?
>>
>> Tobias
>
>

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Mikael Morin]

On Monday 11 July 2011 09:49:20 Tobias Burnus wrote:
> On 07/10/2011 09:56 PM, Tobias Burnus wrote:
> > This patch implemented the trans*.c part of allocatable scalar
> > coarrays; contrary to noncoarray allocatable scalars, they have
> > cobounds and thus use an array descriptor.
> 
> I found a test case (part of Reinhold Bader's fortran_tests), which gave
> an ICE: Allocatable scalar coarrays with SAVE.
> 
> I have fixed that (trans-decl.c) and added a test.
> 
> > The attached patch was build and regtested on x86-64-linux.
> > OK for the trunk?
> 
> Tobias

Hello, 

let me understand one thing about coarray scalars: despite their name, they 
are arrays, right?
Then when you do in gfc_conv_array_ref:

+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
+       se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
[...]
       return;

you are returning scalar[1] instead of scalar (== scalar[this_image()]) or 
scalar[whatever_image_selector], aren't you?


Sorry for the delay; it seems that the more it goes, the more you are the only 
one who can maintain coarray stuff. :-(

Mikael

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Tobias Burnus]

Mikael Morin wrote:
> let me understand one thing about coarray scalars: despite their name, they
> are arrays, right?

Yes and no. In terms of the language, they are scalars - but they have a 
codimension, e.g.
     integer, save :: A[4:6, 7:*]
is a scalar variable on each image, but it has a coarank of 2 with 
lcobound(A) == [4, 7] and ucobound(A, dim=1) == 7. (The value of 
cobound(A, dim=2) depends on the number of images, it's >= 7 in this 
example.)

In terms of gfortran, nonallocatable coarrays are normal scalars - with 
a lang-specific node attached to them, which contains the cobounds, i.e.,
   GFC_ARRAY_TYPE_P (type) = 1;
   GFC_TYPE_ARRAY_CORANK (type) = as->corank;
with
   GFC_TYPE_ARRAY_LBOUND (type, dim)
containing the trees for dim = (rank + 1) ... (rank + corank).

The same scheme is used for assumed-type coarrays:
   subroutine sub(B, n)
      integer :: B(:)[5:7, n:*]

Note that here that contrary to the dimension, the codimension is not 
":" (i.e. assumed shape) but that it is assumed-size.


For allocatable (scalar) coarrays, one has:
    integer, allocatable :: B[:, :]  ! Note: The coshape is deferred
    ...
    allocate (B[2:3, 5:*])

Again, one has the actual data and the cobounds. For that case, I have 
decided to store the information in the array descriptor of rank == 0 
and dim[0 ... corank-1] for the bounds. Thus, "desc->data" contains the 
scalar but the variable itself is a descriptor (GFC_DESCRIPTOR_TYPE_P). 
The corank is not stored in the descriptor, but as one knows the number 
of codimensions (an explicit interface is required for allocatable 
coarray dummies), one knows the corank.

> Then when you do in gfc_conv_array_ref:
>
> +      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
> +       se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr));
> [...]
>         return;
>
> you are returning scalar[1] instead of scalar (== scalar[this_image()]) or
> scalar[whatever_image_selector], aren't you?

Well, the current implementation supports effectively only a single 
image - for -fcoarray=single on purpose and for -fcoarray=lib because it 
has not yet been implemented.

Later, one has to add some function call for "scalar[<image_numer>]" 
while "scalar" itself is the local variable and can be handled as above. 
The expression of "scalar" ends up having expr->ref->type == REF_ARRAY 
with dimen_type == DIMEN_THIS_IMAGE. That way one can distinguish a 
reference to the local coarray and to a remote coarray (coindexed 
variable); note that "coarray[this_image()]" also counts as 
remote/coindexed.

> Sorry for the delay; it seems that the more it goes, the more you are the only
> one who can maintain coarray stuff. :-(

Well, Daniel Carrera develops into an trans*.c, allocate, 
libgfortran/caf/ expert :-)

Tobias

PS: I should document somewhere how coarrays are implemented internally.

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Steve Kargl]

On Sat, Jul 16, 2011 at 05:25:36PM +0200, Tobias Burnus wrote:
> 
> PS: I should document somewhere how coarrays are implemented internally.

gcc/gcc4x/gcc/fortran/gfc-internals.texi

:-)

-- 
Steve

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Mikael Morin]

On Saturday 16 July 2011 17:25:36 Tobias Burnus wrote:
> Mikael Morin wrote:
> > let me understand one thing about coarray scalars: despite their name,
> > they are arrays, right?
> 
> Yes and no. In terms of the language, they are scalars - but they have a
> codimension, e.g.
>      integer, save :: A[4:6, 7:*]
> is a scalar variable on each image, but it has a coarank of 2 with
> lcobound(A) == [4, 7] and ucobound(A, dim=1) == 7.
ucobound(A, dim=1) == 6 ? Otherwise I'm even more confused.


> > Then when you do in gfc_conv_array_ref:
> > 
> > +      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
> > +       se->expr = build_fold_indirect_ref (gfc_conv_array_data
> > (se->expr)); [...]
> > 
> >         return;
> > 
> > you are returning scalar[1] instead of scalar (== scalar[this_image()])
> > or scalar[whatever_image_selector], aren't you?
> 
> Well, the current implementation supports effectively only a single
> image - for -fcoarray=single on purpose and for -fcoarray=lib because it
> has not yet been implemented.
> 
> Later, one has to add some function call for "scalar[<image_numer>]"
> while "scalar" itself is the local variable and can be handled as above.
Ah, OK; that's where I was misunderstanding coarrays. I was thinking that a 
(possibly out of date) copy of remote images was available locally, like a 
normal array; and with any network exchanges happening during the SYNC* calls 
only.
In fact network traffic happens anywhere there are square brackets, and SYNC* 
are mere iddle waits, right?

> The expression of "scalar" ends up having expr->ref->type == REF_ARRAY
> with dimen_type == DIMEN_THIS_IMAGE. That way one can distinguish a
> reference to the local coarray and to a remote coarray (coindexed
> variable); note that "coarray[this_image()]" also counts as
> remote/coindexed.
While it seems to work well, we would probably have gained some clarity by 
using a separate struct for coarray references. 
For example with the current scheme, array[1,2] has type ARRAY_FULL, but some 
dimen_type are of type DIMEN_ELEMENT. Odd.


> > Sorry for the delay; it seems that the more it goes, the more you are the
> > only one who can maintain coarray stuff. :-(
> 
> Well, Daniel Carrera develops into an trans*.c, allocate,
> libgfortran/caf/ expert :-)
> 


Thanks for all the clarifications. Patch is OK (I guess).

Mikael

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Daniel Carrera]

On 07/16/2011 06:43 PM, Mikael Morin wrote:
>> Well, the current implementation supports effectively only a single
>> image - for -fcoarray=single on purpose and for -fcoarray=lib because it
>> has not yet been implemented.
>>
>> Later, one has to add some function call for "scalar[<image_numer>]"
>> while "scalar" itself is the local variable and can be handled as above.
> Ah, OK; that's where I was misunderstanding coarrays. I was thinking that a
> (possibly out of date) copy of remote images was available locally, like a
> normal array; and with any network exchanges happening during the SYNC* calls
> only.
> In fact network traffic happens anywhere there are square brackets, and SYNC*
> are mere iddle waits, right?

I am no expert, but I'll try to answer:   Yes.


Yes, network traffic happens whenever there are square brackets and no 
copies are stored locally. However, you have no guarantee of how far 
ahead other images are. For example:

real :: foo[:]

foo = this_image()

if (this_image() == 1) then
     foo = foo + foo[2]
end if
if (this_image() == 2) then
     foo = foo + foo[1]
end if


This program could do all sorts of crazy things. As you said, the SYNC 
is a idle wait, just to make processes wait for each other. The 
following program is predictable:

real :: foo[:]

foo = this_image()

sync all

if (this_image() == 1) then
     foo = foo + foo[2]
end if

sync all

if (this_image() == 2) then
     foo = foo + foo[1]
end if


Cheers,
Daniel.
-- 
I'm not overweight, I'm undertall.

Re: [Patch, Fortran] Support allocatable *scalar* coarrays

[Tobias Burnus]

Mikael Morin wrote:
> On Saturday 16 July 2011 17:25:36 Tobias Burnus wrote:
>>       integer, save :: A[4:6, 7:*]
>> is a scalar variable on each image, but it has a coarank of 2 with
>> lcobound(A) == [4, 7] and ucobound(A, dim=1) == 7.
> ucobound(A, dim=1) == 6 ? Otherwise I'm even more confused.

Sorry for the typo. It's indeed 6.

> Ah, OK; that's where I was misunderstanding coarrays. I was thinking that a
> (possibly out of date) copy of remote images was available locally, like a
> normal array; and with any network exchanges happening during the SYNC* calls
> only. In fact network traffic happens anywhere there are square brackets, and SYNC*
> are mere iddle waits, right?

In terms of the Fortran standard: Yes. In terms of the implementation: 
It depends. For the front end: It simply requests to receive (or send) 
remote data when it sees a "[...]" - for pushing data to an remote 
image, it might even be asynchrnous.

However, the current plan for libcaf_mpi is that one has two-sided 
communication; the image which wants to have the content of a remote 
image sends a request - and waits for the answer while continuing to 
process incoming requests. Thus, if the image is unlucky, it has to wait 
until the other image hits a SYNC and can then answer requests. If it is 
lucky, the other image also has some remove access and can directly 
process the request.

Via a helper process, the answer could be provided faster - or via 
one-sided communication - or in case of a shared memory implementation.

> While it seems to work well, we would probably have gained some clarity by
> using a separate struct for coarray references.
> For example with the current scheme, array[1,2] has type ARRAY_FULL, but some
> dimen_type are of type DIMEN_ELEMENT. Odd.

Presumably. The problem is that codimensions act on one hand like normal 
dimensions but on the other hand they are different. When declaring 
them, "rank + corank <= 15", adding them as extra dimension is also 
logical etc. On the other hand, when referencing a local coarray, one 
has no brackets and if there is a bracket, one can only give an element 
(single coarray) and not a range or vector.

> Thanks for all the clarifications. Patch is OK (I guess). 

Thanks for the review!

Tobias