re PR fortran/20851 (dummy argument may not appear in specification expression in elemental procedure)

PR fortran/20851
fortran/
* expr.c (check_inquiry): Typo fix in error message.
(check_init_expr): Same * 3.
(check_restricted): Verify that no dummy arguments appear in
restricted expressions in ELEMENTAL procedures.
* resolve.c (resolve_fl_variable): Exchange order of checks to
avoid side-effect.
testsuite/
* initialization_1.f90: Fix dg-error annotations.
* initialization_14.f90: New.
* initialization_7.f90: Fix dg-error annotations.
* initialization_9.f90: Likewise.

From-SVN: r129069

8 files changed, 94 insertions, 20 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9cc097c..28ed3f7 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-10-07  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/20851
+	* expr.c (check_inquiry): Typo fix in error message.
+	(check_init_expr): Same * 3.
+	(check_restricted): Verify that no dummy arguments appear in
+	restricted expressions in ELEMENTAL procedures.
+	* resolve.c (resolve_fl_variable): Exchange order of checks to
+	avoid side-effect.
+
 2007-10-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/33609
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 0c68095..151b465 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2012,7 +2012,7 @@ check_inquiry (gfc_expr *e, int not_restricted)
 	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
 	    && ap->expr->symtree->n.sym->ts.cl->length == NULL)
 	  {
-	    gfc_error ("assumed character length variable '%s' in constant "
+	    gfc_error ("Assumed character length variable '%s' in constant "
 		       "expression at %L", e->symtree->n.sym->name, &e->where);
 	      return MATCH_ERROR;
 	  }
@@ -2204,19 +2204,19 @@ check_init_expr (gfc_expr *e)
 	  switch (e->symtree->n.sym->as->type)
 	    {
 	      case AS_ASSUMED_SIZE:
-		gfc_error ("assumed size array '%s' at %L is not permitted "
+		gfc_error ("Assumed size array '%s' at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_ASSUMED_SHAPE:
-		gfc_error ("assumed shape array '%s' at %L is not permitted "
+		gfc_error ("Assumed shape array '%s' at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_DEFERRED:
-		gfc_error ("deferred array '%s' at %L is not permitted "
+		gfc_error ("Deferred array '%s' at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
@@ -2429,6 +2429,19 @@ check_restricted (gfc_expr *e)
       sym = e->symtree->n.sym;
       t = FAILURE;
 
+      /* If a dummy argument appears in a context that is valid for a
+	 restricted expression in an elemental procedure, it will have
+	 already been simplified away once we get here.  Therefore we
+	 don't need to jump through hoops to distinguish valid from
+	 invalid cases.  */
+      if (sym->attr.dummy && sym->ns == gfc_current_ns
+	  && sym->ns->proc_name && sym->ns->proc_name->attr.elemental)
+	{
+	  gfc_error ("Dummy argument '%s' not allowed in expression at %L",
+		     sym->name, &e->where);
+	  break;
+	}
+
       if (sym->attr.optional)
 	{
 	  gfc_error ("Dummy argument '%s' at %L cannot be OPTIONAL",
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 50164f6..61be64f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6968,22 +6968,20 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
      is_non_constant_shape_array.  */
   specification_expr = 1;
 
-  if (!sym->attr.use_assoc
+  if (sym->ns->proc_name
+      && (sym->ns->proc_name->attr.flavor == FL_MODULE
+	  || sym->ns->proc_name->attr.is_main_program)
+      && !sym->attr.use_assoc
       && !sym->attr.allocatable
       && !sym->attr.pointer
       && is_non_constant_shape_array (sym))
     {
-	/* The shape of a main program or module array needs to be
-	   constant.  */
-	if (sym->ns->proc_name
-	    && (sym->ns->proc_name->attr.flavor == FL_MODULE
-		|| sym->ns->proc_name->attr.is_main_program))
-	  {
-	    gfc_error ("The module or main program array '%s' at %L must "
-		       "have constant shape", sym->name, &sym->declared_at);
-	    specification_expr = 0;
-	    return FAILURE;
-	  }
+      /* The shape of a main program or module array needs to be
+	 constant.  */
+      gfc_error ("The module or main program array '%s' at %L must "
+		 "have constant shape", sym->name, &sym->declared_at);
+      specification_expr = 0;
+      return FAILURE;
     }
 
   if (sym->ts.type == BT_CHARACTER)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ff43843..102c108 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-10-07  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/20851
+	* initialization_1.f90: Fix dg-error annotations.
+	* initialization_14.f90: New.
+	* initialization_7.f90: Fix dg-error annotations.
+	* initialization_9.f90: Likewise.
+
 2007-10-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	* gfortran.dg/error_recovery_4.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/initialization_1.f90 b/gcc/testsuite/gfortran.dg/initialization_1.f90
index 637b317..63035cc 100644
--- a/gcc/testsuite/gfortran.dg/initialization_1.f90
+++ b/gcc/testsuite/gfortran.dg/initialization_1.f90
@@ -24,10 +24,10 @@ contains
     real :: z(2, 2)
 
 ! However, this gives a warning because it is an initialization expression.
-    integer :: l1 = len (ch1)     ! { dg-warning "assumed character length variable" }
+    integer :: l1 = len (ch1)     ! { dg-warning "Assumed character length variable" }
 
 ! These are warnings because they are gfortran extensions.
-    integer :: m3 = size (x, 1)   ! { dg-error "assumed size array" }
+    integer :: m3 = size (x, 1)   ! { dg-error "Assumed size array" }
     integer :: m4(2) = shape (z)
 
 ! This does not depend on non-constant properties.
diff --git a/gcc/testsuite/gfortran.dg/initialization_14.f90 b/gcc/testsuite/gfortran.dg/initialization_14.f90
new file mode 100644
index 0000000..4d5b685
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_14.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! PR 20851
+! Dummy arguments are disallowed in initialization expressions in
+! elemental functions except as arguments to the intrinsic functions
+! BIT_SIZE, KIND, LEN, or to the numeric inquiry functions listed
+! in 13.11.8
+MODULE TT
+INTEGER M
+CONTAINS
+   ELEMENTAL REAL FUNCTION two(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(N) :: scr ! { dg-error "Dummy argument 'n' not allowed in expression" }
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION twopointfive(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(MAX(N,2)) :: scr ! { dg-error "Dummy argument 'n' not allowed in expression" }
+   end FUNCTION twopointfive
+
+   REAL FUNCTION three(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(N) :: scr ! this time it's valid
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION four(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(bit_size(N)) :: scr ! another valid variant
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION gofourit(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(MIN(HUGE(N),1)) :: scr ! another valid variant
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION fourplusone(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(M) :: scr ! another valid variant
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION five(X)
+     real, intent(in) :: x
+     CHARACTER(LEN=PRECISION(X)) :: C ! valid again
+   END FUNCTION
+END MODULE
+END
diff --git a/gcc/testsuite/gfortran.dg/initialization_7.f90 b/gcc/testsuite/gfortran.dg/initialization_7.f90
index 7f5ee31..8615181 100644
--- a/gcc/testsuite/gfortran.dg/initialization_7.f90
+++ b/gcc/testsuite/gfortran.dg/initialization_7.f90
@@ -6,7 +6,7 @@
 
 subroutine probleme(p)
   real(kind=8), dimension(:) :: p
-  integer :: nx = size(p, 1)          ! { dg-error "deferred array" }
+  integer :: nx = size(p, 1)          ! { dg-error "Deferred array" }
   integer :: nix
 
   nix = nx
diff --git a/gcc/testsuite/gfortran.dg/initialization_9.f90 b/gcc/testsuite/gfortran.dg/initialization_9.f90
index 5a82770..2341d40 100644
--- a/gcc/testsuite/gfortran.dg/initialization_9.f90
+++ b/gcc/testsuite/gfortran.dg/initialization_9.f90
@@ -5,7 +5,7 @@
 
    integer function xstrcmp(s1)
      character*(*), intent(in) :: s1
-     integer :: n1 = len(s1)            ! { dg-error "assumed character length variable" }
+     integer :: n1 = len(s1)            ! { dg-error "Assumed character length variable" }
      n1 = 1
      return
    end function xstrcmp