[Patch, Fortran] PR 32460 - Check PRIVATE attribute for derived components

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

The initial problem (PR 32460) was that structure constructors where
accepted for derived types where all components are private (private
statement). - Thanks Daniel for finding this.

I then saw that for components with private attribute (!) the "private"
was completely ignored ...
(The latter is by the way a Fortran 2003 feature supported by only few
compilers.)

Build & regression tested on x86_64-unknown-linux-gnu with no new failures.
Ok for the trunk?

Tobias

2007-06-23  Tobias Burnus  <burnus@net-de>

	PR fortran/32460
	* interface.c (gfc_compare_derived_types): Add access check.
	* symbol.c (gfc_find_component): Ditto.
	(gfc_set_component_attr,gfc_get_component_attr) Copy access state.
	* dump-parse-tree.c (gfc_show_components): Dump access state.
	* gfortran.h (struct gfc_component): Add gfc_access.
	* module.c (mio_component): Add access state.
	* (gfc_match_structure_constructor): Check for private access state.

2007-06-23  Tobias Burnus  <burnus@net-de>

	PR fortran/32460
	* gfortran.dg/private_type_6.f90: New.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 125971)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -364,6 +364,9 @@ gfc_compare_derived_types (gfc_symbol *d
       if (strcmp (dt1->name, dt2->name) != 0)
 	return 0;
 
+      if (dt1->access != dt2->access)
+	return 0;
+
       if (dt1->pointer != dt2->pointer)
 	return 0;
 
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 125971)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -1615,7 +1615,8 @@ gfc_find_component (gfc_symbol *sym, con
 	       name, sym->name);
   else
     {
-      if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE)
+      if (sym->attr.use_assoc && (sym->component_access == ACCESS_PRIVATE
+				  || p->access == ACCESS_PRIVATE))
 	{
 	  gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
 		     name, sym->name);
@@ -1656,6 +1657,7 @@ gfc_set_component_attr (gfc_component *c
   c->dimension = attr->dimension;
   c->pointer = attr->pointer;
   c->allocatable = attr->allocatable;
+  c->access = attr->access;
 }
 
 
@@ -1670,6 +1672,7 @@ gfc_get_component_attr (symbol_attribute
   attr->dimension = c->dimension;
   attr->pointer = c->pointer;
   attr->allocatable = c->allocatable;
+  attr->access = c->access;
 }
 
 
Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c	(Revision 125971)
+++ gcc/fortran/dump-parse-tree.c	(Arbeitskopie)
@@ -620,6 +620,8 @@ gfc_show_components (gfc_symbol *sym)
       gfc_show_typespec (&c->ts);
       if (c->pointer)
 	gfc_status (" POINTER");
+      if (c->access == ACCESS_PRIVATE)
+	gfc_status (" PRIVATE");
       if (c->dimension)
 	gfc_status (" DIMENSION");
       gfc_status_char (' ');
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 125971)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -743,6 +743,7 @@ typedef struct gfc_component
   gfc_typespec ts;
 
   int pointer, allocatable, dimension;
+  gfc_access access;
   gfc_array_spec *as;
 
   tree backend_decl;
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(Revision 125971)
+++ gcc/fortran/module.c	(Arbeitskopie)
@@ -2065,6 +2065,7 @@ mio_component (gfc_component *c)
   mio_integer (&c->dimension);
   mio_integer (&c->pointer);
   mio_integer (&c->allocatable);
+  c->access = MIO_NAME (gfc_access) (c->access, access_types); 
 
   mio_expr (&c->initializer);
   mio_rparen ();
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(Revision 125971)
+++ gcc/fortran/primary.c	(Arbeitskopie)
@@ -1888,6 +1888,7 @@ gfc_match_structure_constructor (gfc_sym
   gfc_expr *e;
   locus where;
   match m;
+  int private_comp = 0;
 
   head = tail = NULL;
 
@@ -1900,6 +1901,11 @@ gfc_match_structure_constructor (gfc_sym
 
   for (comp = sym->components; comp; comp = comp->next)
     {
+      if (comp->access == ACCESS_PRIVATE)
+	{
+	  private_comp = 1;
+	  break;
+	}
       if (head == NULL)
 	tail = head = gfc_get_constructor ();
       else
@@ -1928,6 +1934,14 @@ gfc_match_structure_constructor (gfc_sym
       break;
     }
 
+  if (sym->attr.use_assoc
+      && (sym->component_access == ACCESS_PRIVATE || private_comp))
+    {
+      gfc_error ("Structure constructor for '%s' at %C has PRIVATE "
+		 "components", sym->name);
+      goto cleanup;
+    }
+
   if (gfc_match_char (')') != MATCH_YES)
     goto syntax;
 
Index: gcc/testsuite/gfortran.dg/private_type_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/private_type_6.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/private_type_6.f90	(Revision 0)
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! PR fortran/32460
+!
+module foomod
+  implicit none
+  type :: footype
+    private
+    integer :: dummy
+  end type footype
+  TYPE :: bartype
+    integer :: dummy
+    integer, private :: dummy2
+  end type bartype
+end module foomod
+
+program foo_test
+  USE foomod
+  implicit none
+  TYPE(footype) :: foo
+  TYPE(bartype) :: foo2
+  foo  = footype(1) ! { dg-error "has PRIVATE components" }
+  foo2 = bartype(1,2) ! { dg-error "has PRIVATE components" }
+  foo2%dummy2 = 5 ! { dg-error "is a PRIVATE component" }
+end program foo_test