[patch, fortran] more about namelists

[Daniel Franke <franke dot daniel at gmail dot com>]

A recent patch of mine [1] introduced attribute bits for pointer and private 
components of derived types respectively. It was only shortly after I 
committed this patch, that I found the functions derived_pointer() and 
derived_inaccessable() in resolve.c, obviously meant for the same purpose as 
the attributes just introduced ...

Further, while checking the usage of the functions mentioned to see whether 
they could be savely removed, I learned that the changes I made to fix the 
known problems with namelists introduced new ones (see the changed testcases 
for examples).

As a sidenote: with this patch, gfortran will be the only compiler I tested 
(intel, sun, lahey) that detects the nested private components in 
namelist_33.f90 correctly - for a given value of correct. I would be grateful 
if someone could please double-check this, thanks :)


:ADDPATCH fortran:

2007-07-29  Daniel Franke  <franke.daniel@gmail.com>

	* resolve.c (derived_pointer): Removed, replaced callers by access 
	to appropiate attribute bit.
	(derived_inaccessable): Shortcut recursion depth.
	(resolve_fl_namelist): Fixed checks for private components in namelists.


Bootstrapped and regression tested on i686-pc-linux-gnu.
Ok for trunk?

Regards
	Daniel

[1] http://gcc.gnu.org/ml/gcc-patches/2007-07/msg02016.html

Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c	(revision 127062)
+++ fortran/resolve.c	(working copy)
@@ -4124,28 +4124,6 @@
 }
 
 
-/* Given a pointer to a symbol that is a derived type, see if any components
-   have the POINTER attribute.  The search is recursive if necessary.
-   Returns zero if no pointer components are found, nonzero otherwise.  */
-
-static int
-derived_pointer (gfc_symbol *sym)
-{
-  gfc_component *c;
-
-  for (c = sym->components; c; c = c->next)
-    {
-      if (c->pointer)
-	return 1;
-
-      if (c->ts.type == BT_DERIVED && derived_pointer (c->ts.derived))
-	return 1;
-    }
-
-  return 0;
-}
-
-
 /* Given a pointer to a symbol that is a derived type, see if it's
    inaccessible, i.e. if it's defined in another module and the components are
    PRIVATE.  The search is recursive if necessary.  Returns zero if no
@@ -4156,7 +4134,7 @@
 {
   gfc_component *c;
 
-  if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE)
+  if (sym->attr.use_assoc && sym->attr.private_comp)
     return 1;
 
   for (c = sym->components; c; c = c->next)
@@ -5072,7 +5050,7 @@
     {
       /* Check that transferred derived type doesn't contain POINTER
 	 components.  */
-      if (derived_pointer (ts->derived))
+      if (ts->derived->attr.pointer_comp)
 	{
 	  gfc_error ("Data transfer element at %L cannot have "
 		     "POINTER components", &code->loc);
@@ -5921,7 +5899,7 @@
 
 	      if (code->expr->ts.type == BT_DERIVED
 		    && code->expr->expr_type == EXPR_VARIABLE
-		    && derived_pointer (code->expr->ts.derived)
+		    && code->expr->ts.derived->attr.pointer_comp
 		    && gfc_impure_variable (code->expr2->symtree->n.sym))
 		{
 		  gfc_error ("The impure variable at %L is assigned to "
@@ -7035,13 +7013,11 @@
     {
       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))
-	    continue;
-
-	  if (!gfc_check_access(nl->sym->attr.access,
+	  if (!nl->sym->attr.use_assoc
+	      && !(sym->ns->parent == nl->sym->ns)
+	      && !(sym->ns->parent
+		   && sym->ns->parent->parent == nl->sym->ns)
+	      && !gfc_check_access(nl->sym->attr.access,
 				nl->sym->ns->default_access))
 	    {
 	      gfc_error ("NAMELIST object '%s' was declared PRIVATE and "
@@ -7050,10 +7026,22 @@
 	      return FAILURE;
 	    }
 
+	  /* Types with private components that came here by USE-association.  */
 	  if (nl->sym->ts.type == BT_DERIVED
+	      && derived_inaccessible (nl->sym->ts.derived))
+	    {
+	      gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
+			 "components and cannot be member of namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+
+	  /* 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)
 	      && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
-				    ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
-				    nl->sym->ns->default_access))
+					? ACCESS_PRIVATE : ACCESS_UNKNOWN,
+					nl->sym->ns->default_access))
 	    {
 	      gfc_error ("NAMELIST object '%s' has PRIVATE components and "
 			 "cannot be a member of PUBLIC namelist '%s' at %L",
Index: testsuite/gfortran.dg/namelist_33.f90
===================================================================
--- testsuite/gfortran.dg/namelist_33.f90	(revision 127062)
+++ testsuite/gfortran.dg/namelist_33.f90	(working copy)
@@ -2,6 +2,9 @@
 !
 ! PR fortran/32876 - accepts private items in public NAMELISTs
 !
+! USE-associated types with private components may
+! not be used in namelists -- anywhere.
+!
 MODULE types
   type :: tp4
     PRIVATE
@@ -26,15 +29,42 @@
 END MODULE
 
 MODULE nml
-USE types
-   type(tp1) :: t1
-   type(tp4) :: t4
+  USE types
 
-   namelist /a/ t1    ! { dg-error "has PRIVATE components and cannot be a member of PUBLIC namelist" }
-   namelist /b/ t4    ! { dg-error "has PRIVATE components and cannot be a member of PUBLIC namelist" }
+  type(tp1) :: t1
+  type(tp4) :: t4
 
+  namelist /a/ t1          ! { dg-error "use-associated PRIVATE components" }
+  namelist /b/ t4          ! { dg-error "use-associated PRIVATE components" }
+
   integer, private :: i
-  namelist /c/ i      ! { dg-error "was declared PRIVATE and cannot be member of PUBLIC namelist" }
+  namelist /c/ i           ! { dg-error "was declared PRIVATE and cannot be member of PUBLIC namelist" }
+
+contains
+  subroutine y()
+   type(tp2) :: y2
+   type(tp3) :: y3
+
+    namelist /nml2/ y2     ! { dg-error "has use-associated PRIVATE components " }
+    namelist /nml3/ y3     ! { dg-error "has use-associated PRIVATE components " }
+  end subroutine
 END MODULE
 
+
+program xxx
+  use types
+
+  type :: tp5
+    TYPE(tp4) :: t        ! nested private components
+  end type
+  type(tp5) :: t5
+
+  namelist /nml/ t5       ! { dg-error "has use-associated PRIVATE components" }
+
+contains
+  subroutine z()
+    namelist /nml2/ t5    ! { dg-error "has use-associated PRIVATE components" }
+  end subroutine
+end program
+
 ! { dg-final { cleanup-modules "types nml" } }
Index: testsuite/gfortran.dg/namelist_36.f90
===================================================================
--- testsuite/gfortran.dg/namelist_36.f90	(revision 0)
+++ testsuite/gfortran.dg/namelist_36.f90	(revision 0)
@@ -0,0 +1,29 @@
+! { dg-compile }
+!
+! Private types and types with private components
+! are acceptable in local namelists.
+!
+
+MODULE nml
+  type :: tp1
+    integer :: i
+  end type
+
+  type :: tp2
+    private
+    integer :: i
+  end type
+
+  private :: tp1
+contains
+  subroutine x()
+   type(tp1) :: t1
+   type(tp2) :: t2
+
+    namelist /nml1/ i        ! ok, private variable
+    namelist /nml2/ t1       ! ok, private type
+    namelist /nml3/ t2       ! ok, private components
+  end subroutine
+END MODULE
+
+! { dg-final { cleanup-modules "nml" } }