re PR fortran/79434 ([submodules] separate module procedure breaks encapsulation)
2017-02-20 Paul Thomas <pault@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-20 Paul Thomas <pault@gcc.gnu.org> PR fortran/79434 * gfortran.dg/submodule_25.f08 : New test. From-SVN: r245595
This commit is contained in:
parent
8f712b7690
commit
1ca6a74f89
4 changed files with 83 additions and 6 deletions
|
@ -1,3 +1,13 @@
|
|||
2017-02-20 Paul Thomas <pault@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-19 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/79447
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2017-02-20 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/79434
|
||||
* gfortran.dg/submodule_25.f08 : New test.
|
||||
|
||||
2017-02-19 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/79447
|
||||
|
|
43
gcc/testsuite/gfortran.dg/submodule_25.f08
Normal file
43
gcc/testsuite/gfortran.dg/submodule_25.f08
Normal file
|
@ -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 <Bader@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
|
Loading…
Add table
Reference in a new issue