[patch, fortran] PRs 31818, 32876, 32905 - about namelists

[patch, fortran] PRs 31818, 32876, 32905 - about namelists

[Daniel Franke]

[-- Attachment #1: Type: text/plain, Size: 2428 bytes --]


To track pointer and private components in nested derived types (PR32876,, 
PR32905), two new bits were introduced in symbol_attribute: pointer_comp and 
private_comp. They are used analogously to alloc_comp - they are set if any 
component of a (nested) type is a pointer or has restricted access, 
respectively.

PR31818 was fixed by moving the test for assumed shape arrays from match.c 
(gfc_match_namelist) to resolve.c (resolve_fl_namelist) as as->type is not 
yet available in gfc_match_namelist() if no bound is specified, i.e.

  character(len=10) :: cha(1:)
  namelist /z/  cha               ! error, assumed shape

while

  character(len=10) :: cha(:)
  namelist /z/  cha

passed unnoticed. As assumed shape arrays already were accepted as an GNU 
extension and F2003 allows them officially, assumed shape arrays are now 
rejected only if -std=f95. The testcase namelist_31.f90 used this extension 
already, while namelist_35.f90 now sets the standard and checks for an error.


:ADDPATCH fortran:

gcc/fortran:
2007-07-28  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/31818
	PR fortran/32876
	PR fortran/32905
	* gfortran.h (symbol_attribute): Added bits for pointer_comp, private_comp.
	* parse.c (parse_derived): Set pointer_comp/private_comp bits if the derived
	type ultimately contains pointer components or private components.
	* module.c (ab_attribute): New values AB_POINTER_COMP, AB_PRIVATE_COMP.
	(attr_bits): Added names for new ab_attributes.
	(mio_symbol_attribute): Save/restore new attribute bits in modules.
	* match.c (gfc_match_namelist): Removed check for namelist objects of assumed
	shape.
	* resolve.c (resolve_fl_namelist): Added check for pointer or private
	components in nested types. Added check for namelist objects of assumed
	shape.

gcc/testsuite:
2007-07-28  Daniel Franke  <franke.daniel@gmail.com>

	* gfortran.dg/namelist_5.f90: Adjusted error message.

	* gfortran.dg/assumed_shape_nml.f90: Renamed to ...
	* gfortran.dg/namelist_31.f90: ... this. Removed dg-warning directive.
	* gfortran.dg/assumed_size_nml.f90: Renamed to ...
	* gfortran.dg/namelist_32.f90: ... this.

	PR fortran/32876
	* gfortran.dg/namelist_33.f90: New test.
	
	PR fortran/32905
	* gfortran.dg/namelist_34.f90: New test.

	PR fortran/31818
	* gfortran.dg/namelist_35.f90: New test.


Regression tested on i686-pc-linux-gnu, currently bootstrapping. 
Ok for trunk if successfull?

Regards
	Daniel

[-- Attachment #2: namelist.patch --]
[-- Type: text/x-diff, Size: 12408 bytes --]

Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h	(revision 126998)
+++ fortran/gfortran.h	(working copy)
@@ -702,9 +702,9 @@
   /* Special attributes for Cray pointers, pointees.  */
   unsigned cray_pointer:1, cray_pointee:1;
 
-  /* The symbol is a derived type with allocatable components, possibly
-     nested.  */
-  unsigned alloc_comp:1;
+  /* The symbol is a derived type with allocatable components, pointer 
+     components or private components, possibly nested.  */
+  unsigned alloc_comp:1, pointer_comp:1, private_comp:1;
 
   /* The namespace where the VOLATILE attribute has been set.  */
   struct gfc_namespace *volatile_ns;
Index: fortran/parse.c
===================================================================
--- fortran/parse.c	(revision 126998)
+++ fortran/parse.c	(working copy)
@@ -1615,18 +1615,35 @@
    */
   derived_sym = gfc_current_block();
 
-  /* Look for allocatable components.  */
   sym = gfc_current_block ();
   for (c = sym->components; c; c = c->next)
     {
+      /* Look for allocatable components.  */
       if (c->allocatable
 	  || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp))
 	{
 	  sym->attr.alloc_comp = 1;
 	  break;
 	}
-     }
 
+      /* Look for pointer components.  */
+      if (c->pointer
+	  || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp))
+	{
+	  sym->attr.pointer_comp = 1;
+	  break;
+	}
+
+      /* Look for private components.  */
+      if (sym->component_access == ACCESS_PRIVATE
+	  || c->access == ACCESS_PRIVATE
+	  || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp))
+	{
+	  sym->attr.private_comp = 1;
+	  break;
+	}
+    }
+
   pop_state ();
 }
 
Index: fortran/module.c
===================================================================
--- fortran/module.c	(revision 126998)
+++ fortran/module.c	(working copy)
@@ -1512,8 +1512,8 @@
   AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE,
   AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
   AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
-  AB_VALUE, AB_VOLATILE, AB_PROTECTED, AB_IS_BIND_C, AB_IS_C_INTEROP,
-  AB_IS_ISO_C
+  AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
+  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C
 }
 ab_attribute;
 
@@ -1548,6 +1548,8 @@
     minit ("IS_ISO_C", AB_IS_ISO_C),
     minit ("VALUE", AB_VALUE),
     minit ("ALLOC_COMP", AB_ALLOC_COMP),
+    minit ("POINTER_COMP", AB_POINTER_COMP),
+    minit ("PRIVATE_COMP", AB_PRIVATE_COMP),
     minit ("PROTECTED", AB_PROTECTED),
     minit (NULL, -1)
 };
@@ -1654,6 +1656,10 @@
 	MIO_NAME(ab_attribute) (AB_IS_ISO_C, attr_bits);
       if (attr->alloc_comp)
 	MIO_NAME (ab_attribute) (AB_ALLOC_COMP, attr_bits);
+      if (attr->pointer_comp)
+	MIO_NAME (ab_attribute) (AB_POINTER_COMP, attr_bits);
+      if (attr->private_comp)
+	MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
 
       mio_rparen ();
 
@@ -1760,6 +1766,12 @@
 	    case AB_ALLOC_COMP:
 	      attr->alloc_comp = 1;
 	      break;
+	    case AB_POINTER_COMP:
+	      attr->pointer_comp = 1;
+	      break;
+	    case AB_PRIVATE_COMP:
+	      attr->private_comp = 1;
+	      break;
 	    }
 	}
     }
Index: fortran/match.c
===================================================================
--- fortran/match.c	(revision 126998)
+++ fortran/match.c	(working copy)
@@ -2822,12 +2822,6 @@
 	      gfc_error_check ();
 	    }
 
-	  if (sym->as && sym->as->type == AS_ASSUMED_SHAPE
-	      && gfc_notify_std (GFC_STD_GNU, "Assumed shape array '%s' in "
-				 "namelist '%s' at %C is an extension.",
-				 sym->name, group_name->name) == FAILURE)
-	    gfc_error_check ();
-
 	  nl = gfc_get_namelist ();
 	  nl->sym = sym;
 	  sym->refs++;
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c	(revision 126998)
+++ fortran/resolve.c	(working copy)
@@ -7027,45 +7027,75 @@
     {
       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)
-	      && !gfc_check_access(nl->sym->attr.access,
-				   nl->sym->ns->default_access))
+	  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,
+				nl->sym->ns->default_access))
 	    {
-	      gfc_error ("PRIVATE symbol '%s' cannot be member of "
-			 "PUBLIC namelist at %L", nl->sym->name,
-			 &sym->declared_at);
+	      gfc_error ("NAMELIST object '%s' was declared PRIVATE and "
+			 "cannot be member of PUBLIC namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
 	      return FAILURE;
 	    }
+
+	  if (nl->sym->ts.type == BT_DERIVED
+	      && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
+				    ? 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",
+			 nl->sym->name, sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
 	}
     }
 
-  /* Reject namelist arrays that are not constant shape.  */
   for (nl = sym->namelist; nl; nl = nl->next)
     {
+      /* Reject namelist arrays of assumed shape.  */
+      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
+	  && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
+			     "must not have assumed shape in namelist "
+			     "'%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	    return FAILURE;
+
+      /* Reject namelist arrays that are not constant shape.  */
       if (is_non_constant_shape_array (nl->sym))
 	{
-	  gfc_error ("The array '%s' must have constant shape to be "
-		     "a NAMELIST object at %L", nl->sym->name,
-		     &sym->declared_at);
+	  gfc_error ("NAMELIST array object '%s' must have constant "
+		     "shape in namelist '%s' at %L", nl->sym->name,
+		     sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
-    }
 
-  /* Namelist objects cannot have allocatable components.  */
-  for (nl = sym->namelist; nl; nl = nl->next)
-    {
-      if (nl->sym->ts.type == BT_DERIVED
-	  && nl->sym->ts.derived->attr.alloc_comp)
+      /* Namelist objects cannot have allocatable or pointer components.  */
+      if (nl->sym->ts.type != BT_DERIVED)
+	continue;
+
+      if (nl->sym->ts.derived->attr.alloc_comp)
 	{
-	  gfc_error ("NAMELIST object '%s' at %L cannot have ALLOCATABLE "
-		     "components", nl->sym->name, &sym->declared_at);
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
+		     "have ALLOCATABLE components",
+		     nl->sym->name, sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
+
+      if (nl->sym->ts.derived->attr.pointer_comp)
+	{
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
+		     "have POINTER components", 
+		     nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
     }
 
+
   /* 14.1.2 A module or internal procedure represent local entities
      of the same type as a namelist member and so are not allowed.  */
   for (nl = sym->namelist; nl; nl = nl->next)
Index: testsuite/gfortran.dg/namelist_31.f90
===================================================================
--- testsuite/gfortran.dg/namelist_31.f90	(revision 126930)
+++ testsuite/gfortran.dg/namelist_31.f90	(working copy)
@@ -10,8 +10,8 @@
   call foo (z)
 contains
   subroutine foo (y)
-    real, DIMENSION (1:) :: y
-    namelist /mynml/ y     ! { dg-warning "is an extension" }
+    real, DIMENSION (:) :: y
+    namelist /mynml/ y
     write (*, mynml)
   end subroutine foo
 end program assumed_shape_nml
Index: testsuite/gfortran.dg/namelist_33.f90
===================================================================
--- testsuite/gfortran.dg/namelist_33.f90	(revision 0)
+++ testsuite/gfortran.dg/namelist_33.f90	(revision 0)
@@ -0,0 +1,43 @@
+! { dg-compile }
+!
+! PR fortran/32876 - accepts private items in public NAMELISTs
+!
+MODULE types
+  type :: tp4
+    PRIVATE
+    real :: x
+    integer :: i
+  end type
+
+  ! nested type
+  type :: tp3
+    real :: x
+    integer, private :: i
+  end type
+
+  type :: tp2
+    type(tp3) :: t
+  end type
+
+  type :: tp1
+    integer :: i
+    type(tp2) :: t
+  end type
+
+  integer, private :: i
+  namelist /nml/ i
+END MODULE
+
+MODULE nml
+USE types
+   type(tp1) :: t1
+   type(tp4) :: t4
+
+   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" }
+
+  integer, private :: i
+  namelist /c/ i      ! { dg-error "was declared PRIVATE and cannot be member of PUBLIC namelist" }
+END MODULE
+
+! { dg-final { cleanup-modules "types nml" } }
Index: testsuite/gfortran.dg/namelist_34.f90
===================================================================
--- testsuite/gfortran.dg/namelist_34.f90	(revision 0)
+++ testsuite/gfortran.dg/namelist_34.f90	(revision 0)
@@ -0,0 +1,30 @@
+! { dg-compile }
+!
+! PR fortran/32905 - accepts types with ultimate POINTER components
+!
+MODULE types
+  type :: tp3
+    real :: x
+    integer, pointer :: i
+  end type
+
+  type :: tp2
+    type(tp3) :: t
+  end type
+
+  type :: tp1
+    integer :: i
+    type(tp2) :: t
+  end type
+END MODULE
+
+MODULE nml
+USE types
+   type(tp1) :: t1
+   type(tp3) :: t3
+
+   namelist /a/ t1    ! { dg-error "cannot have POINTER components" }
+   namelist /b/ t3    ! { dg-error "cannot have POINTER components" }
+END MODULE
+
+! { dg-final { cleanup-modules "types nml" } }
Index: testsuite/gfortran.dg/namelist_35.f90
===================================================================
--- testsuite/gfortran.dg/namelist_35.f90	(revision 0)
+++ testsuite/gfortran.dg/namelist_35.f90	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/31818 - accepts namelists with assumed-shape arrays
+!
+
+subroutine test(cha)
+  implicit none
+  character(len=10) :: cha(:)
+  namelist /z/  cha             ! { dg-error "must not have assumed shape" }
+end subroutine test
Index: testsuite/gfortran.dg/namelist_5.f90
===================================================================
--- testsuite/gfortran.dg/namelist_5.f90	(revision 126998)
+++ testsuite/gfortran.dg/namelist_5.f90	(working copy)
@@ -6,7 +6,7 @@
 !
 SUBROUTINE S1(I)
  integer :: a,b(I)
- NAMELIST /NLIST/ a,b ! { dg-error "must have constant shape to be a NAMELIST object" }
+ NAMELIST /NLIST/ a,b ! { dg-error "must have constant shape" }
  a=1 ; b=2
  write(6,NML=NLIST)
 END SUBROUTINE S1
Index: testsuite/gfortran.dg/assumed_size_nml.f90
===================================================================
--- testsuite/gfortran.dg/assumed_size_nml.f90	(revision 126998)
+++ testsuite/gfortran.dg/assumed_size_nml.f90	(working copy)
@@ -1,17 +0,0 @@
-! { dg-do compile }
-! One of two tests for the fix of PR23152 - An ICE would
-! ensue from assumed shape arrays in namelists.
-!
-! Conributed by Paul Thomas  <pault@gcc.gnu.org>
-!
-program assumed_size_nml
-  real, dimension (10) :: z
-  z = 42.0
-  call foo (z)
-contains
-  subroutine foo (y)
-    real, DIMENSION (*) :: y
-    namelist /mynml/ y     ! { dg-error "is not allowed" }
-    write (6, mynml)
-  end subroutine foo
-end program assumed_size_nml
\ No newline at end of file
Index: testsuite/gfortran.dg/assumed_shape_nml.f90
===================================================================
--- testsuite/gfortran.dg/assumed_shape_nml.f90	(revision 126998)
+++ testsuite/gfortran.dg/assumed_shape_nml.f90	(working copy)
@@ -1,17 +0,0 @@
-! { dg-do compile }
-! One of two tests for the fix of PR23152 - There used to be
-! no warning for assumed shape arrays in namelists.
-!
-! Conributed by Paul Thomas  <pault@gcc.gnu.org>
-!
-program assumed_shape_nml
-  real, dimension (10) :: z
-  z = 42.0
-  call foo (z)
-contains
-  subroutine foo (y)
-    real, DIMENSION (1:) :: y
-    namelist /mynml/ y     ! { dg-warning "is an extension" }
-    write (*, mynml)
-  end subroutine foo
-end program assumed_shape_nml

Re: [patch, fortran] PRs 31818, 32876, 32905 - about namelists

[Daniel Franke]

To avoid failures while testing, please remove the two lines indicated below 
from gfortran.dg/namelist_33.f90. I forgot to remove them before preparing 
the patch.


Index: testsuite/gfortran.dg/namelist_33.f90
===================================================================
--- testsuite/gfortran.dg/namelist_33.f90       (revision 0)
+++ testsuite/gfortran.dg/namelist_33.f90       (revision 0)
[...]
+
+  integer, private :: i      ! <<<<< remove
+  namelist /nml/ i           ! <<<<< remove
+END MODULE


By now, successfully boostrapped and regression tested on i686-pc-linux-gnu.

Re: [patch, fortran] PRs 31818, 32876, 32905 - about namelists

[Paul Thomas]

Daniel,
>
>
> Regression tested on i686-pc-linux-gnu, currently bootstrapping. 
> Ok for trunk if successfull?
>
>   
You bet! OK

Thanks

Paul

Re: [patch, fortran] PRs 31818, 32876, 32905 - about namelists

[Paul Thomas]

:REVIEWMAIL:

Daniel,
>
>
> Regression tested on i686-pc-linux-gnu, currently bootstrapping. 
> Ok for trunk if successfull?
>
>   
You are once again cleaning up after me!

OK for trunk with the correction in your subsequent message.

Paul