2009-04-20 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/39800
	* resolve.c (is_sym_host_assoc): New function.
	(resolve_fl_derived): Call it when checking PRIVATE components
	of PUBLIC derived types.  Change gfc_error to a gfc_notify_std
	with std=f2003.
	(resolve_fl_namelist): Call it twice to check for host
	association.

2009-04-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/39800
	* gfortran.dg/private_type_13.f90: New test.
	* gfortran.dg/private_type_2.f90: Add option -std=f95.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 37349b7..d230333 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2009-04-20  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/39800
+       * resolve.c (is_sym_host_assoc): New function.
+       (resolve_fl_derived): Call it when checking PRIVATE components
+       of PUBLIC derived types.  Change gfc_error to a gfc_notify_std
+       with std=f2003.
+       (resolve_fl_namelist): Call it twice to check for host
+       association.
+
 2009-04-20  Ian Lance Taylor  <iant@google.com>
 
        * module.c (import_iso_c_binding_module): Add casts to enum type.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index fad067c..f214050 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -83,6 +83,18 @@ gfc_is_formal_arg (void)
   return formal_arg_flag;
 }
 
+/* Is the symbol host associated?  */
+static bool
+is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns)
+{
+  for (ns = ns->parent; ns; ns = ns->parent)
+    {      
+      if (sym->ns == ns)
+       return true;
+    }
+
+  return false;
+}
 
 /* Ensure a typespec used is valid; for instance, TYPE(t) is invalid if t is
    an ABSTRACT derived-type.  If where is not NULL, an error message with that
@@ -8895,13 +8907,15 @@ resolve_fl_derived (gfc_symbol *sym)
       if (c->ts.type == BT_DERIVED
          && sym->component_access != ACCESS_PRIVATE
          && gfc_check_access (sym->attr.access, sym->ns->default_access)
+         && !is_sym_host_assoc (c->ts.derived, sym->ns)
          && !c->ts.derived->attr.use_assoc
          && !gfc_check_access (c->ts.derived->attr.access,
                                c->ts.derived->ns->default_access))
        {
-         gfc_error ("The component '%s' is a PRIVATE type and cannot be "
-                    "a component of '%s', which is PUBLIC at %L",
-                    c->name, sym->name, &sym->declared_at);
+         gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
+                         "is a PRIVATE type and cannot be a component of "
+                         "'%s', which is PUBLIC at %L", c->name,
+                         sym->name, &sym->declared_at);
          return FAILURE;
        }
 
@@ -8989,9 +9003,7 @@ resolve_fl_namelist (gfc_symbol *sym)
       for (nl = sym->namelist; nl; nl = nl->next)
        {
          if (!nl->sym->attr.use_assoc
-             && !(sym->ns->parent == nl->sym->ns)
-             && !(sym->ns->parent
-                  && sym->ns->parent->parent == nl->sym->ns)
+             && !is_sym_host_assoc (nl->sym, sym->ns)
              && !gfc_check_access(nl->sym->attr.access,
                                nl->sym->ns->default_access))
            {
@@ -9013,7 +9025,7 @@ resolve_fl_namelist (gfc_symbol *sym)
 
          /* Types with private components that are defined in the same module.  */
          if (nl->sym->ts.type == BT_DERIVED
-             && !(sym->ns->parent == nl->sym->ts.derived->ns)
+             && !is_sym_host_assoc (nl->sym->ts.derived, sym->ns)
              && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
                                        ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
                                        nl->sym->ns->default_access))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c589673..a68a44f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-04-20  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/39800
+       * gfortran.dg/private_type_13.f90: New test.
+       * gfortran.dg/private_type_2.f90: Add option -std=f95.
+
 2009-04-20  Le-Chun Wu  <lcwu@google.com>
 
        PR c++/39803

diff --git a/gcc/testsuite/gfortran.dg/private_type_13.f90 b/gcc/testsuite/gfortran.dg/private_type_13.f90
new file mode 100644 (file)
index 0000000..77c41a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_13.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Test fix for F95 part of PR39800, in which the host association of the type 't1'
+! generated an error.
+!
+! Reported to clf by Alexei Matveev <Alexei Matveev@gmail.com> and reported by
+! Tobias Burnus  <burnus@gcc.gnu.org>
+!
+module m
+  implicit none
+  private
+
+  type :: t1
+    integer :: i
+  end type
+
+  type :: t2
+    type(t1) :: j
+  end type
+
+  contains
+
+    subroutine sub()
+      implicit none
+
+      type :: t3
+        type(t1) :: j
+      end type
+
+    end subroutine
+
+end module
+! { dg-final { cleanup-modules "m" } }

diff --git a/gcc/testsuite/gfortran.dg/private_type_2.f90 b/gcc/testsuite/gfortran.dg/private_type_2.f90
index 690be5d..cda00ca 100644 (file)
--- a/gcc/testsuite/gfortran.dg/private_type_2.f90
+++ b/gcc/testsuite/gfortran.dg/private_type_2.f90
@@ -1,8 +1,11 @@
 ! { dg-do compile }
+! { dg-options "-std=f95" }
 ! PR16404 test 6 - If a component of a derived type is of a type declared to
 ! be private, either the derived type definition must contain the PRIVATE
 ! statement, or the derived type must be private.
 ! Modified on 20051105 to test PR24534.
+! Modified on 20090419 to use -std=f95, since F2003 allows public types
+! with private components.
 !
 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
 MODULE TEST