Dear Reinhold, dear all,

Please find attached a new version of the patch that fixes the
inconsistency with the standard, pointed out by Reinhold. It is weird
but a read the appropriate part of the standard several times and
simply did not pick up the critical information :-)

Note that the delimiter used for submodule file name is '@', whereas
the internal identifiers is '.'.

I have added a procedure to cleanup submodules produced by the
testsuite and implemented them in submodule_[1-8].f90. Submodule_8.f90
tests the resolution of the spurious error found by Reinhold.

Booststraps and regtests on FC_21/x86_64 - OK for trunk?

Paul

2015-07-16  Paul Thomas  <pa...@gcc.gnu.org>

    PR fortran/52846
    * decl.c (gfc_match_end): Pick out declared submodule name from
    the composite identifier.
    * gfortran.h : Add 'submodule_name' to gfc_use_list structure.
    * module.c (gfc_match_submodule): Define submodule_name and add
    static 'submodule_name'.
    (gfc_match_submodule): Build up submodule filenames, using '@'
    as a delimiter. Store the output filename in 'submodule_name'.
    Similarly, the submodule identifier is built using '.' as an
    identifier.
    (gfc_dump_module): If current state is COMP_SUBMODULE, write
    to file 'submodule_name', using SUBMODULE_EXTENSION.
    (gfc_use_module): Similarly, use the 'submodule_name' field in
    the gfc_use_list structure and SUBMODULE_EXTENSION to read the
    implicitly used submodule files.

2015-07-16  Paul Thomas  <pa...@gcc.gnu.org>

    PR fortran/52846
    * lib/fortran-modules.exp (proc cleanup-submodules): New proc..
    * gfortran.dg/submodule_1.f90: Clean up submodules
    * gfortran.dg/submodule_2.f90: Clean up submodules
    * gfortran.dg/submodule_3.f90: Clean up submodules
    * gfortran.dg/submodule_4.f90: Clean up submodules
    * gfortran.dg/submodule_5.f90: Clean up submodules
    * gfortran.dg/submodule_6.f90: Clean up submodules
    * gfortran.dg/submodule_7.f90: Clean up submodules
    * gfortran.dg/submodule_8.f90: New test






On 14 July 2015 at 13:10, Paul Richard Thomas
<paul.richard.tho...@gmail.com> wrote:
> Dear All,
>
> Reinhold Bader has pointed out the naming the submodule files after
> the submodule name and using .mod as the extension can potentially
> lead to clashes. Therefore, I have written a patch to change gfortran
> to follow the naming convention of another leading brand:
>
> submodule filename = module@ancestor@....@submodule.smod
>
> The implementation is straightforward and the ChangeLog and the patch
> provide an adequate description.
>
> Bootstraps and regtests on x86_64 - OK for trunk?
>
> Paul
>
> 2015-07-14  Paul Thomas  <pa...@gcc.gnu.org>
>
>     PR fortran/52846
>     * gfortran.h : Add 'submodule_name' to gfc_use_list structure.
>     * module.c (gfc_match_submodule): Define submodule_name and add
>     static 'submodule_name'.
>     (gfc_match_submodule): Build up submodule filenames, using '@'
>     as a delimiter. Store the output filename in 'submodule_name'.
>     (gfc_dump_module): If current state is COMP_SUBMODULE, write
>     to file 'submodule_name', using SUBMODULE_EXTENSION.
>     (gfc_use_module): Similarly, use the 'submodule_name' field in
>     the gfc_use_list structure and SUBMODULE_EXTENSION to read the
>     implicitly used submodule files.



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c  (revision 225410)
--- gcc/fortran/decl.c  (working copy)
*************** gfc_match_end (gfc_statement *st)
*** 6451,6456 ****
--- 6451,6461 ----
    if (block_name == NULL)
      goto syntax;

+   /* We have to pick out the declared submodule name from the composite
+      required by F2008:11.2.3 para 2, which ends in the declared name.  */
+   if (state == COMP_SUBMODULE)
+     block_name = strchr (block_name, '.') + 1;
+
    if (strcmp (name, block_name) != 0 && strcmp (block_name, "ppr@") != 0)
      {
        gfc_error ("Expected label %qs for %s statement at %C", block_name,
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h      (revision 225410)
--- gcc/fortran/gfortran.h      (working copy)
*************** gfc_use_rename;
*** 1556,1561 ****
--- 1556,1562 ----
  typedef struct gfc_use_list
  {
    const char *module_name;
+   const char *submodule_name;
    bool intrinsic;
    bool non_intrinsic;
    bool only_flag;
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c        (revision 225410)
--- gcc/fortran/module.c        (working copy)
*************** along with GCC; see the file COPYING3.
*** 82,87 ****
--- 82,88 ----
  #include <zlib.h>

  #define MODULE_EXTENSION ".mod"
+ #define SUBMODULE_EXTENSION ".smod"

  /* Don't put any single quote (') in MOD_VERSION, if you want it to be
     recognized.  */
*************** static gzFile module_fp;
*** 191,196 ****
--- 192,199 ----

  /* The name of the module we're reading (USE'ing) or writing.  */
  static const char *module_name;
+ /* The name of the .smod file that the submodule will write to.  */
+ static const char *submodule_name;
  static gfc_use_list *module_list;

  /* If we're reading an intrinsic module, this is its ID.  */
*************** cleanup:
*** 716,722 ****
  }


! /* Match a SUBMODULE statement.  */

  match
  gfc_match_submodule (void)
--- 719,735 ----
  }


! /* Match a SUBMODULE statement.
!
!    According to F2008:11.2.3.2, "The submodule identifier is the
!    ordered pair whose first element is the ancestor module name and
!    whose second element is the submodule name. 'Submodule_name' is
!    used for the submodule filename and uses '@' as a separator, whilst
!    the name of the symbol for the module uses '.' as a a separator.
!    The reasons for these choices are:
!    (i) To follow another leading brand in the submodule filenames;
!    (ii) Since '.' is not particularly visible in the filenames; and
!    (iii) The linker does not permit '@' in mnemonics.  */

  match
  gfc_match_submodule (void)
*************** gfc_match_submodule (void)
*** 741,747 ****
        goto syntax;

        use_list = gfc_get_use_list ();
-       use_list->module_name = gfc_get_string (name);
        use_list->where = gfc_current_locus;

        if (module_list)
--- 754,759 ----
*************** gfc_match_submodule (void)
*** 750,758 ****
--- 762,778 ----
          while (last->next)
            last = last->next;
          last->next = use_list;
+         use_list->module_name
+               = gfc_get_string ("%s.%s", module_list->module_name, name);
+         use_list->submodule_name
+               = gfc_get_string ("%s@%s", module_list->module_name, name);
        }
        else
+       {
          module_list = use_list;
+         use_list->module_name = gfc_get_string (name);
+         use_list->submodule_name = use_list->module_name;
+       }

        if (gfc_match_char (')') == MATCH_YES)
        break;
*************** gfc_match_submodule (void)
*** 765,774 ****
--- 785,810 ----
    if (m != MATCH_YES)
      goto syntax;

+   submodule_name = gfc_get_string ("%s@%s", module_list->module_name,
+                                  gfc_new_block->name);
+
+   gfc_new_block->name = gfc_get_string ("%s.%s",
+                                       module_list->module_name,
+                                       gfc_new_block->name);
+
    if (!gfc_add_flavor (&gfc_new_block->attr, FL_MODULE,
                       gfc_new_block->name, NULL))
      return MATCH_ERROR;

+   /* Just retain the ultimate .(s)mod file for reading, since it
+      contains all the information in its ancestors.  */
+   use_list = module_list;
+   for (; module_list->next; use_list = use_list->next)
+     {
+       module_list = use_list->next;
+       free (use_list);
+     }
+
    return MATCH_YES;

  syntax:
*************** gfc_dump_module (const char *name, int d
*** 5933,5939 ****
--- 5969,5984 ----
    char *filename, *filename_tmp;
    uLong crc, crc_old;

+   module_name = gfc_get_string (name);
+
+   if (gfc_state_stack->state == COMP_SUBMODULE)
+     {
+       name = submodule_name;
+       n = strlen (name) + strlen (SUBMODULE_EXTENSION) + 1;
+     }
+   else
      n = strlen (name) + strlen (MODULE_EXTENSION) + 1;
+
    if (gfc_option.module_dir != NULL)
      {
        n += strlen (gfc_option.module_dir);
*************** gfc_dump_module (const char *name, int d
*** 5946,5951 ****
--- 5991,6000 ----
        filename = (char *) alloca (n);
        strcpy (filename, name);
      }
+
+   if (gfc_state_stack->state == COMP_SUBMODULE)
+     strcat (filename, SUBMODULE_EXTENSION);
+   else
      strcat (filename, MODULE_EXTENSION);

    /* Name of the temporary file used to write the module.  */
*************** gfc_dump_module (const char *name, int d
*** 5975,5981 ****

    /* Write the module itself.  */
    iomode = IO_OUTPUT;
-   module_name = gfc_get_string (name);

    init_pi_tree ();

--- 6024,6029 ----
*************** gfc_use_module (gfc_use_list *module)
*** 6706,6715 ****
      gfc_warning_now (OPT_Wuse_without_only,
                     "USE statement at %C has no ONLY qualifier");

!   filename = XALLOCAVEC (char, strlen (module_name) + strlen 
(MODULE_EXTENSION)
!                              + 1);
    strcpy (filename, module_name);
    strcat (filename, MODULE_EXTENSION);

    /* First, try to find an non-intrinsic module, unless the USE statement
       specified that the module is intrinsic.  */
--- 6754,6775 ----
      gfc_warning_now (OPT_Wuse_without_only,
                     "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);
        strcpy (filename, module_name);
        strcat (filename, MODULE_EXTENSION);
+     }
+   else
+     {
+       filename = XALLOCAVEC (char, strlen (module->submodule_name)
+                                  + strlen (SUBMODULE_EXTENSION) + 1);
+       strcpy (filename, module->submodule_name);
+       strcat (filename, SUBMODULE_EXTENSION);
+     }

    /* First, try to find an non-intrinsic module, unless the USE statement
       specified that the module is intrinsic.  */
Index: gcc/testsuite/lib/fortran-modules.exp
===================================================================
*** gcc/testsuite/lib/fortran-modules.exp       (revision 225410)
--- gcc/testsuite/lib/fortran-modules.exp       (working copy)
*************** proc cleanup-modules { modlist } {
*** 29,34 ****
--- 29,47 ----
      }
  }

+ # Remove files for specified Fortran modules.
+ proc cleanup-submodules { modlist } {
+     global clean
+     foreach mod [concat $modlist $clean] {
+       set m [string tolower $mod].smod
+       verbose "cleanup-submodule `$m'" 2
+       if [is_remote host] {
+           remote_file host delete $m
+       }
+       remote_file build delete $m
+     }
+ }
+
  proc keep-modules { modlist } {
      global clean
      # if the modlist is empty, keep everything
Index: gcc/testsuite/gfortran.dg/submodule_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_1.f90   (revision 225410)
--- gcc/testsuite/gfortran.dg/submodule_1.f90   (working copy)
***************
*** 170,172 ****
--- 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" } }
Index: gcc/testsuite/gfortran.dg/submodule_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_2.f90   (revision 225410)
--- gcc/testsuite/gfortran.dg/submodule_2.f90   (working copy)
***************
*** 98,100 ****
--- 98,102 ----
     if (any (arg%greeting .ne. ["adieu, people!", "adieu, people!"])) call 
abort
   contains
   end program
+ ! { dg-final { cleanup-submodules "foo_interface_son" } }
+ ! { dg-final { cleanup-submodules "foo_interface_daughter" } }
Index: gcc/testsuite/gfortran.dg/submodule_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_6.f90   (revision 225410)
--- gcc/testsuite/gfortran.dg/submodule_6.f90   (working copy)
*************** program p
*** 88,91 ****
--- 88,93 ----
    call p_a(a, create_b([3,4,5]))
    call print(a)
  end program p
+ ! { dg-final { cleanup-submodules "imp_p_a" } }
+ ! { dg-final { cleanup-submodules "imp_create" } }

Index: gcc/testsuite/gfortran.dg/submodule_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_7.f90   (revision 225410)
--- gcc/testsuite/gfortran.dg/submodule_7.f90   (working copy)
*************** program main
*** 145,147 ****
--- 145,149 ----
    call verify_cleanup (c_1, c_2)
  !...
  end program main
+ ! { dg-final { cleanup-submodules "color_points_a" } }
+ ! { dg-final { cleanup-submodules "color_points_b" } }
Index: gcc/testsuite/gfortran.dg/submodule_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_8.f90   (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_8.f90   (working copy)
***************
*** 0 ****
--- 1,44 ----
+ ! { dg-do run }
+ !
+ ! Checks that F2008:11.2.3 para 2 is correctly implemented so that
+ ! no error results from using 'mod_s' for both a module name and
+ ! a submodule name. The submodule is now identified as 'mod_a.mod_s'
+ ! internally and the submodule file as 'mod_a@mod_s.smod'.
+ !
+ ! Contributed by Reinhold Bader  <reinhold.ba...@lrz.de>
+ !
+ module mod_a
+   implicit none
+   interface
+     module subroutine p()
+     end subroutine
+   end interface
+ end module
+
+ submodule (mod_a) mod_s
+   implicit none
+   integer :: i=-2
+ contains
+   module procedure p
+     if (i .ne. -2) then
+       call abort
+     end if
+   end procedure
+ end submodule
+
+ module mod_s
+   use mod_a
+   implicit none
+   integer :: i=2
+ end module
+
+ program a_s
+   use mod_s
+   implicit none
+   if (i==2) then
+     call p()
+   else
+     call abort
+   end if
+ end program
+ ! { dg-final { cleanup-submodules "mod_s" } }

Reply via email to