2007-06-24 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-24  Tobias Burnus  <burnus@net-de>

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



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

9 files changed, 66 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3876fc3ab0..6c9c3828c82 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2007-06-24  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-24  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/32298
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 51af1c401f2..5d26a78af1b 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -624,6 +624,8 @@ gfc_show_components (gfc_symbol *sym)
 	gfc_status (" DIMENSION");
       gfc_status_char (' ');
       gfc_show_array_spec (c->as);
+      if (c->access)
+	gfc_status (" %s", gfc_code2string (access_types, c->access));
       gfc_status (")");
       if (c->next != NULL)
 	gfc_status_char (' ');
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aa4c03508d4..9a653ce29ac 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 591e46e0af2..da8696b81da 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -364,6 +364,9 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
       if (strcmp (dt1->name, dt2->name) != 0)
 	return 0;
 
+      if (dt1->access != dt2->access)
+	return 0;
+
       if (dt1->pointer != dt2->pointer)
 	return 0;
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 876255f5849..14d26d9e432 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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 ();
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 90b1d6840e4..14253f6f1bd 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1888,6 +1888,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
   gfc_expr *e;
   locus where;
   match m;
+  bool private_comp = false;
 
   head = tail = NULL;
 
@@ -1900,6 +1901,11 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
 
   for (comp = sym->components; comp; comp = comp->next)
     {
+      if (comp->access == ACCESS_PRIVATE)
+	{
+	  private_comp = true;
+	  break;
+	}
       if (head == NULL)
 	tail = head = gfc_get_constructor ();
       else
@@ -1928,6 +1934,14 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
       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;
 
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 3c11b645406..e1b27dc0fb7 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1615,7 +1615,8 @@ gfc_find_component (gfc_symbol *sym, const char *name)
 	       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, symbol_attribute *attr)
   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, gfc_component *c)
   attr->dimension = c->dimension;
   attr->pointer = c->pointer;
   attr->allocatable = c->allocatable;
+  attr->access = c->access;
 }
 
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 17bddb1a54a..1600cc04039 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-06-24  Tobias Burnus  <burnus@net-de>
+
+	PR fortran/32460
+	* gfortran.dg/private_type_6.f90: New.
+
 2007-06-24  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/31726
diff --git a/gcc/testsuite/gfortran.dg/private_type_6.f90 b/gcc/testsuite/gfortran.dg/private_type_6.f90
new file mode 100644
index 00000000000..0d7ec534be0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_6.f90
@@ -0,0 +1,25 @@
+! { 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
+! { dg-final { cleanup-tree-dump "foomod" } }