Re: [Patch, fortran] PR79434 - [submodules] separate module procedure breaks encapsulation

[Paul Richard Thomas]

Hi Everybody,

Committed as revision 245595.

Thanks for the review.

Paul

On 16 February 2017 at 00:38, Jerry DeLisle  wrote:
> On 02/15/2017 10:12 AM, Paul Richard Thomas wrote:
>> 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?
>>
>
> Yes, OK
>
> Jerry



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [Patch, fortran] PR79434 - [submodules] separate module procedure breaks encapsulation

[Jerry DeLisle]

On 02/15/2017 10:12 AM, Paul Richard Thomas wrote:
> 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?
> 

Yes, OK

Jerry

[Patch, fortran] PR79434 - [submodules] separate module procedure breaks encapsulation

[Paul Richard Thomas]

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  

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  

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, ))
  {
!   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, ))
  {
!   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  
+ !
+ 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