1 files changed, 50 insertions, 23 deletions

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 8df1b9a..5bba099 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -655,7 +655,8 @@ compare_true_names (void * _t1, void * _t2)
   t1 = (true_name *) _t1;
   t2 = (true_name *) _t2;
 
-  c = strcmp (t1->sym->module, t2->sym->module);
+  c = ((t1->sym->module > t2->sym->module)
+       - (t1->sym->module < t2->sym->module));
   if (c != 0)
     return c;
 
@@ -673,8 +674,8 @@ find_true_name (const char *name, const char *module)
   gfc_symbol sym;
   int c;
 
-  strcpy (sym.name, name);
-  strcpy (sym.module, module);
+  sym.name = gfc_get_string (name);
+  sym.module = gfc_get_string (module);
   t.sym = &sym;
 
   p = true_name_root;
@@ -1341,8 +1342,33 @@ mio_allocated_string (const char *s)
 }
 
 
-/* Read or write a string that is in static memory or inside of some
-   already-allocated structure.  */
+/* Read or write a string that is in static memory.  */
+
+static void
+mio_pool_string (const char **stringp)
+{
+  /* TODO: one could write the string only once, and refer to it via a
+     fixup pointer.  */
+
+  /* As a special case we have to deal with a NULL string.  This
+     happens for the 'module' member of 'gfc_symbol's that are not in a
+     module.  We read / write these as the empty string.  */
+  if (iomode == IO_OUTPUT)
+    {
+      const char *p = *stringp == NULL ? "" : *stringp;
+      write_atom (ATOM_STRING, p);
+    }
+  else
+    {
+      require_atom (ATOM_STRING);
+      *stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string);
+      gfc_free (atom_string);
+    }
+}
+
+
+/* Read or write a string that is inside of some already-allocated
+   structure.  */
 
 static void
 mio_internal_string (char *string)
@@ -1802,7 +1828,7 @@ mio_component_ref (gfc_component ** cp, gfc_symbol * sym)
     p->type = P_COMPONENT;
 
   if (iomode == IO_OUTPUT)
-    mio_internal_string ((*cp)->name);
+    mio_pool_string (&(*cp)->name);
   else
     {
       mio_internal_string (name);
@@ -1851,7 +1877,7 @@ mio_component (gfc_component * c)
   if (p->type == P_UNKNOWN)
     p->type = P_COMPONENT;
 
-  mio_internal_string (c->name);
+  mio_pool_string (&c->name);
   mio_typespec (&c->ts);
   mio_array_spec (&c->as);
 
@@ -1907,7 +1933,7 @@ mio_actual_arg (gfc_actual_arglist * a)
 {
 
   mio_lparen ();
-  mio_internal_string (a->name);
+  mio_pool_string (&a->name);
   mio_expr (&a->expr);
   mio_rparen ();
 }
@@ -2599,14 +2625,14 @@ mio_interface (gfc_interface ** ip)
 /* Save/restore a named operator interface.  */
 
 static void
-mio_symbol_interface (char *name, char *module,
+mio_symbol_interface (const char **name, const char **module,
 		      gfc_interface ** ip)
 {
 
   mio_lparen ();
 
-  mio_internal_string (name);
-  mio_internal_string (module);
+  mio_pool_string (name);
+  mio_pool_string (module);
 
   mio_interface_rest (ip);
 }
@@ -2884,7 +2910,7 @@ load_needed (pointer_info * p)
 	}
 
       sym = gfc_new_symbol (p->u.rsym.true_name, ns);
-      strcpy (sym->module, p->u.rsym.module);
+      sym->module = gfc_get_string (p->u.rsym.module);
 
       associate_integer_pointer (p, sym);
     }
@@ -3037,7 +3063,7 @@ read_module (void)
 	      sym = info->u.rsym.sym =
 		gfc_new_symbol (info->u.rsym.true_name, gfc_current_ns);
 
-	      strcpy (sym->module, info->u.rsym.module);
+	      sym->module = gfc_get_string (info->u.rsym.module);
 	    }
 
 	  st->n.sym = sym;
@@ -3170,7 +3196,7 @@ write_common (gfc_symtree *st)
   write_common(st->right);
 
   mio_lparen();
-  mio_internal_string(st->name);
+  mio_pool_string(&st->name);
 
   p = st->n.common;
   mio_symbol_ref(&p->head);
@@ -3190,9 +3216,9 @@ write_symbol (int n, gfc_symbol * sym)
     gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
 
   mio_integer (&n);
-  mio_internal_string (sym->name);
+  mio_pool_string (&sym->name);
 
-  mio_internal_string (sym->module);
+  mio_pool_string (&sym->module);
   mio_pointer_ref (&sym->ns);
 
   mio_symbol (sym);
@@ -3217,8 +3243,8 @@ write_symbol0 (gfc_symtree * st)
   write_symbol0 (st->right);
 
   sym = st->n.sym;
-  if (sym->module[0] == '\0')
-    strcpy (sym->module, module_name);
+  if (sym->module == NULL)
+    sym->module = gfc_get_string (module_name);
 
   if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
       && !sym->attr.subroutine && !sym->attr.function)
@@ -3265,8 +3291,8 @@ write_symbol1 (pointer_info * p)
 
   /* FIXME: This shouldn't be necessary, but it works around
      deficiencies in the module loader or/and symbol handling.  */
-  if (p->u.wsym.sym->module[0] == '\0' && p->u.wsym.sym->attr.dummy)
-    strcpy (p->u.wsym.sym->module, module_name);
+  if (p->u.wsym.sym->module == NULL && p->u.wsym.sym->attr.dummy)
+    p->u.wsym.sym->module = gfc_get_string (module_name);
 
   p->u.wsym.state = WRITTEN;
   write_symbol (p->integer, p->u.wsym.sym);
@@ -3281,12 +3307,13 @@ static void
 write_operator (gfc_user_op * uop)
 {
   static char nullstring[] = "";
+  const char *p = nullstring;
 
   if (uop->operator == NULL
       || !gfc_check_access (uop->access, uop->ns->default_access))
     return;
 
-  mio_symbol_interface (uop->name, nullstring, &uop->operator);
+  mio_symbol_interface (&uop->name, &p, &uop->operator);
 }
 
 
@@ -3300,7 +3327,7 @@ write_generic (gfc_symbol * sym)
       || !gfc_check_access (sym->attr.access, sym->ns->default_access))
     return;
 
-  mio_symbol_interface (sym->name, sym->module, &sym->generic);
+  mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
 }
 
 
@@ -3323,7 +3350,7 @@ write_symtree (gfc_symtree * st)
   if (p == NULL)
     gfc_internal_error ("write_symtree(): Symbol not written");
 
-  mio_internal_string (st->name);
+  mio_pool_string (&st->name);
   mio_integer (&st->ambiguous);
   mio_integer (&p->integer);
 }