2011-06-19 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 19 May 2011 20:53:33 +0000 (20:53 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 19 May 2011 20:53:33 +0000 (20:53 +0000)
        PR fortran/18918
        * trans-types.c (gfc_get_element_type): Handle scalar coarrays.
        (gfc_get_nodesc_array_type): Make a variant-type copy for scalar
        coarrays.
        * trans.c (gfc_build_array_ref): Return original type not
        * variant
        copy for scalar coarrays.
        * trans-array.c (gfc_conv_array_ref): Ditto.

2011-06-19  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_21.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@173920 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-types.c
gcc/fortran/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/coarray_21.f90 [new file with mode: 0644]

index 1fb7947..a6fffdf 100644 (file)
@@ -1,3 +1,13 @@
+2011-06-19  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/18918
+       * trans-types.c (gfc_get_element_type): Handle scalar coarrays.
+       (gfc_get_nodesc_array_type): Make a variant-type copy for scalar
+       coarrays.
+       * trans.c (gfc_build_array_ref): Return original type not variant
+       copy for scalar coarrays.
+       * trans-array.c (gfc_conv_array_ref): Ditto.
+
 2011-05-16  Tobias Burnus  <burnus@net-b.de>
 
        * gfortran.texi (_gfortran_set_options): Add GFC_STD_F2008_TR.
index 1a4ab39..78d65a6 100644 (file)
@@ -2621,7 +2621,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   gfc_se tmpse;
 
   if (ar->dimen == 0)
-    return;
+    {
+      gcc_assert (ar->codimen);
+      /* Use the actual tree type and not the wrapped coarray. */
+      se->expr = fold_convert (TREE_TYPE (TREE_TYPE (se->expr)), se->expr);
+      return;
+    }
 
   /* Handle scalarized references separately.  */
   if (ar->type != AR_ELEMENT)
index 24fdcf3..1165926 100644 (file)
@@ -1100,8 +1100,16 @@ gfc_get_element_type (tree type)
     {
       if (TREE_CODE (type) == POINTER_TYPE)
         type = TREE_TYPE (type);
-      gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
-      element = TREE_TYPE (type);
+      if (GFC_TYPE_ARRAY_RANK (type) == 0)
+       {
+         gcc_assert (GFC_TYPE_ARRAY_CORANK (type) > 0);
+         element = type;
+       }
+      else
+       {
+         gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+         element = TREE_TYPE (type);
+       }
     }
   else
     {
@@ -1412,7 +1420,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
   /* We don't use build_array_type because this does not include include
      lang-specific information (i.e. the bounds of the array) when checking
      for duplicates.  */
-  type = make_node (ARRAY_TYPE);
+  if (as->rank)
+    type = make_node (ARRAY_TYPE);
+  else
+    {
+      type = build_variant_type_copy (etype);
+      TREE_TYPE (type) = etype;
+    }
 
   GFC_ARRAY_TYPE_P (type) = 1;
   TYPE_LANG_SPECIFIC (type)
@@ -1526,6 +1540,23 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
       build_qualified_type (GFC_TYPE_ARRAY_DATAPTR_TYPE (type),
                            TYPE_QUAL_RESTRICT);
 
+  if (as->rank == 0)
+    {
+      if (packed != PACKED_STATIC)
+       type = build_pointer_type (type);
+
+      if (restricted)
+        type = build_qualified_type (type, TYPE_QUAL_RESTRICT);        
+
+      if (packed != PACKED_STATIC)
+       {
+         GFC_ARRAY_TYPE_P (type) = 1;
+         TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type)); 
+       }
+
+      return type;
+    }
+
   if (known_stride)
     {
       mpz_sub_ui (stride, stride, 1);
index 1d25cb0..fcbb850 100644 (file)
@@ -316,6 +316,13 @@ gfc_build_array_ref (tree base, tree offset, tree decl)
   tree type = TREE_TYPE (base);
   tree tmp;
 
+  if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
+    {
+      gcc_assert (GFC_TYPE_ARRAY_CORANK (type) > 0);
+
+      return fold_convert (TREE_TYPE (type), base);
+    }
+
   gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
   type = TREE_TYPE (type);
 
index 7a9dacd..c3a1f83 100644 (file)
@@ -1,3 +1,8 @@
+2011-06-19  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/18918
+       * gfortran.dg/coarray_21.f90: New.
+
 2011-05-19  Joseph Myers  <joseph@codesourcery.com>
 
        * lib/prune.exe (prune_gcc_output): Expect "error:" in collect2
diff --git a/gcc/testsuite/gfortran.dg/coarray_21.f90 b/gcc/testsuite/gfortran.dg/coarray_21.f90
new file mode 100644 (file)
index 0000000..8aa0aa6
--- /dev/null
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Before scalar coarrays weren't regarded as scalar in the ME.
+!
+module mod_reduction
+  real :: g[*]
+contains
+  subroutine caf_reduce(x)
+    real, intent(in) :: x
+       g = x  ! << used to ICE
+  end
+end module
+
+program test
+  integer, parameter :: size = 4000
+  type :: pct
+    integer, allocatable :: data(:,:)
+  end type
+  type(pct) :: picture[*]
+     allocate(picture%data(size, size))
+end program test
+
+
+! { dg-final { cleanup-modules "mod_reduction" } }