From 3787b8ffe0ccf1f5cc47c2065f535f8a944156ea Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 8 Dec 2011 19:56:58 +0100 Subject: [PATCH] re PR fortran/51378 ([OOP] Structure constructor wrongly rejects parent components if only child has PRIVATE comps) 2011-12-08 Tobias Burnus PR fortran/51378 * symbol.c (gfc_find_component): Fix access check of parent components. 2011-12-08 Tobias Burnus PR fortran/51378 * gfortran.dg/private_type_14.f90: New. From-SVN: r182133 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/symbol.c | 30 ++++++------- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/private_type_14.f90 | 43 +++++++++++++++++++ 4 files changed, 69 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/private_type_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 602059fce7b..986ee2d01e1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-12-08 Tobias Burnus + + PR fortran/51378 + * symbol.c (gfc_find_component): Fix access check of parent + components. + 2011-12-08 Tobias Burnus PR fortran/51407 diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index de42297981e..fcc1ccfec58 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2022,6 +2022,21 @@ gfc_find_component (gfc_symbol *sym, const char *name, if (strcmp (p->name, name) == 0) break; + if (p && sym->attr.use_assoc && !noaccess) + { + 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 (p == NULL && sym->attr.extension && sym->components->ts.type == BT_DERIVED) @@ -2037,21 +2052,6 @@ gfc_find_component (gfc_symbol *sym, const char *name, gfc_error ("'%s' at %C is not a member of the '%s' structure", name, sym->name); - else if (sym->attr.use_assoc && !noaccess) - { - 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; - } - } - return p; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9eef8568cdf..452fdddab13 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-12-08 Tobias Burnus + + PR fortran/51378 + * gfortran.dg/private_type_14.f90: New. + 2011-12-08 Tobias Burnus PR fortran/51407 diff --git a/gcc/testsuite/gfortran.dg/private_type_14.f90 b/gcc/testsuite/gfortran.dg/private_type_14.f90 new file mode 100644 index 00000000000..6c90b86411a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/private_type_14.f90 @@ -0,0 +1,43 @@ +! { dg-do compile } +! +! PR fortran/51378 +! +! Allow constructor to nonprivate parent compoents, +! even if the extension specified PRIVATE for its own components +! +! Contributed by Reinhold Bader +! +module type_ext + type :: vec + real, dimension(3) :: comp + integer :: len + end type vec + type, extends(vec) :: l_vec + private + character(len=20) :: label = '01234567890123456789' + end type l_vec +end module type_ext +program test_ext + use type_ext + implicit none + type(vec) :: o_vec, oo_vec + type(l_vec) :: o_l_vec + integer :: i +! + o_vec = vec((/1.0, 2.0, 3.0/),3) +! write(*,*) o_vec%comp, o_vec%len + o_l_vec = l_vec(comp=(/1.0, 2.0, 3.0/),len=3) +! partial constr. not accepted by ifort 11.1, fixed in 12.0 (issue 562240) +! write(*,*) o_l_vec%comp, o_l_vec%len +! write(*,*) o_l_vec%vec + oo_vec = o_l_vec%vec + do i=1, 3 + if (abs(oo_vec%comp(i) - o_vec%comp(i)) > 1.0E-5) then + write(*, *) 'FAIL' + stop + end if + end do + write(*, *) 'OK' +end program + +! { dg-final { cleanup-modules "type_ext" } }