OSDN Git Service

2008-11-12 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 12 Nov 2008 06:59:33 +0000 (06:59 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 12 Nov 2008 06:59:33 +0000 (06:59 +0000)
        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.

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

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/private_type_11.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/private_type_12.f90 [new file with mode: 0644]

index efa4678..0b12539 100644 (file)
@@ -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>
index 4774b0b..aae1ef7 100644 (file)
@@ -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)
index dc4ae56..df1cb86 100644 (file)
@@ -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
@@ -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
@@ -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