From 9d691ba7501c741571edc1618c434316b1eb0170 Mon Sep 17 00:00:00 2001 From: Bernhard Fischer Date: Mon, 20 Nov 2006 17:20:33 +0100 Subject: [PATCH] re PR fortran/24783 ([4.1 and 4.2 only] Implicit none in module overwrite explicit in procedure) fortran/ChangeLog 2006-11-20 Bernhard Fischer PR fortran/24783 * resolve.c (resolve_variable): Get the implicit type from the symbols namespace rather than the default namespace. Fix whitespace. (resolve_formal_arglist, resolve_equivalence): Fix typo. testsuite/ChangeLog 2006-11-20 Bernhard Fischer PR fortran/24783 * gfortran.dg/implicit_10.f90: New test. From-SVN: r119016 --- gcc/fortran/ChangeLog | 7 +++++ gcc/fortran/resolve.c | 8 +++--- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/implicit_10.f90 | 33 +++++++++++++++++++++++ 4 files changed, 48 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/implicit_10.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6efdfac0496..da741c6faff 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2006-11-20 Bernhard Fischer + + PR fortran/24783 + * resolve.c (resolve_variable): Get the implicit type from the + symbols namespace rather than the default namespace. Fix whitespace. + (resolve_formal_arglist, resolve_equivalence): Fix typo. + 2006-11-19 Erik Edelmann * resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3d567cb7cad..5bd8296b55b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -232,7 +232,7 @@ resolve_formal_arglist (gfc_symbol * proc) { gfc_error ("Character-valued argument '%s' of statement function at " - "%L must has constant length", + "%L must have constant length", sym->name, &sym->declared_at); continue; } @@ -2966,7 +2966,7 @@ resolve_variable (gfc_expr * e) else { /* Must be a simple variable reference. */ - if (gfc_set_default_type (sym, 1, NULL) == FAILURE) + if (gfc_set_default_type (sym, 1, sym->ns) == FAILURE) return FAILURE; e->ts = sym->ts; } @@ -6008,11 +6008,9 @@ resolve_symbol (gfc_symbol * sym) case FL_PARAMETER: if (resolve_fl_parameter (sym) == FAILURE) return; - break; default: - break; } @@ -6692,7 +6690,7 @@ resolve_equivalence (gfc_equiv *eq) { if (value_name != NULL) { - gfc_error ("Initialized objects '%s' and '%s' cannot both " + gfc_error ("Initialized objects '%s' and '%s' cannot both " "be in the EQUIVALENCE statement at %L", value_name, sym->name, &e->where); continue; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f014dbb6f04..bda06241fd7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-11-20 Bernhard Fischer + + PR fortran/24783 + * gfortran.dg/implicit_10.f90: New test. + 2006-11-19 Gabriel Dos Reis PR c++/8586 diff --git a/gcc/testsuite/gfortran.dg/implicit_10.f90 b/gcc/testsuite/gfortran.dg/implicit_10.f90 new file mode 100644 index 00000000000..0f5094f4209 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_10.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! Check fix for PR24783 where we did try to resolve the implicit type +! from the wrong namespace thus rejecting valid code. + MODULE mod1 + IMPLICIT NONE + CONTAINS + SUBROUTINE sub(vec, ny) + IMPLICIT REAL (a-h,o-z) + IMPLICIT INTEGER (i-n) + DIMENSION vec(ny) + ny = fun(vec(ny),1,1) + RETURN + END SUBROUTINE sub + REAL FUNCTION fun(r1, i1, i2) + IMPLICIT REAL (r,f) + IMPLICIT INTEGER (i) + DIMENSION r1(i1:i2) + r1(i1) = i1 + 1 + r1(i2) = i2 + 1 + fun = r1(i1) + r1(i2) + END FUNCTION fun + END MODULE mod1 + + use mod1 + IMPLICIT REAL (d) + INTEGER i + dimension di(5) + i = 1 + if (fun(di(i),1,2).NE.5) call abort() + call sub(di(i),i) + if (i.NE.4) call abort() + end +! { dg-final { cleanup-modules "mod1" } } -- 2.30.2