re PR fortran/52846 ([F2008] Support submodules)

2015-08-05  Paul Thomas  <pault@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-08-05  Paul Thomas  <pault@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

From-SVN: r226622

gcc/fortran/ChangeLog

@@ -1,3 +1,21 @@
+2015-08-05  Paul Thomas  <pault@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-08-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/64022

gcc/fortran/module.c

@@ -5283,9 +5283,14 @@ read_module (void)
    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)
@@ -5961,8 +5966,8 @@ read_crc32_from_module_file (const char* filename, uLong* crc)
    processing the module, dump_flag will be set to zero and we delete
    the module file, even if it was already there.  */
 
-void
+static void
-gfc_dump_module (const char *name, int dump_flag)
+dump_module (const char *name, int dump_flag)
 {
   int n;
   char *filename, *filename_tmp;
@@ -5970,13 +5975,13 @@ gfc_dump_module (const char *name, int dump_flag)
 
   module_name = gfc_get_string (name);
 
-  if (gfc_state_stack->state == COMP_SUBMODULE)
+  if (dump_smod)
     {
       name = submodule_name;
       n = strlen (name) + strlen (SUBMODULE_EXTENSION) + 1;
     }
   else
-  n = strlen (name) + strlen (MODULE_EXTENSION) + 1;
+    n = strlen (name) + strlen (MODULE_EXTENSION) + 1;
 
   if (gfc_option.module_dir != NULL)
     {
@@ -5991,7 +5996,7 @@ gfc_dump_module (const char *name, int dump_flag)
       strcpy (filename, name);
     }
 
-  if (gfc_state_stack->state == COMP_SUBMODULE)
+  if (dump_smod)
     strcat (filename, SUBMODULE_EXTENSION);
   else
   strcat (filename, MODULE_EXTENSION);
@@ -6060,6 +6065,27 @@ gfc_dump_module (const char *name, int dump_flag)
 }
 
 
+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,
@@ -6754,13 +6780,12 @@ gfc_use_module (gfc_use_list *module)
 		     "USE statement at %C has no ONLY qualifier");
 
   if (gfc_state_stack->state == COMP_MODULE
-      || module->submodule_name == NULL
+      || module->submodule_name == NULL)
-      || strcmp (module_name, module->submodule_name) == 0)
     {
       filename = XALLOCAVEC (char, strlen (module_name)
 				   + strlen (MODULE_EXTENSION) + 1);
-  strcpy (filename, module_name);
+      strcpy (filename, module_name);
-  strcat (filename, MODULE_EXTENSION);
+      strcat (filename, MODULE_EXTENSION);
     }
   else
     {

gcc/fortran/trans-decl.c

@@ -596,6 +596,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
 	 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.  */
@@ -609,9 +614,13 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
       /* 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_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
@@ -837,9 +846,13 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
 	  else
 	    TREE_STATIC (token) = 1;
 
-	  if (sym->attr.use_assoc || sym->attr.access != ACCESS_PRIVATE ||
+	  TREE_PUBLIC (token) = 1;
-	      sym->attr.public_used)
+
-	    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
 	{
@@ -1747,9 +1760,12 @@ get_proc_pointer_decl (gfc_symbol *sym)
   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
+      TREE_PUBLIC (decl) = 1;
-	  && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used))
+      if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
-	TREE_PUBLIC (decl) = 1;
+	{
+	  DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+	  DECL_VISIBILITY_SPECIFIED (decl) = true;
+	}
       TREE_STATIC (decl) = 1;
     }
 

gcc/testsuite/ChangeLog

@@ -1,3 +1,19 @@
+2015-08-05  Paul Thomas  <pault@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.
+
 2015-08-05  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/66595

gcc/testsuite/gfortran.dg/public_private_module_2.f90

@@ -18,12 +18,15 @@
         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" } }
+      ! { 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" } }
+      ! { dg-final { scan-assembler-not "mmmm" { xfail *-*-* } } }
       ! { dg-final { scan-assembler "nnn" } }
       ! { dg-final { scan-assembler "oo" } }
       ! { dg-final { scan-assembler "__mod_MOD_qq" } }

gcc/testsuite/gfortran.dg/public_private_module_6.f90

@@ -11,4 +11,7 @@ module m
   integer, save :: aaaa
 end module m
 
-! { dg-final { scan-assembler-not "aaaa" } }
+! 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 *-*-* } } }

gcc/testsuite/gfortran.dg/submodule_1.f08

@@ -170,6 +170,6 @@
      message2 = ""
    end subroutine
  end program
-! { dg-final { cleanup-submodules "foo_interface_son" } }
+! { dg-final { cleanup-submodules "foo_interface@foo_interface_son" } }
-! { dg-final { cleanup-submodules "foo_interface_grandson" } }
+! { dg-final { cleanup-submodules "foo_interface@foo_interface_grandson" } }
-! { dg-final { cleanup-submodules "foo_interface_daughter" } }
+! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }

gcc/testsuite/gfortran.dg/submodule_10.f08

@@ -0,0 +1,170 @@
+! { dg-do compile }
+!
+! Checks that PRIVATE enities are visible to submodules.
+!
+! Contributed by Salvatore Filippone  <salvatore.filippone@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" } }
+

gcc/testsuite/gfortran.dg/submodule_5.f08

@@ -49,3 +49,4 @@ contains
 end SUBMODULE foo_interface_daughter
 
 end
+! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }

gcc/testsuite/gfortran.dg/submodule_9.f08

@@ -38,3 +38,4 @@ program a_s
   implicit none
   call p()
 end program
+! { dg-final { cleanup-submodules "mod_a@b" } }

gcc/testsuite/lib/fortran-modules.exp

@@ -17,6 +17,7 @@
 # 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] {
@@ -27,6 +28,7 @@ proc cleanup-modules { modlist } {
 	}
 	remote_file build delete $m
     }
+    cleanup-submodules $modlist
 }
 
 # Remove files for specified Fortran submodules.