re PR fortran/39800 (Rejects PRIVATE TYPE as compont of local type declaration)

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.

From-SVN: r146457

5 files changed, 70 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 37349b7..d230333 100644
--- 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
--- 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
--- 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
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
--- 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