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:
Paul Thomas 2017-02-20 09:42:48 +00:00
parent 8f712b7690
commit 1ca6a74f89
4 changed files with 83 additions and 6 deletions

View File

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

View File

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

View File

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

View 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