diff options
author | Daniel Franke <franke.daniel@gmail.com> | 2007-07-08 16:38:58 -0400 |
---|---|---|
committer | Daniel Franke <dfranke@gcc.gnu.org> | 2007-07-08 16:38:58 -0400 |
commit | 83b2e4e821557b90ed8a6cd4fa1cf3ec6e69e28a (patch) | |
tree | 5265367f152799418f5add3884d981db427538fb /gcc/fortran | |
parent | 298f40649496430f6e6c42a137cd15eda59c1d48 (diff) | |
download | gcc-83b2e4e821557b90ed8a6cd4fa1cf3ec6e69e28a.zip gcc-83b2e4e821557b90ed8a6cd4fa1cf3ec6e69e28a.tar.gz gcc-83b2e4e821557b90ed8a6cd4fa1cf3ec6e69e28a.tar.bz2 |
re PR fortran/25094 (Procedure with public generic identifier allowed to have argument of private type)
gcc/fortran:
2007-07-08 Daniel Franke <franke.daniel@gmail.com>
PR fortran/25094
* resolve.c (resolve_fl_procedure): Added check for PRIVATE types
in PUBLIC interfaces.
gcc/testsuite:
2007-07-08 Daniel Franke <franke.daniel@gmail.com>
PR fortran/25094
* gfortran.dg/interface_15.f90: New test.
From-SVN: r126466
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 25 |
2 files changed, 31 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0705ab8..bda3726 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-07-08 Daniel Franke <franke.daniel@gmail.com> + + PR fortran/25094 + * resolve.c (resolve_fl_procedure): Added check for PRIVATE types + in PUBLIC interfaces. + 2007-07-07 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/32644 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 16a782a..b887d82 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6649,6 +6649,8 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && sym->ns->parent->proc_name->attr.flavor == FL_MODULE) && gfc_check_access(sym->attr.access, sym->ns->default_access)) { + gfc_interface *iface; + for (arg = sym->formal; arg; arg = arg->next) { if (arg->sym @@ -6666,6 +6668,29 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) return FAILURE; } } + + /* PUBLIC interfaces may expose PRIVATE procedures that take types + PRIVATE to the containing module. */ + for (iface = sym->generic; iface; iface = iface->next) + { + for (arg = iface->sym->formal; arg; arg = arg->next) + { + if (arg->sym + && arg->sym->ts.type == BT_DERIVED + && !arg->sym->ts.derived->attr.use_assoc + && !gfc_check_access (arg->sym->ts.derived->attr.access, + arg->sym->ts.derived->ns->default_access)) + { + gfc_error_now ("Procedure '%s' in PUBLIC interface '%s' at %L takes " + "dummy arguments of '%s' which is PRIVATE", + iface->sym->name, sym->name, &iface->sym->declared_at, + gfc_typename(&arg->sym->ts)); + /* Stop this message from recurring. */ + arg->sym->ts.derived->attr.access = ACCESS_PUBLIC; + return FAILURE; + } + } + } } /* An external symbol may not have an initializer because it is taken to be |