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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126466 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0705ab8..bda3726 100644 (file)
--- 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 (file)
--- 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 0800359..0aec398 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-07-08  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/25094
+       * gfortran.dg/interface_155555.f90: New test.
+
 2007-07-08  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
        * 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 (file)
index 0000000..c9a3add
--- /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 <jv244@cam.ac.uk>
+
+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" } }