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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5f8e39d..adc065d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+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.
+
 2007-07-28  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/32880

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a0b79e5..a668bf4 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -702,9 +702,9 @@ typedef struct
   /* 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;

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 18b943d..9c524b2 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2822,12 +2822,6 @@ gfc_match_namelist (void)
              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++;

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 31b7c9b..447ba00 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1512,8 +1512,8 @@ typedef enum
   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 @@ static const mstring attr_bits[] =
     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_symbol_attribute (symbol_attribute *attr)
        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 @@ mio_symbol_attribute (symbol_attribute *attr)
            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;
            }
        }
     }

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 974f3a2..c8d223a 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1615,17 +1615,34 @@ parse_derived (void)
    */
   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 ();
 }

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1a5c001..a7edd16 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7027,45 +7027,75 @@ 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)
-             && !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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8f81053..5352bce 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,20 @@
+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.
+
 2007-07-28  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/32880

diff --git a/gcc/testsuite/gfortran.dg/assumed_shape_nml.f90 b/gcc/testsuite/gfortran.dg/namelist_31.f90
similarity index 80%
rename from gcc/testsuite/gfortran.dg/assumed_shape_nml.f90
rename to gcc/testsuite/gfortran.dg/namelist_31.f90
index c2a8808..b7aba98 100644 (file)
--- a/gcc/testsuite/gfortran.dg/assumed_shape_nml.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_31.f90
@@ -10,8 +10,8 @@ program assumed_shape_nml
   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

diff --git a/gcc/testsuite/gfortran.dg/assumed_size_nml.f90 b/gcc/testsuite/gfortran.dg/namelist_32.f90
similarity index 100%
rename from gcc/testsuite/gfortran.dg/assumed_size_nml.f90
rename to gcc/testsuite/gfortran.dg/namelist_32.f90

diff --git a/gcc/testsuite/gfortran.dg/namelist_33.f90 b/gcc/testsuite/gfortran.dg/namelist_33.f90
new file mode 100644 (file)
index 0000000..1642389
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_33.f90
@@ -0,0 +1,40 @@
+! { dg-do 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
+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" } }

diff --git a/gcc/testsuite/gfortran.dg/namelist_34.f90 b/gcc/testsuite/gfortran.dg/namelist_34.f90
new file mode 100644 (file)
index 0000000..be050d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_34.f90
@@ -0,0 +1,30 @@
+! { dg-do 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" } }

diff --git a/gcc/testsuite/gfortran.dg/namelist_35.f90 b/gcc/testsuite/gfortran.dg/namelist_35.f90
new file mode 100644 (file)
index 0000000..531f636
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_35.f90
@@ -0,0 +1,11 @@
+! { dg-do 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

diff --git a/gcc/testsuite/gfortran.dg/namelist_5.f90 b/gcc/testsuite/gfortran.dg/namelist_5.f90
index 401302d..d7ccfd1 100644 (file)
--- a/gcc/testsuite/gfortran.dg/namelist_5.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_5.f90
@@ -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