From c4d4556f8daab94ba0be96ee6f56507da1ae4b94 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sun, 7 Oct 2007 13:45:15 +0200 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 10 +++++ gcc/fortran/expr.c | 21 +++++++-- gcc/fortran/resolve.c | 22 +++++---- gcc/testsuite/ChangeLog | 8 ++++ .../gfortran.dg/initialization_1.f90 | 4 +- .../gfortran.dg/initialization_14.f90 | 45 +++++++++++++++++++ .../gfortran.dg/initialization_7.f90 | 2 +- .../gfortran.dg/initialization_9.f90 | 2 +- 8 files changed, 94 insertions(+), 20 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/initialization_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9cc097c8b8c..28ed3f7af3f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2007-10-07 Tobias Schlüter + + 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 PR fortran/33609 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 0c68095e6a8..151b465ae9f 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 50164f66949..61be64f26f9 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 ff4384370d5..102c108bddb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-10-07 Tobias Schlüter + + 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 * 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 637b3174e99..63035cc9dcd 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 00000000000..4d5b6856cf0 --- /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 7f5ee315cf2..8615181965d 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 5a827706a9e..2341d40d6d9 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 -- 2.30.2