diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 16 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/extends_10.f03 | 34 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/extends_6.f03 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/private_type_6.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/structure_constructor_8.f03 | 2 |
8 files changed, 64 insertions, 14 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b2741b1..d8e54e1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2010-01-19 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42545 + * resolve.c (resolve_fl_derived): Set the accessibility of the parent + component for extended types. + * symbol.c (gfc_find_component): Remove a wrongly-worded error message + and take care of parent component accessibility. + 2010-01-17 Janus Weil <janus@gcc.gnu.org> PR fortran/42677 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6bc5fde..8f32d1a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10494,6 +10494,12 @@ resolve_fl_derived (gfc_symbol *sym) && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE) return FAILURE; + /* If this type is an extension, set the accessibility of the parent + component. */ + if (super_type && c == sym->components + && strcmp (super_type->name, c->name) == 0) + c->attr.access = super_type->attr.access; + /* If this type is an extension, see if this component has the same name as an inherited type-bound procedure. */ if (super_type diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index a5787de..e363c5e 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1958,23 +1958,17 @@ gfc_find_component (gfc_symbol *sym, const char *name, else if (sym->attr.use_assoc && !noaccess) { - if (p->attr.access == ACCESS_PRIVATE) + bool is_parent_comp = sym->attr.extension && (p == sym->components); + if (p->attr.access == ACCESS_PRIVATE || + (p->attr.access != ACCESS_PUBLIC + && sym->component_access == ACCESS_PRIVATE + && !is_parent_comp)) { if (!silent) gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'", name, sym->name); return NULL; } - - /* If there were components given and all components are private, error - out at this place. */ - if (p->attr.access != ACCESS_PUBLIC && sym->component_access == ACCESS_PRIVATE) - { - if (!silent) - gfc_error ("All components of '%s' are PRIVATE in structure" - " constructor at %C", sym->name); - return NULL; - } } return p; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a4aafda..8b7c5ee 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2010-01-19 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42545 + * gfortran.dg/extends_6.f03: Modified an error message. + * gfortran.dg/extends_10.f03: New test. + * gfortran.dg/private_type_6.f03: Modified an error message. + * gfortran.dg/structure_constructor_8.f03: Ditto. + 2010-01-19 Jakub Jelinek <jakub@redhat.com> PR tree-optimization/42719 diff --git a/gcc/testsuite/gfortran.dg/extends_10.f03 b/gcc/testsuite/gfortran.dg/extends_10.f03 new file mode 100644 index 0000000..fbcaa7e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/extends_10.f03 @@ -0,0 +1,34 @@ +! { dg-do compile } +! +! PR 42545: type extension: parent component has wrong accessibility +! +! Reported by Reinhold Bader <bader@lrz.de> + +module mo + implicit none + type :: t1 + integer :: i = 1 + end type + type, extends(t1) :: t2 + private + real :: x = 2.0 + end type + type :: u1 + integer :: j = 1 + end type + type, extends(u1) :: u2 + real :: y = 2.0 + end type + private :: u1 +end module + +program pr + use mo + implicit none + type(t2) :: a + type(u2) :: b + print *,a%t1%i + print *,b%u1%j ! { dg-error "is a PRIVATE component of" } +end program + +! { dg-final { cleanup-modules "mo" } } diff --git a/gcc/testsuite/gfortran.dg/extends_6.f03 b/gcc/testsuite/gfortran.dg/extends_6.f03 index 866fbbd..a50a9b7 100644 --- a/gcc/testsuite/gfortran.dg/extends_6.f03 +++ b/gcc/testsuite/gfortran.dg/extends_6.f03 @@ -30,7 +30,7 @@ end module m end type two o_dt%day = 5 ! VALID but failed in first version of EXTENDS patch - o_dt%yr = 5 ! { dg-error "All components of 'date' are PRIVATE" } + o_dt%yr = 5 ! { dg-error "is a PRIVATE component of" } t = two(one = one(4), i = 5, r=4.4) ! { dg-error "has already been set" } diff --git a/gcc/testsuite/gfortran.dg/private_type_6.f90 b/gcc/testsuite/gfortran.dg/private_type_6.f90 index 5e13ed5..4af3f70 100644 --- a/gcc/testsuite/gfortran.dg/private_type_6.f90 +++ b/gcc/testsuite/gfortran.dg/private_type_6.f90 @@ -18,7 +18,7 @@ program foo_test implicit none TYPE(footype) :: foo TYPE(bartype) :: foo2 - foo = footype(1) ! { dg-error "All components of 'footype' are PRIVATE" } + foo = footype(1) ! { dg-error "is a PRIVATE component" } foo2 = bartype(1,2) ! { dg-error "is a PRIVATE component" } foo2%dummy2 = 5 ! { dg-error "is a PRIVATE component" } end program foo_test diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 index 520b528..b86d0ec 100644 --- a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 +++ b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 @@ -51,7 +51,7 @@ PROGRAM test struct1 = haspriv_t (b = 2, a = 1) ! { dg-error "is a PRIVATE component" } ! This should fail as all components are private - struct2 = allpriv_t (5) ! { dg-error "of 'allpriv_t' are PRIVATE" } + struct2 = allpriv_t (5) ! { dg-error "is a PRIVATE component" } ! This should fail as the type itself is private, and the expression should ! be deduced as call to an undefined function. |