Dear All, Another straightforward patch, although it took some head scratching to realize how simple the fix could be :-)
Bootstraps and regtests on FC23/x_86_64 - OK for trunk and 6-branch? Cheers Paul 2017-02-15 Paul Thomas <pa...@gcc.gnu.org> PR fortran/79434 * parse.c (check_component, parse_union): Whitespace. (set_syms_host_assoc): For a derived type, check if the module in which it was declared is one of the submodule ancestors. If it is, make the components public. Otherwise, reset attribute 'host_assoc' and set 'use-assoc' so that encapsulation is preserved. 2017-02-15 Paul Thomas <pa...@gcc.gnu.org> PR fortran/79434 * gfortran.dg/submodule_25.f08 : New test.
Index: gcc/fortran/parse.c =================================================================== *** gcc/fortran/parse.c (revision 245196) --- gcc/fortran/parse.c (working copy) *************** check_component (gfc_symbol *sym, gfc_co *** 2917,2923 **** coarray = true; sym->attr.coarray_comp = 1; } ! if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp && !c->attr.pointer) { --- 2917,2923 ---- coarray = true; sym->attr.coarray_comp = 1; } ! if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp && !c->attr.pointer) { *************** parse_union (void) *** 3081,3087 **** /* Add a component to the union for each map. */ if (!gfc_add_component (un, gfc_new_block->name, &c)) { ! gfc_internal_error ("failed to create map component '%s'", gfc_new_block->name); reject_statement (); return; --- 3081,3087 ---- /* Add a component to the union for each map. */ if (!gfc_add_component (un, gfc_new_block->name, &c)) { ! gfc_internal_error ("failed to create map component '%s'", gfc_new_block->name); reject_statement (); return; *************** static void *** 5809,5814 **** --- 5809,5817 ---- set_syms_host_assoc (gfc_symbol *sym) { gfc_component *c; + const char dot[2] = "."; + char parent1[GFC_MAX_SYMBOL_LEN + 1]; + char parent2[GFC_MAX_SYMBOL_LEN + 1]; if (sym == NULL) return; *************** set_syms_host_assoc (gfc_symbol *sym) *** 5816,5831 **** if (sym->attr.module_procedure) sym->attr.external = 0; - /* sym->attr.access = ACCESS_PUBLIC; */ - sym->attr.use_assoc = 0; sym->attr.host_assoc = 1; sym->attr.used_in_submodule =1; if (sym->attr.flavor == FL_DERIVED) { ! for (c = sym->components; c; c = c->next) ! c->attr.access = ACCESS_PUBLIC; } } --- 5819,5850 ---- if (sym->attr.module_procedure) sym->attr.external = 0; sym->attr.use_assoc = 0; sym->attr.host_assoc = 1; sym->attr.used_in_submodule =1; if (sym->attr.flavor == FL_DERIVED) { ! /* Derived types with PRIVATE components that are declared in ! modules other than the parent module must not be changed to be ! PUBLIC. The 'use-assoc' attribute must be reset so that the ! test in symbol.c(gfc_find_component) works correctly. This is ! not necessary for PRIVATE symbols since they are not read from ! the module. */ ! memset(parent1, '\0', sizeof(parent1)); ! memset(parent2, '\0', sizeof(parent2)); ! strcpy (parent1, gfc_new_block->name); ! strcpy (parent2, sym->module); ! if (strcmp (strtok (parent1, dot), strtok (parent2, dot)) == 0) ! { ! for (c = sym->components; c; c = c->next) ! c->attr.access = ACCESS_PUBLIC; ! } ! else ! { ! sym->attr.use_assoc = 1; ! sym->attr.host_assoc = 0; ! } } } Index: gcc/testsuite/gfortran.dg/submodule_25.f08 =================================================================== *** gcc/testsuite/gfortran.dg/submodule_25.f08 (nonexistent) --- gcc/testsuite/gfortran.dg/submodule_25.f08 (working copy) *************** *** 0 **** --- 1,43 ---- + ! { dg-do compile } + ! Test the fix for PR79434 in which the PRIVATE attribute of the + ! component 'i' of the derived type 't' was not respected in the + ! submodule 's_u'. + ! + ! Contributed by Reinhold Bader <ba...@lrz.de> + ! + module mod_encap_t + implicit none + type, public :: t + private + integer :: i + end type + end module + module mod_encap_u + use mod_encap_t + type, public, extends(t) :: u + private + integer :: j + end type + interface + module subroutine fu(this) + type(u), intent(inout) :: this + end subroutine + end interface + end module + submodule (mod_encap_u) s_u + contains + module procedure fu + ! the following statement should cause the compiler to + ! abort, pointing out a private component defined in + ! a USED module is being accessed + this%i = 2 ! { dg-error "is a PRIVATE component" } + this%j = 1 + write(*, *) 'FAIL' + end procedure + end submodule + program p + use mod_encap_u + implicit none + type(u) :: x + call fu(x) + end program