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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182133
138bc75d-0d04-0410-961f-
82ee72b054a4
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
* io/transfer.c (require_numeric_type): New function.
(formatted_transfer_scalar_read, formatted_transfer_scalar_write):
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)
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;
}
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
* gfortran.dg/io_real_boz_3.f90: New.
* gfortran.dg/io_real_boz_4.f90: New.
--- /dev/null
+! { 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" } }