Commit 9d691ba7 by Bernhard Fischer Committed by Bernhard Reutner-Fischer

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  <aldot@gcc.gnu.org>

        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  <aldot@gcc.gnu.org>

        PR fortran/24783
        * gfortran.dg/implicit_10.f90: New test.

From-SVN: r119016
parent d58542ea
2006-11-20 Bernhard Fischer <aldot@gcc.gnu.org>
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 <eedelman@gcc.gnu.org> 2006-11-19 Erik Edelmann <eedelman@gcc.gnu.org>
* resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of * resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of
......
...@@ -232,7 +232,7 @@ resolve_formal_arglist (gfc_symbol * proc) ...@@ -232,7 +232,7 @@ resolve_formal_arglist (gfc_symbol * proc)
{ {
gfc_error gfc_error
("Character-valued argument '%s' of statement function at " ("Character-valued argument '%s' of statement function at "
"%L must has constant length", "%L must have constant length",
sym->name, &sym->declared_at); sym->name, &sym->declared_at);
continue; continue;
} }
...@@ -2966,7 +2966,7 @@ resolve_variable (gfc_expr * e) ...@@ -2966,7 +2966,7 @@ resolve_variable (gfc_expr * e)
else else
{ {
/* Must be a simple variable reference. */ /* 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; return FAILURE;
e->ts = sym->ts; e->ts = sym->ts;
} }
...@@ -6008,11 +6008,9 @@ resolve_symbol (gfc_symbol * sym) ...@@ -6008,11 +6008,9 @@ resolve_symbol (gfc_symbol * sym)
case FL_PARAMETER: case FL_PARAMETER:
if (resolve_fl_parameter (sym) == FAILURE) if (resolve_fl_parameter (sym) == FAILURE)
return; return;
break; break;
default: default:
break; break;
} }
...@@ -6692,7 +6690,7 @@ resolve_equivalence (gfc_equiv *eq) ...@@ -6692,7 +6690,7 @@ resolve_equivalence (gfc_equiv *eq)
{ {
if (value_name != NULL) 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", "be in the EQUIVALENCE statement at %L",
value_name, sym->name, &e->where); value_name, sym->name, &e->where);
continue; continue;
......
2006-11-20 Bernhard Fischer <aldot@gcc.gnu.org>
PR fortran/24783
* gfortran.dg/implicit_10.f90: New test.
2006-11-19 Gabriel Dos Reis <gdr@integrable-solutions.net> 2006-11-19 Gabriel Dos Reis <gdr@integrable-solutions.net>
PR c++/8586 PR c++/8586
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment