procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/51378 ([OOP] Structure constructor wrongly rejects parent components if only child has PRIVATE comps)

Browse source 
2011-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51378
        * symbol.c (gfc_find_component): Fix access check of parent
        components.

2011-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51378
        * gfortran.dg/private_type_14.f90: New.

From-SVN: r182133
This commit is contained in:
Tobias Burnus 2011-12-08 19:56:58 +01:00 • committed by Tobias Burnus
parent 14dcdf69d5
commit 3787b8ffe0
4 changed files with 69 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/51378
* symbol.c (gfc_find_component): Fix access check of parent
components.
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/51407

30
gcc/fortran/symbol.c
View file

@ -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;
}

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/51378
* gfortran.dg/private_type_14.f90: New.
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/51407

43
gcc/testsuite/gfortran.dg/private_type_14.f90 Normal file
View file

@ -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" } }