2015-07-17 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 17 Jul 2015 17:23:45 +0000 (17:23 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 17 Jul 2015 17:23:45 +0000 (17:23 +0000)
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-17  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/52846
* lib/fortran-modules.exp (proc cleanup-submodules): New
procedure.
* gfortran.dg/submodule_1.f08: Change extension and clean up
the submodule files.
* gfortran.dg/submodule_2.f08: ditto
* gfortran.dg/submodule_6.f08: ditto
* gfortran.dg/submodule_7.f08: ditto
* gfortran.dg/submodule_8.f08: New test
* gfortran.dg/submodule_9.f08: New test

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@225945 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/gfortran.h
gcc/fortran/module.c
gcc/testsuite/gfortran.dg/submodule_1.f08 [moved from gcc/testsuite/gfortran.dg/submodule_1.f90 with 96% similarity]
gcc/testsuite/lib/fortran-modules.exp

index d082f0b..4c61b1a 100644 (file)
@@ -1,3 +1,21 @@
+2015-07-17  Paul Thomas  <pault@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-17  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
 
        * trans-intrinsic.c (conv_co_collective): Remove redundant address
index 4946061..ebc88ea 100644 (file)
@@ -6450,6 +6450,11 @@ gfc_match_end (gfc_statement *st)
   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 cd0ec88..69de5ad 100644 (file)
@@ -1556,6 +1556,7 @@ gfc_use_rename;
 typedef struct gfc_use_list
 {
   const char *module_name;
+  const char *submodule_name;
   bool intrinsic;
   bool non_intrinsic;
   bool only_flag;
index ebfb89b..db1d339 100644 (file)
@@ -81,6 +81,7 @@ along with GCC; see the file COPYING3.  If not see
 #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.  */
@@ -190,6 +191,8 @@ static gzFile module_fp;
 
 /* 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.  */
@@ -715,7 +718,17 @@ cleanup:
 }
 
 
-/* Match a SUBMODULE statement.  */
+/* 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)
@@ -740,7 +753,6 @@ gfc_match_submodule (void)
        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)
@@ -749,9 +761,17 @@ gfc_match_submodule (void)
          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;
@@ -764,10 +784,26 @@ gfc_match_submodule (void)
   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:
@@ -5932,7 +5968,16 @@ gfc_dump_module (const char *name, int dump_flag)
   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);
@@ -5945,6 +5990,10 @@ gfc_dump_module (const char *name, int dump_flag)
       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.  */
@@ -5974,7 +6023,6 @@ gfc_dump_module (const char *name, int dump_flag)
 
   /* Write the module itself.  */
   iomode = IO_OUTPUT;
-  module_name = gfc_get_string (name);
 
   init_pi_tree ();
 
@@ -6705,10 +6753,22 @@ gfc_use_module (gfc_use_list *module)
     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);
+  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.  */
similarity index 96%
rename from gcc/testsuite/gfortran.dg/submodule_1.f90
rename to gcc/testsuite/gfortran.dg/submodule_1.f08
index 2c5d373..d117dc6 100644 (file)
      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 3ebb31a..0e2f30a 100644 (file)
@@ -29,6 +29,19 @@ proc cleanup-modules { modlist } {
     }
 }
 
+# Remove files for specified Fortran submodules.
+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