Patchwork [Fortran] Fix allocatable scalar coarray components

login
register
mail settings
Submitter Tobias Burnus
Date Aug. 25, 2011, 2:39 p.m.
Message ID <4E565E89.7020108@net-b.de>
Download mbox | patch
Permalink /patch/111579/
State New
Headers show

Comments

Tobias Burnus - Aug. 25, 2011, 2:39 p.m.
Scalar coarray components didn't use the array descriptor, which caused 
all kinds of ICEs.

Fix by this relatively simple patch.
OK for the trunk?

  * * *

Pending coarray patch for -fcoarray=lib: Add support for assumed-shape 
coarray dummies (passing offset and token); see 
http://gcc.gnu.org/ml/fortran/2011-08/msg00182.html

Regarding -fcoarray=single: I would claim gfortran has full coarray 
support, except for polymorphic coarrays (depends on polymorphic arrays 
support) and another issue with allocatable coarray components and 
assignment, which will be fixed soon.

Tobias
Thomas Koenig - Aug. 25, 2011, 3:15 p.m.
Am 25.08.2011 16:39, schrieb Tobias Burnus:
> Scalar coarray components didn't use the array descriptor, which caused
> all kinds of ICEs.
>
> Fix by this relatively simple patch.
> OK for the trunk?

OK (bordering on obvious, although I'm not sure which side of the border :-)

Thanks for the patch!

	Thomas

Patch

2011-08-25  Tobias Burnus  <burnus@net-b.de>

	* trans-array.c (structure_alloc_comps): Fix for allocatable
	scalar coarray components.
	* trans-expr.c (gfc_conv_component_ref): Ditto.
	* trans-type.c (gfc_get_derived_type): Ditto.

2011-08-25  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/coarray/alloc_comp_1.f90: New.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 3a75658..6dc1e17 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6798,7 +6799,8 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 
-	  if (c->attr.allocatable && c->attr.dimension)
+	  if (c->attr.allocatable
+	      && (c->attr.dimension || c->attr.codimension))
 	    {
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
@@ -6845,7 +6847,8 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	case NULLIFY_ALLOC_COMP:
 	  if (c->attr.pointer)
 	    continue;
-	  else if (c->attr.allocatable && c->attr.dimension)
+	  else if (c->attr.allocatable
+		   && (c->attr.dimension|| c->attr.codimension))
 	    {
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 39a83ce..6f93d6f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -564,7 +564,8 @@  gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
       se->string_length = tmp;
     }
 
-  if (((c->attr.pointer || c->attr.allocatable) && c->attr.dimension == 0
+  if (((c->attr.pointer || c->attr.allocatable)
+       && (!c->attr.dimension && !c->attr.codimension)
        && c->ts.type != BT_CHARACTER)
       || c->attr.proc_pointer)
     se->expr = build_fold_indirect_ref_loc (input_location,
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index bec2a11..f66878a 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2395,7 +2400,7 @@  gfc_get_derived_type (gfc_symbol * derived)
 
       /* This returns an array descriptor type.  Initialization may be
          required.  */
-      if (c->attr.dimension && !c->attr.proc_pointer)
+      if ((c->attr.dimension || c->attr.codimension) && !c->attr.proc_pointer )
 	{
 	  if (c->attr.pointer || c->attr.allocatable)
 	    {
--- /dev/null	2011-08-24 07:52:14.631885245 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/alloc_comp_1.f90	2011-08-25 15:50:07.000000000 +0200
@@ -0,0 +1,16 @@ 
+! { dg-do run }
+!
+! Allocatable scalar corrays were mishandled (ICE)
+!
+type t
+  integer, allocatable :: caf[:]
+end type t
+type(t) :: a
+allocate (a%caf[3:*])
+a%caf = 7
+!print *, a%caf
+if (a%caf /= 7) call abort ()
+if (any (lcobound (a%caf) /= [ 3 ]) &
+    .or. ucobound (a%caf, dim=1) /= this_image ()+2)  &
+  call abort ()
+end