gfortran.h (array_type): New type `AS_IMPLIED_SHAPE'.

2010-08-13  Daniel Kraft  <d@domob.eu>

	* gfortran.h (array_type): New type `AS_IMPLIED_SHAPE'.
	* array.c (gfc_match_array_spec): Match implied-shape specification and
	handle AS_IMPLIED_SHAPE correctly otherwise.
	* decl.c (add_init_expr_to_sym): Set upper bounds for implied-shape.
	(variable_decl): Some checks for implied-shape declaration.
	* resolve.c (resolve_symbol): Assert that array-spec is no longer
	AS_IMPLIED_SHAPE in any case.

2010-08-13  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/implied_shape_1.f08: New test.
	* gfortran.dg/implied_shape_2.f90: New test.
	* gfortran.dg/implied_shape_3.f08: New test.

From-SVN: r163221

gcc/fortran/ChangeLog

+2010-08-13  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (array_type): New type `AS_IMPLIED_SHAPE'.
+	* array.c (gfc_match_array_spec): Match implied-shape specification and
+	handle AS_IMPLIED_SHAPE correctly otherwise.
+	* decl.c (add_init_expr_to_sym): Set upper bounds for implied-shape.
+	(variable_decl): Some checks for implied-shape declaration.
+	* resolve.c (resolve_symbol): Assert that array-spec is no longer
+	AS_IMPLIED_SHAPE in any case.
+
 2010-08-12  Joseph Myers  <joseph@codesourcery.com>
 
 	* lang.opt (MD, MMD): Change to MDX and MMDX.

gcc/fortran/array.c

@@ -463,6 +463,12 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
       as->rank++;
       current_type = match_array_element_spec (as);
 
+      /* Note that current_type == AS_ASSUMED_SIZE for both assumed-size
+	 and implied-shape specifications.  If the rank is at least 2, we can
+	 distinguish between them.  But for rank 1, we currently return
+	 ASSUMED_SIZE; this gets adjusted later when we know for sure
+	 whether the symbol parsed is a PARAMETER or not.  */
+
       if (as->rank == 1)
 	{
 	  if (current_type == AS_UNKNOWN)
@@ -475,6 +481,15 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
 	  case AS_UNKNOWN:
 	    goto cleanup;
 
+	  case AS_IMPLIED_SHAPE:
+	    if (current_type != AS_ASSUMED_SHAPE)
+	      {
+		gfc_error ("Bad array specification for implied-shape"
+			   " array at %C");
+		goto cleanup;
+	      }
+	    break;
+
 	  case AS_EXPLICIT:
 	    if (current_type == AS_ASSUMED_SIZE)
 	      {
@@ -513,6 +528,12 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
 	    goto cleanup;
 
 	  case AS_ASSUMED_SIZE:
+	    if (as->rank == 2 && current_type == AS_ASSUMED_SIZE)
+	      {
+		as->type = AS_IMPLIED_SHAPE;
+		break;
+	      }
+
 	    gfc_error ("Bad specification for assumed size array at %C");
 	    goto cleanup;
 	  }
@@ -570,6 +591,7 @@ coarray:
       else
 	switch (as->cotype)
 	  { /* See how current spec meshes with the existing.  */
+	    case AS_IMPLIED_SHAPE:
 	    case AS_UNKNOWN:
 	      goto cleanup;
 

gcc/fortran/decl.c

@@ -1378,6 +1378,51 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 	    }
 	}
 
+      /* If sym is implied-shape, set its upper bounds from init.  */
+      if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension
+	  && sym->as->type == AS_IMPLIED_SHAPE)
+	{
+	  int dim;
+
+	  if (init->rank == 0)
+	    {
+	      gfc_error ("Can't initialize implied-shape array at %L"
+			 " with scalar", &sym->declared_at);
+	      return FAILURE;
+	    }
+	  gcc_assert (sym->as->rank == init->rank);
+
+	  /* Shape should be present, we get an initialization expression.  */
+	  gcc_assert (init->shape);
+
+	  for (dim = 0; dim < sym->as->rank; ++dim)
+	    {
+	      int k;
+	      gfc_expr* lower;
+	      gfc_expr* e;
+	      
+	      lower = sym->as->lower[dim];
+	      if (lower->expr_type != EXPR_CONSTANT)
+		{
+		  gfc_error ("Non-constant lower bound in implied-shape"
+			     " declaration at %L", &lower->where);
+		  return FAILURE;
+		}
+
+	      /* All dimensions must be without upper bound.  */
+	      gcc_assert (!sym->as->upper[dim]);
+
+	      k = lower->ts.kind;
+	      e = gfc_get_constant_expr (BT_INTEGER, k, &sym->declared_at);
+	      mpz_add (e->value.integer,
+		       lower->value.integer, init->shape[dim]);
+	      mpz_sub_ui (e->value.integer, e->value.integer, 1);
+	      sym->as->upper[dim] = e;
+	    }
+
+	  sym->as->type = AS_EXPLICIT;
+	}
+
       /* Need to check if the expression we initialized this
 	 to was one of the iso_c_binding named constants.  If so,
 	 and we're a parameter (constant), let it be iso_c.
@@ -1650,6 +1695,34 @@ variable_decl (int elem)
   else if (current_as)
     merge_array_spec (current_as, as, true);
 
+  /* At this point, we know for sure if the symbol is PARAMETER and can thus
+     determine (and check) whether it can be implied-shape.  If it
+     was parsed as assumed-size, change it because PARAMETERs can not
+     be assumed-size.  */
+  if (as)
+    {
+      if (as->type == AS_IMPLIED_SHAPE && current_attr.flavor != FL_PARAMETER)
+	{
+	  m = MATCH_ERROR;
+	  gfc_error ("Non-PARAMETER symbol '%s' at %L can't be implied-shape",
+		     name, &var_locus);
+	  goto cleanup;
+	}
+
+      if (as->type == AS_ASSUMED_SIZE && as->rank == 1
+	  && current_attr.flavor == FL_PARAMETER)
+	as->type = AS_IMPLIED_SHAPE;
+
+      if (as->type == AS_IMPLIED_SHAPE
+	  && gfc_notify_std (GFC_STD_F2008,
+			     "Fortran 2008: Implied-shape array at %L",
+			     &var_locus) == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+
   char_len = NULL;
   cl = NULL;
 

gcc/fortran/gfortran.h

@@ -157,7 +157,7 @@ expr_t;
 /* Array types.  */
 typedef enum
 { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
-  AS_ASSUMED_SIZE, AS_UNKNOWN
+  AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
 }
 array_type;
 

gcc/fortran/resolve.c

@@ -11673,20 +11673,24 @@ resolve_symbol (gfc_symbol *sym)
     }
 
   /* Assumed size arrays and assumed shape arrays must be dummy
-     arguments.  */
+     arguments.  Array-spec's of implied-shape should have been resolved to
+     AS_EXPLICIT already.  */
 
-  if (sym->as != NULL
-      && ((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
-	  || sym->as->type == AS_ASSUMED_SHAPE)
-      && sym->attr.dummy == 0)
+  if (sym->as)
     {
-      if (sym->as->type == AS_ASSUMED_SIZE)
-	gfc_error ("Assumed size array at %L must be a dummy argument",
-		   &sym->declared_at);
-      else
-	gfc_error ("Assumed shape array at %L must be a dummy argument",
-		   &sym->declared_at);
-      return;
+      gcc_assert (sym->as->type != AS_IMPLIED_SHAPE);
+      if (((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
+	   || sym->as->type == AS_ASSUMED_SHAPE)
+	  && sym->attr.dummy == 0)
+	{
+	  if (sym->as->type == AS_ASSUMED_SIZE)
+	    gfc_error ("Assumed size array at %L must be a dummy argument",
+		       &sym->declared_at);
+	  else
+	    gfc_error ("Assumed shape array at %L must be a dummy argument",
+		       &sym->declared_at);
+	  return;
+	}
     }
 
   /* Make sure symbols with known intent or optional are really dummy

gcc/testsuite/ChangeLog

+2010-08-13  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.dg/implied_shape_1.f08: New test.
+	* gfortran.dg/implied_shape_2.f90: New test.
+	* gfortran.dg/implied_shape_3.f08: New test.
+
 2010-08-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/42526

gcc/testsuite/gfortran.dg/implied_shape_1.f08

+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Test for correct semantics of implied-shape arrays.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: n = 3
+
+  ! Should be able to reduce complex expressions.
+  REAL, PARAMETER :: arr1(n:*) = SQRT ((/ 1.0, 2.0, 3.0 /)) + 42
+
+  ! With dimension statement.
+  REAL, DIMENSION(*), PARAMETER :: arr2 = arr1
+
+  ! Rank > 1.
+  INTEGER, PARAMETER :: arr3(n:*, *) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2/))
+
+  ! Character array.
+  CHARACTER(LEN=*), PARAMETER :: arr4(*) = (/ CHARACTER(LEN=3) :: "ab", "cde" /)
+
+  IF (LBOUND (arr1, 1) /= n .OR. UBOUND (arr1, 1) /= n + 2) CALL abort ()
+  IF (SIZE (arr1) /= 3) CALL abort ()
+
+  IF (LBOUND (arr2, 1) /= 1 .OR. UBOUND (arr2, 1) /= 3) CALL abort ()
+  IF (SIZE (arr2) /= 3) CALL abort ()
+
+  IF (ANY (LBOUND (arr3) /= (/ n, 1 /) .OR. UBOUND (arr3) /= (/ n + 1, 2 /))) &
+    CALL abort ()
+  IF (SIZE (arr3) /= 4) CALL abort ()
+
+  IF (LBOUND (arr4, 1) /= 1 .OR. UBOUND (arr4, 1) /= 2) CALL abort ()
+  IF (SIZE (arr4) /= 2) CALL abort ()
+END PROGRAM main

gcc/testsuite/gfortran.dg/implied_shape_2.f90

+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Test for rejection of implied-shape prior to Fortran 2008.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: arr(*) = (/ 2, 3, 4 /) ! { dg-error "Fortran 2008" }
+END PROGRAM main

gcc/testsuite/gfortran.dg/implied_shape_3.f08

+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! Test for errors with implied-shape declarations.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  INTEGER :: n
+  INTEGER, PARAMETER :: mat(2, 2) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2 /))
+
+  ! Malformed declaration.
+  INTEGER, PARAMETER :: arr1(*, *, 5) = mat ! { dg-error "Bad array specification for implied-shape array" }
+
+  ! Rank mismatch in initialization.
+  INTEGER, PARAMETER :: arr2(*, *) = (/ 1, 2, 3, 4 /) ! { dg-error "Incompatible ranks" }
+
+  ! Non-PARAMETER implied-shape, with and without initializer.
+  INTEGER :: arr3(*, *) ! { dg-error "Non-PARAMETER" }
+  INTEGER :: arr4(*, *) = mat ! { dg-error "Non-PARAMETER" }
+
+  ! Missing initializer.
+  INTEGER, PARAMETER :: arr5(*) ! { dg-error "is missing an initializer" }
+
+  ! Initialization from scalar.
+  INTEGER, PARAMETER :: arr6(*) = 0 ! { dg-error "with scalar" }
+
+  ! Automatic bounds.
+  n = 2
+  BLOCK
+    INTEGER, PARAMETER :: arr7(n:*) = (/ 2, 3, 4 /) ! { dg-error "Non-constant lower bound" }
+  END BLOCK
+END PROGRAM main