re PR fortran/32460 (structure constructor not allowed if a USEd type has private...

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.

From-SVN: r125984

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3876fc3ab0b3be10ff409189ac100f39243fb9c..6c9c3828c82db10a7dbad6951462f723ac36513a 100644 (file)
--- 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 51af1c401f2152e91a3e1235d4bbbd5427921930..5d26a78af1b6a08077a417c76ea1c950b78795e9 100644 (file)
--- 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 aa4c03508d4c7ea4c90aca4b447e4253bb4da5c6..9a653ce29acb362700eb3d03b796d164d4308b30 100644 (file)
--- 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 591e46e0af2209afa6aece9c9ed2b499e494425f..da8696b81da1d167712c1e523a36e2a14cd45768 100644 (file)
--- 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 876255f5849b63c4e655938dd19656e9773e59a4..14d26d9e43291bb09986ae7620de105dc5893332 100644 (file)
--- 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 90b1d6840e4e55c3d60abd0c6604b3dc9f2ff663..14253f6f1bd2efb0991b326514d706b6b989e018 100644 (file)
--- 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 3c11b645406b3b49a48dff2566cb94f78a3b6016..e1b27dc0fb764408a3826c51e7bc6359b8ad30fd 100644 (file)
--- 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 17bddb1a54a744e81365262cd97b732bef977959..1600cc04039a2df976ab5de22955a9d368d6267a 100644 (file)
--- 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 (file)
index 0000000..0d7ec53
--- /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" } }