Unrevert previously reversed patch, adding this patch:

* module.c (find_true_name): Deal with NULL module.

From-SVN: r95506

gcc/fortran/check.c

@@ -1214,7 +1214,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap)
   m = ap->next->next->expr;
 
   if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
-      && ap->next->name[0] == '\0')
+      && ap->next->name == NULL)
     {
       m = d;
       d = NULL;
@@ -1259,7 +1259,7 @@ check_reduction (gfc_actual_arglist * ap)
   m = ap->next->next->expr;
 
   if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
-      && ap->next->name[0] == '\0')
+      && ap->next->name == NULL)
     {
       m = d;
       d = NULL;

gcc/fortran/dump-parse-tree.c

@@ -106,7 +106,7 @@ gfc_show_actual_arglist (gfc_actual_arglist * a)
   for (; a; a = a->next)
     {
       gfc_status_char ('(');
-      if (a->name[0] != '\0')
+      if (a->name != NULL)
 	gfc_status ("%s = ", a->name);
       if (a->expr != NULL)
 	gfc_show_expr (a->expr);

gcc/fortran/gfortran.h

@@ -540,7 +540,7 @@ gfc_array_spec;
 /* Components of derived types.  */
 typedef struct gfc_component
 {
-  char name[GFC_MAX_SYMBOL_LEN + 1];
+  const char *name;
   gfc_typespec ts;
 
   int pointer, dimension;
@@ -571,7 +571,7 @@ gfc_formal_arglist;
 /* The gfc_actual_arglist structure is for actual arguments.  */
 typedef struct gfc_actual_arglist
 {
-  char name[GFC_MAX_SYMBOL_LEN + 1];
+  const char *name;
   /* Alternate return label when the expr member is null.  */
   struct gfc_st_label *label;
 
@@ -636,7 +636,7 @@ gfc_interface;
 /* User operator nodes.  These are like stripped down symbols.  */
 typedef struct
 {
-  char name[GFC_MAX_SYMBOL_LEN + 1];
+  const char *name;
 
   gfc_interface *operator;
   struct gfc_namespace *ns;
@@ -652,8 +652,8 @@ gfc_user_op;
 
 typedef struct gfc_symbol
 {
-  char name[GFC_MAX_SYMBOL_LEN + 1];	/* Primary name, before renaming */
-  char module[GFC_MAX_SYMBOL_LEN + 1];	/* Module this symbol came from */
+  const char *name;	/* Primary name, before renaming */
+  const char *module;	/* Module this symbol came from */
   locus declared_at;
 
   gfc_typespec ts;
@@ -744,7 +744,7 @@ gfc_entry_list;
 typedef struct gfc_symtree
 {
   BBT_HEADER (gfc_symtree);
-  char name[GFC_MAX_SYMBOL_LEN + 1];
+  const char *name;
   int ambiguous;
   union
   {
@@ -1003,7 +1003,7 @@ gfc_resolve_f;
 
 typedef struct gfc_intrinsic_sym
 {
-  char name[GFC_MAX_SYMBOL_LEN + 1], lib_name[GFC_MAX_SYMBOL_LEN + 1];
+  const char *name, *lib_name;
   gfc_intrinsic_arg *formal;
   gfc_typespec ts;
   int elemental, pure, generic, specific, actual_ok, standard;
@@ -1654,8 +1654,8 @@ void gfc_save_all (gfc_namespace *);
 
 void gfc_symbol_state (void);
 
-gfc_gsymbol *gfc_get_gsymbol (char *);
-gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, char *);
+gfc_gsymbol *gfc_get_gsymbol (const char *);
+gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
 
 /* intrinsic.c */
 extern int gfc_init_expr;
@@ -1664,7 +1664,7 @@ extern int gfc_init_expr;
    by placing it into a special module that is otherwise impossible to
    read or write.  */
 
-#define gfc_intrinsic_symbol(SYM) strcpy (SYM->module, "(intrinsic)")
+#define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
 
 void gfc_intrinsic_init_1 (void);
 void gfc_intrinsic_done_1 (void);

gcc/fortran/interface.c

@@ -340,8 +340,9 @@ gfc_compare_types (gfc_typespec * ts1, gfc_typespec * ts2)
      true names and module names are the same and the module name is
      nonnull, then they are equal.  */
   if (strcmp (ts1->derived->name, ts2->derived->name) == 0
-      && ts1->derived->module[0] != '\0'
-      && strcmp (ts1->derived->module, ts2->derived->module) == 0)
+      && ((ts1->derived->module == NULL && ts2->derived->module == NULL)
+	  || (ts1->derived != NULL && ts2->derived != NULL
+	      && strcmp (ts1->derived->module, ts2->derived->module) == 0)))
     return 1;
 
   /* Compare type via the rules of the standard.  Both types must have
@@ -1165,7 +1166,7 @@ compare_actual_formal (gfc_actual_arglist ** ap,
 
   for (a = actual; a; a = a->next, f = f->next)
     {
-      if (a->name[0] != '\0')
+      if (a->name != NULL)
 	{
 	  i = 0;
 	  for (f = formal; f; f = f->next, i++)

gcc/fortran/intrinsic.c

@@ -37,7 +37,8 @@ int gfc_init_expr = 0;
 /* Pointers to an intrinsic function and its argument names that are being
    checked.  */
 
-char *gfc_current_intrinsic, *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+const char *gfc_current_intrinsic;
+const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
 locus *gfc_current_intrinsic_where;
 
 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
@@ -107,7 +108,7 @@ gfc_get_intrinsic_sub_symbol (const char * name)
 /* Return a pointer to the name of a conversion function given two
    typespecs.  */
 
-static char *
+static const char *
 conv_name (gfc_typespec * from, gfc_typespec * to)
 {
   static char name[30];
@@ -115,7 +116,7 @@ conv_name (gfc_typespec * from, gfc_typespec * to)
   sprintf (name, "__convert_%c%d_%c%d", gfc_type_letter (from->type),
 	   from->kind, gfc_type_letter (to->type), to->kind);
 
-  return name;
+  return gfc_get_string (name);
 }
 
 
@@ -127,7 +128,7 @@ static gfc_intrinsic_sym *
 find_conv (gfc_typespec * from, gfc_typespec * to)
 {
   gfc_intrinsic_sym *sym;
-  char *target;
+  const char *target;
   int i;
 
   target = conv_name (from, to);
@@ -213,7 +214,7 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
 	 bt type, int kind, int standard, gfc_check_f check,
 	 gfc_simplify_f simplify, gfc_resolve_f resolve, ...)
 {
-
+  char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0'  */
   int optional, first_flag;
   va_list argp;
 
@@ -233,10 +234,11 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
       break;
 
     case SZ_NOTHING:
-      strcpy (next_sym->name, name);
+      next_sym->name = gfc_get_string (name);
 
-      strcpy (next_sym->lib_name, "_gfortran_");
-      strcat (next_sym->lib_name, name);
+      strcpy (buf, "_gfortran_");
+      strcat (buf, name);
+      next_sym->lib_name = gfc_get_string (buf);
 
       next_sym->elemental = elemental;
       next_sym->ts.type = type;
@@ -785,11 +787,11 @@ make_generic (const char *name, gfc_generic_isym_id generic_id, int standard)
   g->generic = 1;
   g->specific = 1;
   g->generic_id = generic_id;
-  if ((g + 1)->name[0] != '\0')
+  if ((g + 1)->name != NULL)
     g->specific_head = g + 1;
   g++;
 
-  while (g->name[0] != '\0')
+  while (g->name != NULL)
     {
       g->next = g + 1;
       g->specific = 1;
@@ -828,7 +830,7 @@ make_alias (const char *name, int standard)
 
     case SZ_NOTHING:
       next_sym[0] = next_sym[-1];
-      strcpy (next_sym->name, name);
+      next_sym->name = gfc_get_string (name);
       next_sym++;
       break;
 
@@ -2152,8 +2154,8 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind,
 
   sym = conversion + nconv;
 
-  strcpy (sym->name, conv_name (&from, &to));
-  strcpy (sym->lib_name, sym->name);
+  sym->name =  conv_name (&from, &to);
+  sym->lib_name = sym->name;
   sym->simplify.cc = simplify;
   sym->elemental = 1;
   sym->ts = to;
@@ -2359,7 +2361,7 @@ sort_actual (const char *name, gfc_actual_arglist ** ap,
       if (a == NULL)
 	goto optional;
 
-      if (a->name[0] != '\0')
+      if (a->name != NULL)
 	goto keywords;
 
       f->actual = a;

gcc/fortran/intrinsic.h

@@ -368,6 +368,6 @@ void gfc_resolve_unlink_sub (gfc_code *);
 
 #define MAX_INTRINSIC_ARGS 5
 
-extern char *gfc_current_intrinsic,
-  *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+extern const char *gfc_current_intrinsic;
+extern const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
 extern locus *gfc_current_intrinsic_where;

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,11 @@ 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);
+  if (module != NULL)
+    sym.module = gfc_get_string (module);
+  else
+    sym.module = NULL;
   t.sym = &sym;
 
   p = true_name_root;
@@ -1341,8 +1345,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 +1831,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 +1880,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 +1936,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 +2628,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 +2913,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 +3066,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 +3199,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 +3219,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 +3246,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 +3294,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 +3310,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 +3330,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 +3353,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);
 }

gcc/fortran/primary.c

@@ -1273,7 +1273,7 @@ match_keyword_arg (gfc_actual_arglist * actual, gfc_actual_arglist * base)
   if (name[0] != '\0')
     {
       for (a = base; a; a = a->next)
-	if (strcmp (a->name, name) == 0)
+	if (a->name != NULL && strcmp (a->name, name) == 0)
 	  {
 	    gfc_error
 	      ("Keyword '%s' at %C has already appeared in the current "
@@ -1282,7 +1282,7 @@ match_keyword_arg (gfc_actual_arglist * actual, gfc_actual_arglist * base)
 	  }
     }
 
-  strcpy (actual->name, name);
+  actual->name = gfc_get_string (name);
   return MATCH_YES;
 
 cleanup:

gcc/fortran/symbol.c

@@ -1157,7 +1157,7 @@ gfc_add_component (gfc_symbol * sym, const char *name, gfc_component ** componen
   else
     tail->next = p;
 
-  strcpy (p->name, name);
+  p->name = gfc_get_string (name);
   p->loc = gfc_current_locus;
 
   *component = p;
@@ -1613,7 +1613,7 @@ gfc_new_symtree (gfc_symtree ** root, const char *name)
   gfc_symtree *st;
 
   st = gfc_getmem (sizeof (gfc_symtree));
-  strcpy (st->name, name);
+  st->name = gfc_get_string (name);
 
   gfc_insert_bbt (root, st, compare_symtree);
   return st;
@@ -1629,7 +1629,7 @@ delete_symtree (gfc_symtree ** root, const char *name)
 
   st0 = gfc_find_symtree (*root, name);
 
-  strcpy (st.name, name);
+  st.name = gfc_get_string (name);
   gfc_delete_bbt (root, &st, compare_symtree);
 
   gfc_free (st0);
@@ -1674,7 +1674,7 @@ gfc_get_uop (const char *name)
   st = gfc_new_symtree (&gfc_current_ns->uop_root, name);
 
   uop = st->n.uop = gfc_getmem (sizeof (gfc_user_op));
-  strcpy (uop->name, name);
+  uop->name = gfc_get_string (name);
   uop->access = ACCESS_UNKNOWN;
   uop->ns = gfc_current_ns;
 
@@ -1743,7 +1743,7 @@ gfc_new_symbol (const char *name, gfc_namespace * ns)
   if (strlen (name) > GFC_MAX_SYMBOL_LEN)
     gfc_internal_error ("new_symbol(): Symbol name too long");
 
-  strcpy (p->name, name);
+  p->name = gfc_get_string (name);
   return p;
 }
 
@@ -1754,7 +1754,7 @@ static void
 ambiguous_symbol (const char *name, gfc_symtree * st)
 {
 
-  if (st->n.sym->module[0])
+  if (st->n.sym->module)
     gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
 	       "from module '%s'", name, st->n.sym->name, st->n.sym->module);
   else
@@ -2362,7 +2362,7 @@ gfc_symbol_state(void) {
 /* Search a tree for the global symbol.  */
 
 gfc_gsymbol *
-gfc_find_gsymbol (gfc_gsymbol *symbol, char *name)
+gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name)
 {
   gfc_gsymbol *s;
 
@@ -2399,7 +2399,7 @@ gsym_compare (void * _s1, void * _s2)
 /* Get a global symbol, creating it if it doesn't exist.  */
 
 gfc_gsymbol *
-gfc_get_gsymbol (char *name)
+gfc_get_gsymbol (const char *name)
 {
   gfc_gsymbol *s;
 

gcc/fortran/trans-array.c

@@ -3071,7 +3071,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
 
   gcc_assert (!sym->attr.use_assoc);
   gcc_assert (!TREE_STATIC (decl));
-  gcc_assert (!sym->module[0]);
+  gcc_assert (!sym->module);
 
   if (sym->ts.type == BT_CHARACTER
       && !INTEGER_CST_P (sym->ts.cl->backend_decl))

gcc/fortran/trans-decl.c

@@ -272,7 +272,7 @@ gfc_sym_mangled_identifier (gfc_symbol * sym)
 {
   char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
 
-  if (sym->module[0] == 0)
+  if (sym->module == NULL)
     return gfc_sym_identifier (sym);
   else
     {
@@ -290,8 +290,8 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
   int has_underscore;
   char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
 
-  if (sym->module[0] == 0 || sym->attr.proc == PROC_EXTERNAL
-      || (sym->module[0] != 0 && sym->attr.if_source == IFSRC_IFBODY))
+  if (sym->module == NULL || sym->attr.proc == PROC_EXTERNAL
+      || (sym->module != NULL && sym->attr.if_source == IFSRC_IFBODY))
     {
       if (strcmp (sym->name, "MAIN__") == 0
 	  || sym->attr.proc == PROC_INTRINSIC)
@@ -404,7 +404,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
       DECL_EXTERNAL (decl) = 1;
       TREE_PUBLIC (decl) = 1;
     }
-  else if (sym->module[0] && !sym->attr.result && !sym->attr.dummy)
+  else if (sym->module && !sym->attr.result && !sym->attr.dummy)
     {
       /* TODO: Don't set sym->module for result or dummy variables.  */
       gcc_assert (current_function_decl == NULL_TREE);
@@ -766,7 +766,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Symbols from modules should have their assembler names mangled.
      This is done here rather than in gfc_finish_var_decl because it
      is different for string length variables.  */
-  if (sym->module[0])
+  if (sym->module)
     SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym));
 
   if (sym->attr.dimension)
@@ -808,7 +808,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	{
 	  char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
 
-	  if (sym->module[0])
+	  if (sym->module)
 	    {
 	      /* Also prefix the mangled name for symbols from modules.  */
 	      strcpy (&name[1], sym->name);

gcc/fortran/trans-io.c

@@ -816,7 +816,7 @@ gfc_trans_inquire (gfc_code * code)
 
 
 static gfc_expr *
-gfc_new_nml_name_expr (char * name)
+gfc_new_nml_name_expr (const char * name)
 {
    gfc_expr * nml_name;
    nml_name = gfc_get_expr();
@@ -825,7 +825,8 @@ gfc_new_nml_name_expr (char * name)
    nml_name->ts.kind = gfc_default_character_kind;
    nml_name->ts.type = BT_CHARACTER;
    nml_name->value.character.length = strlen(name);
-   nml_name->value.character.string = name;
+   nml_name->value.character.string = gfc_getmem (strlen (name) + 1);
+   strcpy (nml_name->value.character.string, name);
 
    return nml_name;
 }