@@ -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. */
@@ -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);
@@ -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
@@ -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
@@ -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
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 <burnus@net-b.de> Mikael Morin <mikael@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 <burnus@net-b.de> Mikael Morin <mikael@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