diff mbox

[Fortran] Support allocatable *scalar* coarrays

Message ID 4E1AAB00.2030104@net-b.de
State New
Headers show

Commit Message

Tobias Burnus July 11, 2011, 7:49 a.m. UTC 
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

Comments

Tobias Burnus July 14, 2011, 7:03 a.m. UTC | #1 
*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
Tobias Burnus July 16, 2011, 9:04 a.m. UTC | #2 
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
>
>
Mikael Morin July 16, 2011, 12:59 p.m. UTC | #3 
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
Tobias Burnus July 16, 2011, 3:25 p.m. UTC | #4 
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.
Steve Kargl July 16, 2011, 3:45 p.m. UTC | #5 
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

:-)
Mikael Morin July 16, 2011, 4:43 p.m. UTC | #6 
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
Daniel Carrera July 16, 2011, 5:06 p.m. UTC | #7 
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.
Tobias Burnus July 16, 2011, 5:20 p.m. UTC | #8 
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
diff mbox

Patch

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