From 2eae3dc776d21ca736df7805977f39af98513b31 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 24 Jun 2007 18:19:11 +0200 Subject: [PATCH] re PR fortran/32460 (structure constructor not allowed if a USEd type has private components) 2007-06-24 Tobias Burnus 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 PR fortran/32460 * gfortran.dg/private_type_6.f90: New. From-SVN: r125984 --- gcc/fortran/ChangeLog | 11 +++++++++ gcc/fortran/dump-parse-tree.c | 2 ++ gcc/fortran/gfortran.h | 1 + gcc/fortran/interface.c | 3 +++ gcc/fortran/module.c | 1 + gcc/fortran/primary.c | 14 +++++++++++ gcc/fortran/symbol.c | 5 +++- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/private_type_6.f90 | 25 ++++++++++++++++++++ 9 files changed, 66 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/private_type_6.f90 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 + + 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 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 + + PR fortran/32460 + * gfortran.dg/private_type_6.f90: New. + 2007-06-24 Paul Thomas 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" } }