2011-06-16  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-16  Tobias Burnus  <burnus@net-b.de>

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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1a4ab39..78d65a6 100644
--- a/gcc/fortran/trans-array.c
+++ b/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)
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 24fdcf3..1165926 100644
--- a/gcc/fortran/trans-types.c
+++ b/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);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 1d25cb0..fcbb850 100644
--- a/gcc/fortran/trans.c
+++ b/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);
 
--- /dev/null	2011-05-15 08:03:38.907894364 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_21.f90	2011-05-15 23:41:43.000000000 +0200
@@ -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" } }
