+2013-01-28 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.
+
2013-01-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/55984
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;
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;
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;
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. */
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);
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);
+2013-01-28 Tobias Burnus <burnus@net-b.de>
+ Mikael Morin <mikael@gcc.gnu.org>
+
+ PR fortran/53537
+ * gfortran.dg/import2.f90: Adjust undeclared type error messages.
+ * gfortran.dg/import8.f90: Likewise.
+ * gfortran.dg/interface_derived_type_1.f90: Likewise.
+ * gfortran.dg/import10.f90: New test.
+ * gfortran.dg/import11.f90: Likewise
+
2013-01-28 Jakub Jelinek <jakub@redhat.com>
PR testsuite/56053
--- /dev/null
+! { 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.markus@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
+
+
--- /dev/null
+! { 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
+
+
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
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
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
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
projects / platform / upstream / gcc.git / commitdiff