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-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

+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.

gcc/fortran/trans-array.c

@@ -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)

gcc/fortran/trans-types.c

@@ -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);

gcc/fortran/trans.c

@@ -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);
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/coarray_21.f90

+! { 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" } }