Hello,
for the case:
[...]
use select_precision, only: wp => dp
interface
subroutine ode_derivative(x)
import :: wp
[...]
`wp' is currently imported in the subroutine namespace under its
original name `dp', which leads to an error if one tries to use `wp'.
The core of the fix, which is basically a collection of the patches
Tobias posted in the PR, uses the matched name instead of the original
name for the symtree in the subroutine namespace.
Tobias' patches regress on import7.f90 because variable_decl lookups for
the type in the interface namespace (to check that it has been declared)
using the original name (which is the only one available there).
The fix I propose for that is to remove the regressing error, and try to
trigger the existing generic code diagnosing undeclared types. The
latter doesn't trigger currently because gfc_get_ha_symtree keep going
up the parent namespace until it finds a symbol, so in an interface
block, it is guaranteed to find a declared symbol, even if the latter
hasn't been imported in the interface.
The fix for that checks whether we are in an interface body without
blank import statement, and aborts the lookup in that case. A few
adjustments are then needed where the parent namespace is accessed
directly, thus bypassing the above check.
The change from the interface-specific error to the more general error
needs a few test cases to be adjusted, namely import2.f90, import8.f90,
and interface_derived_type_1.f90
from:
type(fcnparms) :: fparams ! { dg-error "not been declared
within the in
1
Error: The type of 'fparams' at (1) has not been declared within the
interface
to:
type(fcnparms) :: fparams ! { dg-error "not been declared
within the in
1
Error: Derived type 'fcnparms' at (1) is being used before it is defined
The caret is slightly better, the message is slightly worse. I think
it's OK, but could consider trying to issue a better error message.
Otherwise it passes the test suite. OK for trunk?
As the code impacts the name to symbol resolution code, it has a big
potential for breakage; the bug is a regression however, so I plan to
backport to 4.7 and 4.6, say, two weeks after trunk at least (if I don't
forget). Does it sound good?
Mikael
fortran/
2013-01-10 Tobias Burnus <bur...@net-b.de>
Mikael Morin <mik...@gcc.gnu.org>
PR fortran/53537
* symbol.c (gfc_find_sym_tree): Don't look for the symbol outside an
interface block.
(gfc_get_ha_symtree): Let gfc_find_sym_tree lookup the parent namespace.
* decl.c (gfc_match_data_decl): Ditto.
(variable_decl): Remove undeclared type error.
(gfc_match_import): Use renamed instead of original name.
testsuite/
2013-01-10 Tobias Burnus <bur...@net-b.de>
Mikael Morin <mik...@gcc.gnu.org>
PR fortran/53537
* gfortran.dg/import2.f90: Adjust undeclared type error message.
* gfortran.dg/import8.f90: Likewise.
* gfortran.dg/interface_derived_type_1.f90: Likewise.
* gfortran.dg/import10.f90: New test.
* gfortran.dg/import11.f90: Likewise
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3a36cad..4af587b 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1981,30 +1981,6 @@ variable_decl (int elem)
goto cleanup;
}
- /* An interface body specifies all of the procedure's
- characteristics and these shall be consistent with those
- specified in the procedure definition, except that the interface
- may specify a procedure that is not pure if the procedure is
- defined to be pure(12.3.2). */
- if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
- && gfc_current_ns->proc_name
- && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && current_ts.u.derived->ns != gfc_current_ns)
- {
- gfc_symtree *st;
- st = gfc_find_symtree (gfc_current_ns->sym_root,
current_ts.u.derived->name);
- if (!(current_ts.u.derived->attr.imported
- && st != NULL
- && gfc_find_dt_in_generic (st->n.sym) == current_ts.u.derived)
- && !gfc_current_ns->has_import_set)
- {
- gfc_error ("The type of '%s' at %C has not been declared within the
"
- "interface", name);
- m = MATCH_ERROR;
- goto cleanup;
- }
- }
-
if (check_function_name (name) == FAILURE)
{
m = MATCH_ERROR;
@@ -3242,14 +3218,14 @@ gfc_match_import (void)
return MATCH_ERROR;
}
- if (gfc_find_symtree (gfc_current_ns->sym_root,name))
+ if (gfc_find_symtree (gfc_current_ns->sym_root, name))
{
gfc_warning ("'%s' is already IMPORTed from host scoping unit "
"at %C.", name);
goto next_item;
}
- st = gfc_new_symtree (&gfc_current_ns->sym_root, sym->name);
+ st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
st->n.sym = sym;
sym->refs++;
sym->attr.imported = 1;
@@ -3261,8 +3237,8 @@ gfc_match_import (void)
lower-case name contains the associated generic function. */
st = gfc_new_symtree (&gfc_current_ns->sym_root,
gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) sym->name[0]),
- &sym->name[1]));
+ (char) TOUPPER ((unsigned char) name[0]),
+ &name[1]));
st->n.sym = sym;
sym->refs++;
sym->attr.imported = 1;
@@ -4317,7 +4293,7 @@ gfc_match_data_decl (void)
goto ok;
gfc_find_symbol (current_ts.u.derived->name,
- current_ts.u.derived->ns->parent, 1, &sym);
+ current_ts.u.derived->ns, 1, &sym);
/* Any symbol that we find had better be a type definition
which has its components defined. */
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index dbd5132..a3a6a6c 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2679,6 +2679,11 @@ gfc_find_sym_tree (const char *name, gfc_namespace *ns,
int parent_flag,
if (!parent_flag)
break;
+ /* Don't escape an interface block. */
+ if (ns && !ns->has_import_set
+ && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ break;
+
ns = ns->parent;
}
while (ns != NULL);
@@ -2837,17 +2842,14 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree
**result)
return i;
}
- if (gfc_current_ns->parent != NULL)
- {
- i = gfc_find_sym_tree (name, gfc_current_ns->parent, 1, &st);
- if (i)
- return i;
+ i = gfc_find_sym_tree (name, gfc_current_ns, 1, &st);
+ if (i)
+ return i;
- if (st != NULL)
- {
- *result = st;
- return 0;
- }
+ if (st != NULL)
+ {
+ *result = st;
+ return 0;
}
return gfc_get_sym_tree (name, gfc_current_ns, result, false);
diff --git a/gcc/testsuite/gfortran.dg/import2.f90
b/gcc/testsuite/gfortran.dg/import2.f90
index d9e65e3..9db2197 100644
--- a/gcc/testsuite/gfortran.dg/import2.f90
+++ b/gcc/testsuite/gfortran.dg/import2.f90
@@ -37,7 +37,7 @@ module testmod
interface
subroutine other(x,y)
import ! { dg-error "Fortran 2003: IMPORT statement" }
- type(modType) :: y ! { dg-error "not been declared within the interface"
}
+ type(modType) :: y ! { dg-error "is being used before it is defined" }
real(kind) :: x ! { dg-error "has not been declared" }
end subroutine
end interface
@@ -56,13 +56,13 @@ program foo
interface
subroutine bar(x,y)
import ! { dg-error "Fortran 2003: IMPORT statement" }
- type(myType) :: x ! { dg-error "not been declared within the interface" }
+ type(myType) :: x ! { dg-error "is being used before it is defined" }
integer(dp) :: y ! { dg-error "has not been declared" }
end subroutine bar
subroutine test(x)
import :: myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
import myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
- type(myType3) :: x ! { dg-error "not been declared within the interface"
}
+ type(myType3) :: x ! { dg-error "is being used before it is defined" }
end subroutine test
end interface
diff --git a/gcc/testsuite/gfortran.dg/import8.f90
b/gcc/testsuite/gfortran.dg/import8.f90
index 0d88e62..543b0a1 100644
--- a/gcc/testsuite/gfortran.dg/import8.f90
+++ b/gcc/testsuite/gfortran.dg/import8.f90
@@ -12,7 +12,7 @@ end type Connection
abstract interface
subroutine generic_desc(self)
! <<< missing IMPORT
- class(Connection) :: self ! { dg-error "has not been declared within
the interface" }
+ class(Connection) :: self ! { dg-error "is being used before it is
defined" }
end subroutine generic_desc
end interface
end
diff --git a/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
b/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
index 7c165b3..efd81fd 100644
--- a/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
+++ b/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
@@ -13,7 +13,7 @@ contains
subroutine sim_1(func1,params)
interface
function func1(fparams)
- type(fcnparms) :: fparams ! { dg-error "not been declared within the
interface" }
+ type(fcnparms) :: fparams ! { dg-error "is being used before it is
defined" }
real :: func1
end function func1
end interface
! { dg-do compile }
!
! PR fortran/53537
! The use of WP in the ODE_DERIVATIVE interface used to be rejected because
! the symbol was imported under the original name DP.
!
! Original test case from Arjen Markus <arjen.mar...@deltares.nl>
module select_precision
integer, parameter :: dp = kind(1.0)
end module select_precision
module ode_types
use select_precision, only: wp => dp
implicit none
interface
subroutine ode_derivative(x)
import :: wp
real(wp) :: x
end subroutine ode_derivative
end interface
end module ode_types
! { dg-do compile }
!
! PR fortran/53537
! The definition of T1 in the interface used to be rejected because T3
! was imported under the original name T1.
MODULE MOD
TYPE T1
SEQUENCE
integer :: j
END TYPE t1
END
PROGRAM MAIN
USE MOD, T3 => T1
INTERFACE SUBR
SUBROUTINE SUBR1(X,y)
IMPORT :: T3
type t1
! sequence
! integer :: i
end type t1
TYPE(T3) X
! TYPE(T1) X
END SUBROUTINE
END INTERFACE SUBR
END PROGRAM MAIN
