re PR fortran/38065 (private/public confusion with a contained function)

2008-11-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38065
        * resolve.c (resolve_fntype): Fix private derived type checking.

2008-11-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38065
        * gfortran.dg/private_type_11.f90: New test.
        * gfortran.dg/private_type_12.f90: New test.

From-SVN: r141780

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index efa4678f30e04deee71cc83339d356624e693adf..0b1253914b34422b58813e7c8e70d13006e240bc 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,7 +1,12 @@
+2008-11-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/38065
+       * resolve.c (resolve_fntype): Fix private derived type checking.
+
 2008-11-09  Paul Thomas  <pault@gcc.gnu.org>
 
-        PR fortran/37836
-        * intrinsic.c (add_functions): Reference gfc_simplify._minval
+       PR fortran/37836
+       * intrinsic.c (add_functions): Reference gfc_simplify._minval
        and gfc_simplify_maxval.
        * intrinsic.h : Add prototypes for gfc_simplify._minval and
        gfc_simplify_maxval.
@@ -13,8 +18,8 @@
 
 2008-11-04  Paul Thomas  <pault@gcc.gnu.org>
 
-        PR fortran/37597
-        * parse.c (gfc_fixup_sibling_symbols ): Fixup contained, even
+       PR fortran/37597
+       * parse.c (gfc_fixup_sibling_symbols ): Fixup contained, even
        when symbol not found.
 
 2008-11-03  Tobias Burnus  <burnus@net-b.de>

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4774b0bdb960a7432392d9a2b793c8f6a555d0ba..aae1ef784f4b6f7360f9911005cf0bbca9245042 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10179,12 +10179,14 @@ resolve_fntype (gfc_namespace *ns)
     }
 
   if (sym->ts.type == BT_DERIVED && !sym->ts.derived->attr.use_assoc
+      && !sym->attr.contained
       && !gfc_check_access (sym->ts.derived->attr.access,
                            sym->ts.derived->ns->default_access)
       && gfc_check_access (sym->attr.access, sym->ns->default_access))
     {
-      gfc_error ("PUBLIC function '%s' at %L cannot be of PRIVATE type '%s'",
-                sym->name, &sym->declared_at, sym->ts.derived->name);
+      gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at "
+                     "%L of PRIVATE type '%s'", sym->name,
+                     &sym->declared_at, sym->ts.derived->name);
     }
 
     if (ns->entries)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dc4ae56ef20d1fdfdc9dd3bf92384b1b632dc940..df1cb8621f135f04a6b6f935de705a11fea5b37b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-11-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/38065
+       * gfortran.dg/private_type_11.f90: New test.
+       * gfortran.dg/private_type_12.f90: New test.
+
 2008-11-10  Catherine Moore  <clm@codesourcery.com>
 
        * gcc.target/mips/no-smartmips-lwxs.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/private_type_11.f90 b/gcc/testsuite/gfortran.dg/private_type_11.f90
new file mode 100644 (file)
index 0000000..53d5f4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_11.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/38065
+!
+! Reported by Norman S. Clerman
+! and reduced by Joost VandeVondele
+!
+MODULE M1
+  IMPLICIT NONE
+  PRIVATE
+  TYPE T1
+   INTEGER :: I1
+  END TYPE T1
+  PUBLIC :: S1,F2
+CONTAINS
+  SUBROUTINE S1
+  CONTAINS
+   TYPE(T1) FUNCTION F1()
+   END FUNCTION F1
+  END SUBROUTINE S1
+  TYPE(T1) FUNCTION F2()
+  END FUNCTION F2
+END MODULE M1

diff --git a/gcc/testsuite/gfortran.dg/private_type_12.f90 b/gcc/testsuite/gfortran.dg/private_type_12.f90
new file mode 100644 (file)
index 0000000..c9867bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_12.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR fortran/38065
+!
+! Reported by Norman S. Clerman
+! and reduced by Joost VandeVondele
+!
+MODULE M1
+  IMPLICIT NONE
+  PRIVATE
+  TYPE T1
+   INTEGER :: I1
+  END TYPE T1
+  PUBLIC :: S1,F2
+CONTAINS
+  SUBROUTINE S1
+  CONTAINS
+   TYPE(T1) FUNCTION F1()
+   END FUNCTION F1
+  END SUBROUTINE S1
+  TYPE(T1) FUNCTION F2() ! { dg-error "Fortran 2003: PUBLIC variable 'f2'" }
+  END FUNCTION F2
+END MODULE M1