From: Paul Thomas Date: Mon, 20 Feb 2017 09:42:48 +0000 (+0000) Subject: re PR fortran/79434 ([submodules] separate module procedure breaks encapsulation) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1ca6a74f8900cd8e18a5603eaea2c16f4f0d1e36;p=gcc.git re PR fortran/79434 ([submodules] separate module procedure breaks encapsulation) 2017-02-20 Paul Thomas 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-20 Paul Thomas PR fortran/79434 * gfortran.dg/submodule_25.f08 : New test. From-SVN: r245595 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fb7123472d7..78d40afea29 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2017-02-20 Paul Thomas + + 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-19 Paul Thomas PR fortran/79447 diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c9f8da46ed3..3809ec18556 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2917,7 +2917,7 @@ check_component (gfc_symbol *sym, gfc_component *c, gfc_component **lockp, coarray = true; sym->attr.coarray_comp = 1; } - + if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp && !c->attr.pointer) { @@ -3081,7 +3081,7 @@ parse_union (void) /* 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_internal_error ("failed to create map component '%s'", gfc_new_block->name); reject_statement (); return; @@ -5809,6 +5809,9 @@ static void 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; @@ -5816,16 +5819,32 @@ set_syms_host_assoc (gfc_symbol *sym) 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; + /* 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; + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1f6f9671022..fab1612270a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-02-20 Paul Thomas + + PR fortran/79434 + * gfortran.dg/submodule_25.f08 : New test. + 2017-02-19 Paul Thomas PR fortran/79447 diff --git a/gcc/testsuite/gfortran.dg/submodule_25.f08 b/gcc/testsuite/gfortran.dg/submodule_25.f08 new file mode 100644 index 00000000000..0581ce3ca76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_25.f08 @@ -0,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 +! +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