Dear All,
On 24 July 2015 at 10:08, Damian Rouson <dam...@sourceryinstitute.org> wrote:
> I love this idea and had similar thoughts as well.
>
> :D
>
> Sent from my iPhone
>
>> On Jul 24, 2015, at 1:06 AM, Paul Richard Thomas
>> <paul.richard.tho...@gmail.com> wrote:
>>
>> Dear Mikael,
>>
>> It had crossed my mind also that a .mod and a .smod file could be
>> written. Normally, the .smod files are produced by the submodules
>> themselves, so that their descendants can pick up the symbols that
>> they generate. There is no reason at all why this could not be
>> implemented; early on in the development I did just this, although I
>> think that it would now be easier to modify this patch.
>>
>> One huge advantage of proceeding in this way is that any resulting
>> library can be distributed with the .mod file alone so that the
>> private entities are never exposed. The penalty is that a second file
>> is output.
>>
>> With best regards
>>
>> Paul
>>
Please find attached the implementation of this suggestion.
Bootstraps and regtests on FC21/x86_64 - OK for trunk or is the
original preferred?
Cheers
Paul
2015-07-29 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/52846
* module.c (check_access): Return true if new static flag
'dump_smod' is true..
(gfc_dump_module): Rename original 'dump_module' and call from
new version. Use 'dump_smod' rather than the stack state to
determine if a submodule is being processed. The new version of
this procedure sets 'dump_smod' depending on the stack state and
then writes both the mod and smod files if a module is being
processed or just the smod for a submodule.
(gfc_use_module): Eliminate the check for module_name and
submodule_name being the same.
* trans-decl.c (gfc_finish_var_decl, gfc_build_qualified_array,
get_proc_pointer_decl): Set TREE_PUBLIC unconditionally and use
the conditions to set DECL_VISIBILITY as hidden and to set as
true DECL_VISIBILITY_SPECIFIED.
2015-07-29 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/52846
* lib/fortran-modules.exp: Call cleanup-submodules from
cleanup-modules.
* gfortran.dg/public_private_module_2.f90: Add two XFAILS to
cover the cases where private entities are no longer optimized
away.
* gfortran.dg/public_private_module_6.f90: Add an XFAIL for the
same reason.
* gfortran.dg/submodule_1.f08: Change cleanup module names.
* gfortran.dg/submodule_5.f08: The same.
* gfortran.dg/submodule_9.f08: The same.
* gfortran.dg/submodule_10.f08: New test
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c (revision 226054)
--- gcc/fortran/module.c (working copy)
*************** read_module (void)
*** 5283,5291 ****
--- 5283,5296 ----
PRIVATE, then private, and otherwise it is public unless the default
access in this context has been declared PRIVATE. */
+ static bool dump_smod = false;
+
static bool
check_access (gfc_access specific_access, gfc_access default_access)
{
+ if (dump_smod)
+ return true;
+
if (specific_access == ACCESS_PUBLIC)
return TRUE;
if (specific_access == ACCESS_PRIVATE)
*************** read_crc32_from_module_file (const char*
*** 5961,5968 ****
processing the module, dump_flag will be set to zero and we delete
the module file, even if it was already there. */
! void
! gfc_dump_module (const char *name, int dump_flag)
{
int n;
char *filename, *filename_tmp;
--- 5966,5973 ----
processing the module, dump_flag will be set to zero and we delete
the module file, even if it was already there. */
! static void
! dump_module (const char *name, int dump_flag)
{
int n;
char *filename, *filename_tmp;
*************** gfc_dump_module (const char *name, int d
*** 5970,5976 ****
module_name = gfc_get_string (name);
! if (gfc_state_stack->state == COMP_SUBMODULE)
{
name = submodule_name;
n = strlen (name) + strlen (SUBMODULE_EXTENSION) + 1;
--- 5975,5981 ----
module_name = gfc_get_string (name);
! if (dump_smod)
{
name = submodule_name;
n = strlen (name) + strlen (SUBMODULE_EXTENSION) + 1;
*************** gfc_dump_module (const char *name, int d
*** 5991,5997 ****
strcpy (filename, name);
}
! if (gfc_state_stack->state == COMP_SUBMODULE)
strcat (filename, SUBMODULE_EXTENSION);
else
strcat (filename, MODULE_EXTENSION);
--- 5996,6002 ----
strcpy (filename, name);
}
! if (dump_smod)
strcat (filename, SUBMODULE_EXTENSION);
else
strcat (filename, MODULE_EXTENSION);
*************** gfc_dump_module (const char *name, int d
*** 6060,6065 ****
--- 6065,6091 ----
}
+ void
+ gfc_dump_module (const char *name, int dump_flag)
+ {
+ if (gfc_state_stack->state == COMP_SUBMODULE)
+ dump_smod = true;
+ else
+ dump_smod =false;
+
+ dump_module (name, dump_flag);
+
+ if (dump_smod)
+ return;
+
+ /* Write a submodule file from a module. The 'dump_smod' flag switches
+ off the check for PRIVATE entities. */
+ dump_smod = true;
+ submodule_name = module_name;
+ dump_module (name, dump_flag);
+ dump_smod = false;
+ }
+
static void
create_intrinsic_function (const char *name, int id,
const char *modname, intmod_id module,
*************** gfc_use_module (gfc_use_list *module)
*** 6754,6761 ****
"USE statement at %C has no ONLY qualifier");
if (gfc_state_stack->state == COMP_MODULE
! || module->submodule_name == NULL
! || strcmp (module_name, module->submodule_name) == 0)
{
filename = XALLOCAVEC (char, strlen (module_name)
+ strlen (MODULE_EXTENSION) + 1);
--- 6780,6786 ----
"USE statement at %C has no ONLY qualifier");
if (gfc_state_stack->state == COMP_MODULE
! || module->submodule_name == NULL)
{
filename = XALLOCAVEC (char, strlen (module_name)
+ strlen (MODULE_EXTENSION) + 1);
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 226054)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_finish_var_decl (tree decl, gfc_symb
*** 596,601 ****
--- 596,606 ----
both, of course.) (J3/04-007, section 15.3). */
TREE_PUBLIC(decl) = 1;
DECL_COMMON(decl) = 1;
+ if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
+ {
+ DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+ DECL_VISIBILITY_SPECIFIED (decl) = true;
+ }
}
/* If a variable is USE associated, it's always external. */
*************** gfc_finish_var_decl (tree decl, gfc_symb
*** 609,617 ****
/* TODO: Don't set sym->module for result or dummy variables. */
gcc_assert (current_function_decl == NULL_TREE || sym->result == sym);
- if (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used)
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
}
/* Derived types are a bit peculiar because of the possibility of
--- 614,626 ----
/* TODO: Don't set sym->module for result or dummy variables. */
gcc_assert (current_function_decl == NULL_TREE || sym->result == sym);
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
+ if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
+ {
+ DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+ DECL_VISIBILITY_SPECIFIED (decl) = true;
+ }
}
/* Derived types are a bit peculiar because of the possibility of
*************** gfc_build_qualified_array (tree decl, gf
*** 837,845 ****
else
TREE_STATIC (token) = 1;
- if (sym->attr.use_assoc || sym->attr.access != ACCESS_PRIVATE ||
- sym->attr.public_used)
TREE_PUBLIC (token) = 1;
}
else
{
--- 846,858 ----
else
TREE_STATIC (token) = 1;
TREE_PUBLIC (token) = 1;
+
+ if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
+ {
+ DECL_VISIBILITY (token) = VISIBILITY_HIDDEN;
+ DECL_VISIBILITY_SPECIFIED (token) = true;
+ }
}
else
{
*************** get_proc_pointer_decl (gfc_symbol *sym)
*** 1747,1755 ****
else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE)
{
/* This is the declaration of a module variable. */
- if (sym->ns->proc_name->attr.flavor == FL_MODULE
- && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used))
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
}
--- 1760,1771 ----
else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE)
{
/* This is the declaration of a module variable. */
TREE_PUBLIC (decl) = 1;
+ if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
+ {
+ DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+ DECL_VISIBILITY_SPECIFIED (decl) = true;
+ }
TREE_STATIC (decl) = 1;
}
Index: gcc/testsuite/lib/fortran-modules.exp
===================================================================
*** gcc/testsuite/lib/fortran-modules.exp (revision 226054)
--- gcc/testsuite/lib/fortran-modules.exp (working copy)
***************
*** 17,22 ****
--- 17,23 ----
# helper to deal with fortran modules
# Remove files for specified Fortran modules.
+ # This includes both .mod and .smod files.
proc cleanup-modules { modlist } {
global clean
foreach mod [concat $modlist $clean] {
*************** proc cleanup-modules { modlist } {
*** 27,32 ****
--- 28,34 ----
}
remote_file build delete $m
}
+ cleanup-submodules $modlist
}
# Remove files for specified Fortran submodules.
Index: gcc/testsuite/gfortran.dg/public_private_module_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/public_private_module_2.f90 (revision
226054)
--- gcc/testsuite/gfortran.dg/public_private_module_2.f90 (working copy)
***************
*** 18,29 ****
integer, bind(C,name='') :: qq
end module mod
! { dg-final { scan-assembler "__mod_MOD_aa" } }
! ! { dg-final { scan-assembler-not "iii" } }
! { dg-final { scan-assembler "jj" } }
! { dg-final { scan-assembler "lll" } }
! { dg-final { scan-assembler-not "kk" } }
! ! { dg-final { scan-assembler-not "mmmm" } }
! { dg-final { scan-assembler "nnn" } }
! { dg-final { scan-assembler "oo" } }
! { dg-final { scan-assembler "__mod_MOD_qq" } }
--- 18,32 ----
integer, bind(C,name='') :: qq
end module mod
+ ! The two xfails below have appeared with the introduction of submodules.
'iii' and
+ ! 'mmm' now are TREE_PUBLIC but has DECL_VISIBILITY (decl) =
VISIBILITY_HIDDEN set.
+
! { dg-final { scan-assembler "__mod_MOD_aa" } }
! ! { dg-final { scan-assembler-not "iii" { xfail *-*-* } } }
! { dg-final { scan-assembler "jj" } }
! { dg-final { scan-assembler "lll" } }
! { dg-final { scan-assembler-not "kk" } }
! ! { dg-final { scan-assembler-not "mmmm" { xfail *-*-* } } }
! { dg-final { scan-assembler "nnn" } }
! { dg-final { scan-assembler "oo" } }
! { dg-final { scan-assembler "__mod_MOD_qq" } }
Index: gcc/testsuite/gfortran.dg/public_private_module_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/public_private_module_6.f90 (revision
226054)
--- gcc/testsuite/gfortran.dg/public_private_module_6.f90 (working copy)
*************** module m
*** 11,14 ****
integer, save :: aaaa
end module m
! ! { dg-final { scan-assembler-not "aaaa" } }
--- 11,17 ----
integer, save :: aaaa
end module m
! ! The xfail below has appeared with the introduction of submodules. 'aaaa'
! ! now is TREE_PUBLIC but has DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN set.
!
! ! { dg-final { scan-assembler-not "aaaa" { xfail *-*-* } } }
Index: gcc/testsuite/gfortran.dg/submodule_1.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_1.f08 (revision 226054)
--- gcc/testsuite/gfortran.dg/submodule_1.f08 (working copy)
***************
*** 170,175 ****
message2 = ""
end subroutine
end program
! ! { dg-final { cleanup-submodules "foo_interface_son" } }
! ! { dg-final { cleanup-submodules "foo_interface_grandson" } }
! ! { dg-final { cleanup-submodules "foo_interface_daughter" } }
--- 170,175 ----
message2 = ""
end subroutine
end program
! ! { dg-final { cleanup-submodules "foo_interface@foo_interface_son" } }
! ! { dg-final { cleanup-submodules "foo_interface@foo_interface_grandson" } }
! ! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }
Index: gcc/testsuite/gfortran.dg/submodule_10.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_10.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_10.f08 (working copy)
***************
*** 0 ****
--- 1,170 ----
+ ! { dg-do compile }
+ !
+ ! Checks that PRIVATE enities are visible to submodules.
+ !
+ ! Contributed by Salvatore Filippone <salvatore.filipp...@uniroma2.it>
+ !
+ module const_mod
+ integer, parameter :: ndig=8
+ integer, parameter :: ipk_ = selected_int_kind(ndig)
+ integer, parameter :: longndig=12
+ integer, parameter :: long_int_k_ = selected_int_kind(longndig)
+ integer, parameter :: mpik_ = kind(1)
+
+ integer(ipk_), parameter, public :: success_=0
+
+ end module const_mod
+
+
+ module error_mod
+ use const_mod
+
+ integer(ipk_), parameter, public :: act_ret_=0
+ integer(ipk_), parameter, public :: act_print_=1
+ integer(ipk_), parameter, public :: act_abort_=2
+
+ integer(ipk_), parameter, public :: no_err_ = 0
+
+ public error, errcomm, get_numerr, &
+ & error_handler, &
+ & ser_error_handler, par_error_handler
+
+
+ interface error_handler
+ module subroutine ser_error_handler(err_act)
+ integer(ipk_), intent(inout) :: err_act
+ end subroutine ser_error_handler
+ module subroutine par_error_handler(ictxt,err_act)
+ integer(mpik_), intent(in) :: ictxt
+ integer(ipk_), intent(in) :: err_act
+ end subroutine par_error_handler
+ end interface
+
+ interface error
+ module subroutine serror()
+ end subroutine serror
+ module subroutine perror(ictxt,abrt)
+ integer(mpik_), intent(in) :: ictxt
+ logical, intent(in), optional :: abrt
+ end subroutine perror
+ end interface
+
+
+ interface error_print_stack
+ module subroutine par_error_print_stack(ictxt)
+ integer(mpik_), intent(in) :: ictxt
+ end subroutine par_error_print_stack
+ module subroutine ser_error_print_stack()
+ end subroutine ser_error_print_stack
+ end interface
+
+ interface errcomm
+ module subroutine errcomm(ictxt, err)
+ integer(mpik_), intent(in) :: ictxt
+ integer(ipk_), intent(inout):: err
+ end subroutine errcomm
+ end interface errcomm
+
+
+ private
+
+ type errstack_node
+
+ integer(ipk_) :: err_code=0
+ character(len=20) :: routine=''
+ integer(ipk_),dimension(5) :: i_err_data=0
+ character(len=40) :: a_err_data=''
+ type(errstack_node), pointer :: next
+
+ end type errstack_node
+
+
+ type errstack
+ type(errstack_node), pointer :: top => null()
+ integer(ipk_) :: n_elems=0
+ end type errstack
+
+
+ type(errstack), save :: error_stack
+ integer(ipk_), save :: error_status = no_err_
+ integer(ipk_), save :: verbosity_level = 1
+ integer(ipk_), save :: err_action = act_abort_
+ integer(ipk_), save :: debug_level = 0, debug_unit,
serial_debug_level=0
+
+ contains
+ end module error_mod
+
+ submodule (error_mod) error_impl_mod
+ use const_mod
+ contains
+ ! checks whether an error has occurred on one of the processes in the
execution pool
+ subroutine errcomm(ictxt, err)
+ integer(mpik_), intent(in) :: ictxt
+ integer(ipk_), intent(inout):: err
+
+
+ end subroutine errcomm
+
+ subroutine ser_error_handler(err_act)
+ implicit none
+ integer(ipk_), intent(inout) :: err_act
+
+ if (err_act /= act_ret_) &
+ & call error()
+ if (err_act == act_abort_) stop
+
+ return
+ end subroutine ser_error_handler
+
+ subroutine par_error_handler(ictxt,err_act)
+ implicit none
+ integer(mpik_), intent(in) :: ictxt
+ integer(ipk_), intent(in) :: err_act
+
+ if (err_act == act_print_) &
+ & call error(ictxt, abrt=.false.)
+ if (err_act == act_abort_) &
+ & call error(ictxt, abrt=.true.)
+
+ return
+
+ end subroutine par_error_handler
+
+ subroutine par_error_print_stack(ictxt)
+ integer(mpik_), intent(in) :: ictxt
+
+ call error(ictxt, abrt=.false.)
+
+ end subroutine par_error_print_stack
+
+ subroutine ser_error_print_stack()
+
+ call error()
+ end subroutine ser_error_print_stack
+
+ subroutine serror()
+
+ implicit none
+
+ end subroutine serror
+
+ subroutine perror(ictxt,abrt)
+ use const_mod
+ implicit none
+ integer(mpik_), intent(in) :: ictxt
+ logical, intent(in), optional :: abrt
+
+ end subroutine perror
+
+ end submodule error_impl_mod
+
+ program testlk
+ use error_mod
+ implicit none
+
+ call error()
+
+ stop
+ end program testlk
+ ! { dg-final { cleanup-submodules "error_mod@error_impl_mod" } }
+
Index: gcc/testsuite/gfortran.dg/submodule_5.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_5.f08 (revision 226054)
--- gcc/testsuite/gfortran.dg/submodule_5.f08 (working copy)
*************** contains
*** 49,51 ****
--- 49,52 ----
end SUBMODULE foo_interface_daughter
end
+ ! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }
Index: gcc/testsuite/gfortran.dg/submodule_9.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_9.f08 (revision 226054)
--- gcc/testsuite/gfortran.dg/submodule_9.f08 (working copy)
*************** program a_s
*** 38,40 ****
--- 38,41 ----
implicit none
call p()
end program
+ ! { dg-final { cleanup-submodules "mod_a@b" } }
