expr.c (gfc_ref_this_image): New function.

2011-07-16  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-16  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.

From-SVN: r176358

14 files changed, 257 insertions, 58 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9484523..4321c2f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2011-07-16  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  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/49698
@@ -26,7 +42,7 @@
 	* trans.c (gfc_allocate_with_status): Call _gfortran_caf_register
 	with NULL arguments for (new) stat=/errmsg= arguments.
 
-2011-07-06  Daniel Carrera <dcarrera@gmail.com>
+2011-07-06  Daniel Carrera  <dcarrera@gmail.com>
 
 	* trans-array.c (gfc_array_allocate): Rename allocatable_array to
 	allocatable. Rename function gfc_allocate_array_with_status to
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 7117219..1da3a06 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/ChangeLog b/gcc/testsuite/ChangeLog
index cdc2f2d..258128b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.
+
 2011-07-16  Bernd Schmidt  <bernds@codesourcery.com>
 
 	* gcc.c-torture/execute/ieee/mul-subnormal-single-1.x: Add tic6x-*-*
diff --git a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
new file mode 100644
index 0000000..528dd3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_2.f90
new file mode 100644
index 0000000..50c3dfb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_2.f90
@@ -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
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