From 83b2e4e821557b90ed8a6cd4fa1cf3ec6e69e28a Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Sun, 8 Jul 2007 16:38:58 -0400 Subject: [PATCH] re PR fortran/25094 (Procedure with public generic identifier allowed to have argument of private type) gcc/fortran: 2007-07-08 Daniel Franke PR fortran/25094 * resolve.c (resolve_fl_procedure): Added check for PRIVATE types in PUBLIC interfaces. gcc/testsuite: 2007-07-08 Daniel Franke PR fortran/25094 * gfortran.dg/interface_15.f90: New test. From-SVN: r126466 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 25 ++++++++++++++++++++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/interface_15.f90 | 22 +++++++++++++++++++ 4 files changed, 58 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/interface_15.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0705ab89f03..bda3726b241 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-07-08 Daniel Franke + + PR fortran/25094 + * resolve.c (resolve_fl_procedure): Added check for PRIVATE types + in PUBLIC interfaces. + 2007-07-07 Jerry DeLisle PR fortran/32644 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 16a782ad603..b887d82e8c9 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0800359460b..0aec398b7f9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-07-08 Daniel Franke + + PR fortran/25094 + * gfortran.dg/interface_155555.f90: New test. + 2007-07-08 Kaveh R. Ghazi * gcc.dg/c99-math-double-1.c, gcc.dg/c99-math-float-1.c, diff --git a/gcc/testsuite/gfortran.dg/interface_15.f90 b/gcc/testsuite/gfortran.dg/interface_15.f90 new file mode 100644 index 00000000000..c9a3add74ae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_15.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-c" } +! Testcase from PR fortran/25094 +! Contributed by Joost VandeVondele + +MODULE M1 + TYPE T1 + INTEGER :: I + END TYPE T1 + INTERFACE I + MODULE PROCEDURE F1 ! { dg-error "PUBLIC interface" } + END INTERFACE + PRIVATE ! :: T1,F1 + PUBLIC :: I +CONTAINS + INTEGER FUNCTION F1(D) + TYPE(T1) :: D + F1 = D%I + END FUNCTION +END MODULE + +! { dg-final { cleanup-modules "M1" } }