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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9cc097c..28ed3f7 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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 (file)
--- 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