PR fortran/42769

[pf3gnuchains/gcc-fork.git] / gcc / fortran / module.c

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4e6c520..f6662b4 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -81,7 +81,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Don't put any single quote (') in MOD_VERSION, 
    if yout want it to be recognized.  */
-#define MOD_VERSION "8"
+#define MOD_VERSION "9"
 
 
 /* Structure that describes a position within a module file.  */
@@ -155,13 +155,12 @@ typedef struct pointer_info
     struct
     {
       gfc_symbol *sym;
-      char true_name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
+      char *true_name, *module, *binding_label;
+      fixup_t *stfixup;
+      gfc_symtree *symtree;
       enum gfc_rsym_state state;
       int ns, referenced, renamed;
       module_locus where;
-      fixup_t *stfixup;
-      gfc_symtree *symtree;
-      char* binding_label;
     }
     rsym;
 
@@ -229,7 +228,11 @@ free_pi_tree (pointer_info *p)
   free_pi_tree (p->right);
 
   if (iomode == IO_INPUT)
-    XDELETEVEC (p->u.rsym.binding_label);
+    {
+      XDELETEVEC (p->u.rsym.true_name);
+      XDELETEVEC (p->u.rsym.module);
+      XDELETEVEC (p->u.rsym.binding_label);
+    }
 
   free (p);
 }
@@ -1442,6 +1445,19 @@ find_enum (const mstring *m)
 }
 
 
+/* Read a string. The caller is responsible for freeing.  */
+
+static char*
+read_string (void)
+{
+  char* p;
+  require_atom (ATOM_STRING);
+  p = atom_string;
+  atom_string = NULL;
+  return p;
+}
+
+
 /**************** Module output subroutines ***************************/
 
 /* Output a character to a module file.  */
@@ -1816,27 +1832,6 @@ mio_internal_string (char *string)
 }
 
 
-/* Read a string. The caller is responsible for freeing.  */
-
-static char*
-mio_read_string (void)
-{
-  char* p;
-  require_atom (ATOM_STRING);
-  p = atom_string;
-  atom_string = NULL;
-  return p;
-}
-
-
-/* Write a string.  */
-static void
-mio_write_string (const char* string)
-{
-  write_atom (ATOM_STRING, string);
-}
-
-
 typedef enum
 { AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
   AB_POINTER, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
@@ -3583,12 +3578,17 @@ mio_typebound_proc (gfc_typebound_proc** proc)
   if ((*proc)->is_generic)
     {
       gfc_tbp_generic* g;
+      int iop;
 
       mio_lparen ();
 
       if (iomode == IO_OUTPUT)
        for (g = (*proc)->u.generic; g; g = g->next)
-         mio_allocated_string (g->specific_st->name);
+         {
+           iop = (int) g->is_operator;
+           mio_integer (&iop);
+           mio_allocated_string (g->specific_st->name);
+         }
       else
        {
          (*proc)->u.generic = NULL;
@@ -3599,6 +3599,9 @@ mio_typebound_proc (gfc_typebound_proc** proc)
              g = gfc_get_tbp_generic ();
              g->specific = NULL;
 
+             mio_integer (&iop);
+             g->is_operator = (bool) iop;
+
              require_atom (ATOM_STRING);
              sym_root = &current_f2k_derived->tb_sym_root;
              g->specific_st = gfc_get_tbp_symtree (sym_root, atom_string);
@@ -4168,7 +4171,7 @@ load_commons (void)
       /* Get whether this was a bind(c) common or not.  */
       mio_integer (&p->is_bind_c);
       /* Get the binding label.  */
-      label = mio_read_string ();
+      label = read_string ();
       if (strlen (label))
        p->binding_label = IDENTIFIER_POINTER (get_identifier (label));
       XDELETEVEC (label);
@@ -4385,9 +4388,24 @@ load_needed (pointer_info *p)
 
   /* Mark as only or rename for later diagnosis for explicitly imported
      but not used warnings; don't mark internal symbols such as __vtab,
-     __def_init etc.  */
+     __def_init etc. Only mark them if they have been explicitly loaded.  */
+
   if (only_flag && sym->name[0] != '_' && sym->name[1] != '_')
-    sym->attr.use_only = 1;
+    {
+      gfc_use_rename *u;
+
+      /* Search the use/rename list for the variable; if the variable is
+        found, mark it.  */
+      for (u = gfc_rename_list; u; u = u->next)
+       {
+         if (strcmp (u->use_name, sym->name) == 0)
+           {
+             sym->attr.use_only = 1;
+             break;
+           }
+       }
+    }
+
   if (p->u.rsym.renamed)
     sym->attr.use_rename = 1;
 
@@ -4531,9 +4549,9 @@ read_module (void)
       info->type = P_SYMBOL;
       info->u.rsym.state = UNUSED;
 
-      mio_internal_string (info->u.rsym.true_name);
-      mio_internal_string (info->u.rsym.module);
-      bind_label = mio_read_string ();
+      info->u.rsym.true_name = read_string ();
+      info->u.rsym.module = read_string ();
+      bind_label = read_string ();
       if (strlen (bind_label))
        info->u.rsym.binding_label = bind_label;
       else
@@ -4623,8 +4641,14 @@ read_module (void)
          if (p == NULL)
            {
              st = gfc_find_symtree (gfc_current_ns->sym_root, name);
-             if (st != NULL)
-               info->u.rsym.symtree = st;
+             if (st != NULL
+                 && strcmp (st->n.sym->name, info->u.rsym.true_name) == 0
+                 && st->n.sym->module != NULL
+                 && strcmp (st->n.sym->module, info->u.rsym.module) == 0)
+               {
+                 info->u.rsym.symtree = st;
+                 info->u.rsym.sym = st->n.sym;
+               }
              continue;
            }
 
@@ -4645,7 +4669,8 @@ read_module (void)
              /* Check for ambiguous symbols.  */
              if (check_for_ambiguous (st->n.sym, info))
                st->ambiguous = 1;
-             info->u.rsym.symtree = st;
+             else
+               info->u.rsym.symtree = st;
            }
          else
            {
@@ -4960,7 +4985,7 @@ write_blank_common (void)
   mio_integer (&is_bind_c);
 
   /* Write out an empty binding label.  */
-  mio_write_string ("");
+  write_atom (ATOM_STRING, "");
 
   mio_rparen ();
 }
@@ -5064,7 +5089,7 @@ write_symbol (int n, gfc_symbol *sym)
       mio_pool_string (&label);
     }
   else
-    mio_write_string ("");
+    write_atom (ATOM_STRING, "");
 
   mio_pointer_ref (&sym->ns);