From: Tobias Burnus <burnus@gcc.gnu.org>
Date: Wed, 12 Nov 2008 06:59:33 +0000 (+0100)
Subject: re PR fortran/38065 (private/public confusion with a contained function)
X-Git-Tag: releases/gcc-4.4.0~1718
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=0d6872cba72c3fad11d88e31611fc5ff229f8288;p=thirdparty%2Fgcc.git

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 efa4678f30e0..0b1253914b34 100644
--- 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 4774b0bdb960..aae1ef784f4b 100644
--- 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 dc4ae56ef20d..df1cb8621f13 100644
--- 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
index 000000000000..53d5f4c705c0
--- /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
index 000000000000..c9867bcf87ba
--- /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