gfortran.h (gfc_add_dimension, [...]): Add argument.

* gfortran.h (gfc_add_dimension, gfc_add_result, gfc_add_save,
gfc_add_dummy, gfc_add_generic, gfc_add_in_common, gfc_add_data,
gfc_add_in_namelist, gfc_add_sequence, gfc_add_function,
gfc_add_subroutine, gfc_add_access, gfc_add_flavor, gfc_add_entry,
gfc_add_procedure): Add argument.
* array.c (gfc_set_array_spec), decl.c (var_element, get_proc_name,
gfc_match_null, match_type_spec, match_attr_spec,
gfc_match_formal_arglist, match_result, gfc_match_function_decl):
Update callers to match.
(gfc_match_entry) : Likewise, fix comment typo.
(gfc_match_subroutine, attr_decl1, gfc_add_dimension,
access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc,
gfc_match_derived_decl): Update callers.
* interface.c (gfc_match_interface): Likewise.
* match.c (gfc_match_label, gfc_add_flavor,
gfc_match_call, gfc_match_common, gfc_match_block_data,
gfc_match_namelist, gfc_match_module, gfc_match_st_function):
Likewise.
* parse.c (parse_derived, parse_interface, parse_contained),
primary.c (gfc_match_rvalue, gfc_match_variable): Likewise.
* resolve.c (resolve_formal_arglist, resolve_entries): Update callers.
* symbol.c (check_conflict, check_used): Add new 'name' argument,
use when printing error message.
(gfc_add_dimension, gfc_add_result, gfc_add_save, gfc_add_dummy,
gfc_add_generic, gfc_add_in_common, gfc_add_data,
gfc_add_in_namelist, gfc_add_sequence, gfc_add_function,
gfc_add_subroutine, gfc_add_access, gfc_add_flavor, gfc_add_entry,
gfc_add_procedure): Add new 'name' argument.  Pass along to
check_conflict and check_used.
(gfc_add_allocatable, gfc_add_external, gfc_add_intrinsic,
gfc_add_optional, gfc_add_pointer, gfc_add_target, gfc_add_elemental,
gfc_add_pure, gfc_add_recursive, gfc_add_intent,
gfc_add_explicit_interface, gfc_copy_attr): Pass NULL for new
argument in calls to any of the modified functions.

From-SVN: r94718

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 88b3c144bcfeece815f57e8b08b055ade8e2cd68..25bc317881e31555d8cd557d431d309efbb6422d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,40 @@
+2005-02-07  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * gfortran.h (gfc_add_dimension, gfc_add_result, gfc_add_save,
+       gfc_add_dummy, gfc_add_generic, gfc_add_in_common, gfc_add_data,
+       gfc_add_in_namelist, gfc_add_sequence, gfc_add_function,
+       gfc_add_subroutine, gfc_add_access, gfc_add_flavor, gfc_add_entry,
+       gfc_add_procedure): Add argument.
+       * array.c (gfc_set_array_spec), decl.c (var_element, get_proc_name,
+       gfc_match_null, match_type_spec, match_attr_spec,
+       gfc_match_formal_arglist, match_result, gfc_match_function_decl):
+       Update callers to match.
+       (gfc_match_entry) : Likewise, fix comment typo.
+       (gfc_match_subroutine, attr_decl1, gfc_add_dimension,
+       access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc,
+       gfc_match_derived_decl): Update callers.
+       * interface.c (gfc_match_interface): Likewise.
+       * match.c (gfc_match_label, gfc_add_flavor,
+       gfc_match_call, gfc_match_common, gfc_match_block_data,
+       gfc_match_namelist, gfc_match_module, gfc_match_st_function):
+       Likewise.
+       * parse.c (parse_derived, parse_interface, parse_contained),
+       primary.c (gfc_match_rvalue, gfc_match_variable): Likewise.
+       * resolve.c (resolve_formal_arglist, resolve_entries): Update callers.
+       * symbol.c (check_conflict, check_used): Add new 'name' argument,
+       use when printing error message.
+       (gfc_add_dimension, gfc_add_result, gfc_add_save, gfc_add_dummy,
+       gfc_add_generic, gfc_add_in_common, gfc_add_data,
+       gfc_add_in_namelist, gfc_add_sequence, gfc_add_function,
+       gfc_add_subroutine, gfc_add_access, gfc_add_flavor, gfc_add_entry,
+       gfc_add_procedure): Add new 'name' argument.  Pass along to
+       check_conflict and check_used.
+       (gfc_add_allocatable, gfc_add_external, gfc_add_intrinsic,
+       gfc_add_optional, gfc_add_pointer, gfc_add_target, gfc_add_elemental,
+       gfc_add_pure, gfc_add_recursive, gfc_add_intent,
+       gfc_add_explicit_interface, gfc_copy_attr): Pass NULL for new
+       argument in calls to any of the modified functions.
+
 2005-02-06  Joseph S. Myers  <joseph@codesourcery.com>
 
        * gfortran.texi: Don't give last update date.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index c09bf8bcce52b6a3c8229f6d2d5d3f25800f584d..4f4f19b100b5ed0a90c02b0f96ca5196285faee0 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -457,7 +457,7 @@ gfc_set_array_spec (gfc_symbol * sym, gfc_array_spec * as, locus * error_loc)
   if (as == NULL)
     return SUCCESS;
 
-  if (gfc_add_dimension (&sym->attr, error_loc) == FAILURE)
+  if (gfc_add_dimension (&sym->attr, sym->name, error_loc) == FAILURE)
     return FAILURE;
 
   sym->as = as;

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 92326e7066a2375671773e80b3dfdebc16c0d23d..9ad5ef179737af4ba8ef200db6ffd447c8a82c8a 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -198,7 +198,7 @@ var_element (gfc_data_variable * new)
        }
 #endif
 
-  if (gfc_add_data (&sym->attr, &new->expr->where) == FAILURE)
+  if (gfc_add_data (&sym->attr, sym->name, &new->expr->where) == FAILURE)
     return MATCH_ERROR;
 
   return MATCH_YES;
@@ -598,7 +598,8 @@ get_proc_name (const char *name, gfc_symbol ** result)
   if (sym->ns->proc_name != NULL
       && sym->ns->proc_name->attr.flavor == FL_MODULE
       && sym->attr.proc != PROC_MODULE
-      && gfc_add_procedure (&sym->attr, PROC_MODULE, NULL) == FAILURE)
+      && gfc_add_procedure (&sym->attr, PROC_MODULE,
+                           sym->name, NULL) == FAILURE)
     rc = 2;
 
   return rc;
@@ -818,8 +819,9 @@ gfc_match_null (gfc_expr ** result)
   gfc_intrinsic_symbol (sym);
 
   if (sym->attr.proc != PROC_INTRINSIC
-      && (gfc_add_procedure (&sym->attr, PROC_INTRINSIC, NULL) == FAILURE
-         || gfc_add_function (&sym->attr, NULL) == FAILURE))
+      && (gfc_add_procedure (&sym->attr, PROC_INTRINSIC,
+                            sym->name, NULL) == FAILURE
+         || gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE))
     return MATCH_ERROR;
 
   e = gfc_get_expr ();
@@ -1369,7 +1371,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
     }
 
   if (sym->attr.flavor != FL_DERIVED
-      && gfc_add_flavor (&sym->attr, FL_DERIVED, NULL) == FAILURE)
+      && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   ts->type = BT_DERIVED;
@@ -1801,7 +1803,7 @@ match_attr_spec (void)
          break;
 
        case DECL_DIMENSION:
-         t = gfc_add_dimension (&current_attr, &seen_at[d]);
+         t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
          break;
 
        case DECL_EXTERNAL:
@@ -1829,7 +1831,7 @@ match_attr_spec (void)
          break;
 
        case DECL_PARAMETER:
-         t = gfc_add_flavor (&current_attr, FL_PARAMETER, &seen_at[d]);
+         t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, &seen_at[d]);
          break;
 
        case DECL_POINTER:
@@ -1837,15 +1839,17 @@ match_attr_spec (void)
          break;
 
        case DECL_PRIVATE:
-         t = gfc_add_access (&current_attr, ACCESS_PRIVATE, &seen_at[d]);
+         t = gfc_add_access (&current_attr, ACCESS_PRIVATE, NULL,
+                             &seen_at[d]);
          break;
 
        case DECL_PUBLIC:
-         t = gfc_add_access (&current_attr, ACCESS_PUBLIC, &seen_at[d]);
+         t = gfc_add_access (&current_attr, ACCESS_PUBLIC, NULL,
+                             &seen_at[d]);
          break;
 
        case DECL_SAVE:
-         t = gfc_add_save (&current_attr, &seen_at[d]);
+         t = gfc_add_save (&current_attr, NULL, &seen_at[d]);
          break;
 
        case DECL_TARGET:
@@ -2080,7 +2084,7 @@ gfc_match_formal_arglist (gfc_symbol * progname, int st_flag, int null_flag)
          dummy procedure.  We don't apply these attributes to formal
          arguments of statement functions.  */
       if (sym != NULL && !st_flag
-         && (gfc_add_dummy (&sym->attr, NULL) == FAILURE
+         && (gfc_add_dummy (&sym->attr, sym->name, NULL) == FAILURE
              || gfc_missing_attr (&sym->attr, NULL) == FAILURE))
        {
          m = MATCH_ERROR;
@@ -2180,8 +2184,8 @@ match_result (gfc_symbol * function, gfc_symbol ** result)
   if (gfc_get_symbol (name, NULL, &r))
     return MATCH_ERROR;
 
-  if (gfc_add_flavor (&r->attr, FL_VARIABLE, NULL) == FAILURE
-      || gfc_add_result (&r->attr, NULL) == FAILURE)
+  if (gfc_add_flavor (&r->attr, FL_VARIABLE, r->name, NULL) == FAILURE
+      || gfc_add_result (&r->attr, r->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   *result = r;
@@ -2251,7 +2255,7 @@ gfc_match_function_decl (void)
   /* Make changes to the symbol.  */
   m = MATCH_ERROR;
 
-  if (gfc_add_function (&sym->attr, NULL) == FAILURE)
+  if (gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
     goto cleanup;
 
   if (gfc_missing_attr (&sym->attr, NULL) == FAILURE
@@ -2326,13 +2330,13 @@ gfc_match_entry (void)
 
   if (state == COMP_SUBROUTINE)
     {
-      /* And entry in a subroutine.  */
+      /* An entry in a subroutine.  */
       m = gfc_match_formal_arglist (entry, 0, 1);
       if (m != MATCH_YES)
        return MATCH_ERROR;
 
-      if (gfc_add_entry (&entry->attr, NULL) == FAILURE
-         || gfc_add_subroutine (&entry->attr, NULL) == FAILURE)
+      if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
+         || gfc_add_subroutine (&entry->attr, entry->name, NULL) == FAILURE)
        return MATCH_ERROR;
     }
   else
@@ -2346,8 +2350,8 @@ gfc_match_entry (void)
 
       if (gfc_match_eos () == MATCH_YES)
        {
-         if (gfc_add_entry (&entry->attr, NULL) == FAILURE
-             || gfc_add_function (&entry->attr, NULL) == FAILURE)
+         if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
+             || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
            return MATCH_ERROR;
 
          entry->result = proc->result;
@@ -2361,9 +2365,10 @@ gfc_match_entry (void)
          if (m != MATCH_YES)
            return MATCH_ERROR;
 
-         if (gfc_add_result (&result->attr, NULL) == FAILURE
-             || gfc_add_entry (&entry->attr, NULL) == FAILURE
-             || gfc_add_function (&entry->attr, NULL) == FAILURE)
+         if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
+             || gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
+             || gfc_add_function (&entry->attr, result->name,
+                                  NULL) == FAILURE)
            return MATCH_ERROR;
        }
 
@@ -2426,7 +2431,7 @@ gfc_match_subroutine (void)
     return MATCH_ERROR;
   gfc_new_block = sym;
 
-  if (gfc_add_subroutine (&sym->attr, NULL) == FAILURE)
+  if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   if (gfc_match_formal_arglist (sym, 0, 1) != MATCH_YES)
@@ -2713,7 +2718,7 @@ attr_decl1 (void)
 
   if ((current_attr.external || current_attr.intrinsic)
       && sym->attr.flavor != FL_PROCEDURE
-      && gfc_add_flavor (&sym->attr, FL_PROCEDURE, NULL) == FAILURE)
+      && gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL) == FAILURE)
     {
       m = MATCH_ERROR;
       goto cleanup;
@@ -2840,7 +2845,7 @@ gfc_match_dimension (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_dimension (&current_attr, NULL);
+  gfc_add_dimension (&current_attr, NULL, NULL);
 
   return attr_decl ();
 }
@@ -2893,7 +2898,7 @@ access_attr_decl (gfc_statement st)
          if (gfc_add_access (&sym->attr,
                              (st ==
                               ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE,
-                             NULL) == FAILURE)
+                             sym->name, NULL) == FAILURE)
            return MATCH_ERROR;
 
          break;
@@ -3036,7 +3041,7 @@ do_parm (void)
     }
 
   if (gfc_check_assign_symbol (sym, init) == FAILURE
-      || gfc_add_flavor (&sym->attr, FL_PARAMETER, NULL) == FAILURE)
+      || gfc_add_flavor (&sym->attr, FL_PARAMETER, sym->name, NULL) == FAILURE)
     {
       m = MATCH_ERROR;
       goto cleanup;
@@ -3120,7 +3125,8 @@ gfc_match_save (void)
       switch (m)
        {
        case MATCH_YES:
-         if (gfc_add_save (&sym->attr, &gfc_current_locus) == FAILURE)
+         if (gfc_add_save (&sym->attr, sym->name,
+                           &gfc_current_locus) == FAILURE)
            return MATCH_ERROR;
          goto next_item;
 
@@ -3189,7 +3195,8 @@ gfc_match_modproc (void)
        return MATCH_ERROR;
 
       if (sym->attr.proc != PROC_MODULE
-         && gfc_add_procedure (&sym->attr, PROC_MODULE, NULL) == FAILURE)
+         && gfc_add_procedure (&sym->attr, PROC_MODULE,
+                               sym->name, NULL) == FAILURE)
        return MATCH_ERROR;
 
       if (gfc_add_interface (sym) == FAILURE)
@@ -3236,7 +3243,7 @@ loop:
          return MATCH_ERROR;
        }
 
-      if (gfc_add_access (&attr, ACCESS_PRIVATE, NULL) == FAILURE)
+      if (gfc_add_access (&attr, ACCESS_PRIVATE, NULL, NULL) == FAILURE)
        return MATCH_ERROR;
       goto loop;
     }
@@ -3249,7 +3256,7 @@ loop:
          return MATCH_ERROR;
        }
 
-      if (gfc_add_access (&attr, ACCESS_PUBLIC, NULL) == FAILURE)
+      if (gfc_add_access (&attr, ACCESS_PUBLIC, NULL, NULL) == FAILURE)
        return MATCH_ERROR;
       goto loop;
     }
@@ -3294,7 +3301,7 @@ loop:
      derived type that is a pointer.  The first part of the AND clause
      is true if a the symbol is not the return value of a function.  */
   if (sym->attr.flavor != FL_DERIVED
-      && gfc_add_flavor (&sym->attr, FL_DERIVED, NULL) == FAILURE)
+      && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   if (sym->components != NULL)
@@ -3306,7 +3313,7 @@ loop:
     }
 
   if (attr.access != ACCESS_UNKNOWN
-      && gfc_add_access (&sym->attr, attr.access, NULL) == FAILURE)
+      && gfc_add_access (&sym->attr, attr.access, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   gfc_new_block = sym;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c68f5af5ad52d101c31f2b3401cc3252d77f4440..9df2f376ed30373c18b7b798bbe5a8e1a7472385 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1573,32 +1573,33 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *);
 void gfc_set_sym_referenced (gfc_symbol * sym);
 
 try gfc_add_allocatable (symbol_attribute *, locus *);
-try gfc_add_dimension (symbol_attribute *, locus *);
+try gfc_add_dimension (symbol_attribute *, const char *, locus *);
 try gfc_add_external (symbol_attribute *, locus *);
 try gfc_add_intrinsic (symbol_attribute *, locus *);
 try gfc_add_optional (symbol_attribute *, locus *);
 try gfc_add_pointer (symbol_attribute *, locus *);
-try gfc_add_result (symbol_attribute *, locus *);
-try gfc_add_save (symbol_attribute *, locus *);
+try gfc_add_result (symbol_attribute *, const char *, locus *);
+try gfc_add_save (symbol_attribute *, const char *, locus *);
 try gfc_add_saved_common (symbol_attribute *, locus *);
 try gfc_add_target (symbol_attribute *, locus *);
-try gfc_add_dummy (symbol_attribute *, locus *);
-try gfc_add_generic (symbol_attribute *, locus *);
+try gfc_add_dummy (symbol_attribute *, const char *, locus *);
+try gfc_add_generic (symbol_attribute *, const char *, locus *);
 try gfc_add_common (symbol_attribute *, locus *);
-try gfc_add_in_common (symbol_attribute *, locus *);
-try gfc_add_data (symbol_attribute *, locus *);
-try gfc_add_in_namelist (symbol_attribute *, locus *);
-try gfc_add_sequence (symbol_attribute *, locus *);
+try gfc_add_in_common (symbol_attribute *, const char *, locus *);
+try gfc_add_data (symbol_attribute *, const char *, locus *);
+try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
+try gfc_add_sequence (symbol_attribute *, const char *, locus *);
 try gfc_add_elemental (symbol_attribute *, locus *);
 try gfc_add_pure (symbol_attribute *, locus *);
 try gfc_add_recursive (symbol_attribute *, locus *);
-try gfc_add_function (symbol_attribute *, locus *);
-try gfc_add_subroutine (symbol_attribute *, locus *);
-
-try gfc_add_access (symbol_attribute *, gfc_access, locus *);
-try gfc_add_flavor (symbol_attribute *, sym_flavor, locus *);
-try gfc_add_entry (symbol_attribute *, locus *);
-try gfc_add_procedure (symbol_attribute *, procedure_type, locus *);
+try gfc_add_function (symbol_attribute *, const char *, locus *);
+try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
+
+try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
+try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
+try gfc_add_entry (symbol_attribute *, const char *, locus *);
+try gfc_add_procedure (symbol_attribute *, procedure_type,
+                      const char *, locus *);
 try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
 try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
                                gfc_formal_arglist *, locus *);

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index c127568275aaac98c2052d35cf0bb1559879dede..71555e48cbe30e06d2e1ede43e63768a852b45ae 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -213,7 +213,8 @@ gfc_match_interface (void)
       if (gfc_get_symbol (name, NULL, &sym))
        return MATCH_ERROR;
 
-      if (!sym->attr.generic && gfc_add_generic (&sym->attr, NULL) == FAILURE)
+      if (!sym->attr.generic 
+         && gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
        return MATCH_ERROR;
 
       current_interface.sym = gfc_new_block = sym;

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index abd8ef89acb14c66e2db2c91bcd9f25b63495027..2a36447853030bec4f1afeae2be9de0418e61486 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -266,7 +266,8 @@ gfc_match_label (void)
     }
 
   if (gfc_new_block->attr.flavor != FL_LABEL
-      && gfc_add_flavor (&gfc_new_block->attr, FL_LABEL, NULL) == FAILURE)
+      && gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
+                        gfc_new_block->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   for (p = gfc_state_stack; p; p = p->previous)
@@ -806,7 +807,7 @@ gfc_match_program (void)
   if (m == MATCH_ERROR)
     return m;
 
-  if (gfc_add_flavor (&sym->attr, FL_PROGRAM, NULL) == FAILURE)
+  if (gfc_add_flavor (&sym->attr, FL_PROGRAM, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   gfc_new_block = sym;
@@ -2013,7 +2014,7 @@ gfc_match_call (void)
 
   if (!sym->attr.generic
       && !sym->attr.subroutine
-      && gfc_add_subroutine (&sym->attr, NULL) == FAILURE)
+      && gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   if (gfc_match_eos () != MATCH_YES)
@@ -2237,7 +2238,7 @@ gfc_match_common (void)
              goto cleanup;
            }
 
-         if (gfc_add_in_common (&sym->attr, NULL) == FAILURE) 
+         if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE) 
            goto cleanup;
 
          if (sym->value != NULL
@@ -2252,7 +2253,7 @@ gfc_match_common (void)
              goto cleanup;
            }
 
-         if (gfc_add_in_common (&sym->attr, NULL) == FAILURE)
+         if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE)
            goto cleanup;
 
          /* Derived type names must have the SEQUENCE attribute.  */
@@ -2287,7 +2288,7 @@ gfc_match_common (void)
                  goto cleanup;
                }
 
-             if (gfc_add_dimension (&sym->attr, NULL) == FAILURE)
+             if (gfc_add_dimension (&sym->attr, sym->name, NULL) == FAILURE)
                goto cleanup;
 
              if (sym->attr.pointer)
@@ -2353,7 +2354,7 @@ gfc_match_block_data (void)
   if (gfc_get_symbol (name, NULL, &sym))
     return MATCH_ERROR;
 
-  if (gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, NULL) == FAILURE)
+  if (gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   gfc_new_block = sym;
@@ -2403,7 +2404,8 @@ gfc_match_namelist (void)
        }
 
       if (group_name->attr.flavor != FL_NAMELIST
-         && gfc_add_flavor (&group_name->attr, FL_NAMELIST, NULL) == FAILURE)
+         && gfc_add_flavor (&group_name->attr, FL_NAMELIST,
+                            group_name->name, NULL) == FAILURE)
        return MATCH_ERROR;
 
       for (;;)
@@ -2415,7 +2417,7 @@ gfc_match_namelist (void)
            goto error;
 
          if (sym->attr.in_namelist == 0
-             && gfc_add_in_namelist (&sym->attr, NULL) == FAILURE)
+             && gfc_add_in_namelist (&sym->attr, sym->name, NULL) == FAILURE)
            goto error;
 
          nl = gfc_get_namelist ();
@@ -2471,7 +2473,8 @@ gfc_match_module (void)
   if (m != MATCH_YES)
     return m;
 
-  if (gfc_add_flavor (&gfc_new_block->attr, FL_MODULE, NULL) == FAILURE)
+  if (gfc_add_flavor (&gfc_new_block->attr, FL_MODULE,
+                     gfc_new_block->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
   return MATCH_YES;
@@ -2587,7 +2590,8 @@ gfc_match_st_function (void)
 
   gfc_push_error (&old_error);
 
-  if (gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, NULL) == FAILURE)
+  if (gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION,
+                        sym->name, NULL) == FAILURE)
     goto undo_error;
 
   if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES)

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 484c05ce2d6e5bc56a98ccd5e013047d1a1b7d58..dac40775d055de03551c21ce960d3f8e20d6908e 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1349,7 +1349,8 @@ parse_derived (void)
            }
 
          seen_sequence = 1;
-         gfc_add_sequence (&gfc_current_block ()->attr, NULL);
+         gfc_add_sequence (&gfc_current_block ()->attr, 
+                           gfc_current_block ()->name, NULL);
          break;
 
        default:
@@ -1451,9 +1452,9 @@ loop:
       if (current_state == COMP_NONE)
        {
          if (new_state == COMP_FUNCTION)
-           gfc_add_function (&sym->attr, NULL);
-         if (new_state == COMP_SUBROUTINE)
-           gfc_add_subroutine (&sym->attr, NULL);
+           gfc_add_function (&sym->attr, sym->name, NULL);
+         else if (new_state == COMP_SUBROUTINE)
+           gfc_add_subroutine (&sym->attr, sym->name, NULL);
 
          current_state = new_state;
        }
@@ -2200,15 +2201,15 @@ parse_contained (int module)
                   gfc_new_block->name);
              else
                {
-                 if (gfc_add_procedure (&sym->attr, PROC_INTERNAL,
+                 if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, sym->name,
                                         &gfc_new_block->declared_at) ==
                      SUCCESS)
                    {
                      if (st == ST_FUNCTION)
-                       gfc_add_function (&sym->attr,
+                       gfc_add_function (&sym->attr, sym->name,
                                          &gfc_new_block->declared_at);
                      else
-                       gfc_add_subroutine (&sym->attr,
+                       gfc_add_subroutine (&sym->attr, sym->name,
                                            &gfc_new_block->declared_at);
                    }
                }

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index a2d1d1f5004fa3842dd51ebd572b29289997f660..f122779b1364f8af3e0fbe7f7273db50f7270580 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1877,7 +1877,7 @@ gfc_match_rvalue (gfc_expr ** result)
        e->rank = sym->as->rank;
 
       if (!sym->attr.function
-         && gfc_add_function (&sym->attr, NULL) == FAILURE)
+         && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
        {
          m = MATCH_ERROR;
          break;
@@ -1905,7 +1905,8 @@ gfc_match_rvalue (gfc_expr ** result)
 
       if (sym->attr.dimension)
        {
-         if (gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
+         if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
+                             sym->name, NULL) == FAILURE)
            {
              m = MATCH_ERROR;
              break;
@@ -1930,7 +1931,8 @@ gfc_match_rvalue (gfc_expr ** result)
          e->symtree = symtree;
          e->expr_type = EXPR_VARIABLE;
 
-         if (gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
+         if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
+                             sym->name, NULL) == FAILURE)
            {
              m = MATCH_ERROR;
              break;
@@ -1964,7 +1966,8 @@ gfc_match_rvalue (gfc_expr ** result)
              e->expr_type = EXPR_VARIABLE;
 
              if (sym->attr.flavor != FL_VARIABLE
-                 && gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
+                 && gfc_add_flavor (&sym->attr, FL_VARIABLE,
+                                    sym->name, NULL) == FAILURE)
                {
                  m = MATCH_ERROR;
                  break;
@@ -1990,7 +1993,7 @@ gfc_match_rvalue (gfc_expr ** result)
       e->expr_type = EXPR_FUNCTION;
 
       if (!sym->attr.function
-         && gfc_add_function (&sym->attr, NULL) == FAILURE)
+         && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
        {
          m = MATCH_ERROR;
          break;
@@ -2072,7 +2075,8 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag)
       break;
 
     case FL_UNKNOWN:
-      if (gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
+      if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
+                         sym->name, NULL) == FAILURE)
        return MATCH_ERROR;
       break;
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 442b205b7bc4ef8469fb2d5e61531e1d90aeba44..dd69a98340643674b56102742cfeea2f75d7b77b 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -151,7 +151,7 @@ resolve_formal_arglist (gfc_symbol * proc)
          A procedure specification would have already set the type.  */
 
       if (sym->attr.flavor == FL_UNKNOWN)
-       gfc_add_flavor (&sym->attr, FL_VARIABLE, &sym->declared_at);
+       gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at);
 
       if (gfc_pure (proc))
        {
@@ -364,12 +364,12 @@ resolve_entries (gfc_namespace * ns)
   gfc_get_ha_symbol (name, &proc);
   gcc_assert (proc != NULL);
 
-  gfc_add_procedure (&proc->attr, PROC_INTERNAL, NULL);
+  gfc_add_procedure (&proc->attr, PROC_INTERNAL, proc->name, NULL);
   if (ns->proc_name->attr.subroutine)
-    gfc_add_subroutine (&proc->attr, NULL);
+    gfc_add_subroutine (&proc->attr, proc->name, NULL);
   else
     {
-      gfc_add_function (&proc->attr, NULL);
+      gfc_add_function (&proc->attr, proc->name, NULL);
       gfc_internal_error ("TODO: Functions with alternate entry points");
     }
   proc->attr.access = ACCESS_PRIVATE;

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 7333dbbb442584712550aed061fcc4864194c002..b8b6d5e135bd78c25cd1562004b3a2a5bdd60ca5 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -237,7 +237,7 @@ gfc_set_default_type (gfc_symbol * sym, int error_flag, gfc_namespace * ns)
 #define conf2(a) if (attr->a) { a2 = a; goto conflict; }
 
 static try
-check_conflict (symbol_attribute * attr, locus * where)
+check_conflict (symbol_attribute * attr, const char * name, locus * where)
 {
   static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
     *target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
@@ -426,7 +426,13 @@ check_conflict (symbol_attribute * attr, locus * where)
   return SUCCESS;
 
 conflict:
-  gfc_error ("%s attribute conflicts with %s attribute at %L", a1, a2, where);
+  if (name == NULL)
+    gfc_error ("%s attribute conflicts with %s attribute at %L",
+              a1, a2, where);
+  else
+    gfc_error ("%s attribute conflicts with %s attribute in '%s' at %L",
+              a1, a2, name, where);
+
   return FAILURE;
 }
 
@@ -456,7 +462,7 @@ gfc_set_sym_referenced (gfc_symbol * sym)
    nonzero if not.  */
 
 static int
-check_used (symbol_attribute * attr, locus * where)
+check_used (symbol_attribute * attr, const char * name, locus * where)
 {
 
   if (attr->use_assoc == 0)
@@ -465,8 +471,12 @@ check_used (symbol_attribute * attr, locus * where)
   if (where == NULL)
     where = &gfc_current_locus;
 
-  gfc_error ("Cannot change attributes of USE-associated symbol at %L",
-             where);
+  if (name == NULL)
+    gfc_error ("Cannot change attributes of USE-associated symbol at %L",
+              where);
+  else
+    gfc_error ("Cannot change attributes of USE-associated symbol %s at %L",
+              name, where);
 
   return 1;
 }
@@ -511,7 +521,7 @@ try
 gfc_add_allocatable (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->allocatable)
@@ -521,15 +531,15 @@ gfc_add_allocatable (symbol_attribute * attr, locus * where)
     }
 
   attr->allocatable = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
 try
-gfc_add_dimension (symbol_attribute * attr, locus * where)
+gfc_add_dimension (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, name, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->dimension)
@@ -539,7 +549,7 @@ gfc_add_dimension (symbol_attribute * attr, locus * where)
     }
 
   attr->dimension = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
@@ -547,7 +557,7 @@ try
 gfc_add_external (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->external)
@@ -558,7 +568,7 @@ gfc_add_external (symbol_attribute * attr, locus * where)
 
   attr->external = 1;
 
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
@@ -566,7 +576,7 @@ try
 gfc_add_intrinsic (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->intrinsic)
@@ -577,7 +587,7 @@ gfc_add_intrinsic (symbol_attribute * attr, locus * where)
 
   attr->intrinsic = 1;
 
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
@@ -585,7 +595,7 @@ try
 gfc_add_optional (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->optional)
@@ -595,7 +605,7 @@ gfc_add_optional (symbol_attribute * attr, locus * where)
     }
 
   attr->optional = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
@@ -603,31 +613,31 @@ try
 gfc_add_pointer (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   attr->pointer = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
 try
-gfc_add_result (symbol_attribute * attr, locus * where)
+gfc_add_result (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, name, where) || check_done (attr, where))
     return FAILURE;
 
   attr->result = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_save (symbol_attribute * attr, locus * where)
+gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where))
+  if (check_used (attr, name, where))
     return FAILURE;
 
   if (gfc_pure (NULL))
@@ -645,7 +655,7 @@ gfc_add_save (symbol_attribute * attr, locus * where)
     }
 
   attr->save = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
@@ -653,7 +663,7 @@ try
 gfc_add_target (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->target)
@@ -663,72 +673,73 @@ gfc_add_target (symbol_attribute * attr, locus * where)
     }
 
   attr->target = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
 try
-gfc_add_dummy (symbol_attribute * attr, locus * where)
+gfc_add_dummy (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where))
+  if (check_used (attr, name, where))
     return FAILURE;
 
   /* Duplicate dummy arguments are allow due to ENTRY statements.  */
   attr->dummy = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_in_common (symbol_attribute * attr, locus * where)
+gfc_add_in_common (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, name, where) || check_done (attr, where))
     return FAILURE;
 
   /* Duplicate attribute already checked for.  */
   attr->in_common = 1;
-  if (check_conflict (attr, where) == FAILURE)
+  if (check_conflict (attr, name, where) == FAILURE)
     return FAILURE;
 
   if (attr->flavor == FL_VARIABLE)
     return SUCCESS;
 
-  return gfc_add_flavor (attr, FL_VARIABLE, where);
+  return gfc_add_flavor (attr, FL_VARIABLE, name, where);
 }
 
 
 try
-gfc_add_data (symbol_attribute *attr, locus *where)
+gfc_add_data (symbol_attribute *attr, const char *name, locus *where)
 {
 
-  if (check_used (attr, where))
+  if (check_used (attr, name, where))
     return FAILURE;
 
   attr->data = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_in_namelist (symbol_attribute * attr, locus * where)
+gfc_add_in_namelist (symbol_attribute * attr, const char *name,
+                    locus * where)
 {
 
   attr->in_namelist = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_sequence (symbol_attribute * attr, locus * where)
+gfc_add_sequence (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where))
+  if (check_used (attr, name, where))
     return FAILURE;
 
   attr->sequence = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
@@ -736,11 +747,11 @@ try
 gfc_add_elemental (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   attr->elemental = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
@@ -748,11 +759,11 @@ try
 gfc_add_pure (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   attr->pure = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
@@ -760,19 +771,19 @@ try
 gfc_add_recursive (symbol_attribute * attr, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, NULL, where) || check_done (attr, where))
     return FAILURE;
 
   attr->recursive = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, NULL, where);
 }
 
 
 try
-gfc_add_entry (symbol_attribute * attr, locus * where)
+gfc_add_entry (symbol_attribute * attr, const char *name, locus * where)
 {
 
-  if (check_used (attr, where))
+  if (check_used (attr, name, where))
     return FAILURE;
 
   if (attr->entry)
@@ -782,46 +793,46 @@ gfc_add_entry (symbol_attribute * attr, locus * where)
     }
 
   attr->entry = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_function (symbol_attribute * attr, locus * where)
+gfc_add_function (symbol_attribute * attr, const char *name, locus * where)
 {
 
   if (attr->flavor != FL_PROCEDURE
-      && gfc_add_flavor (attr, FL_PROCEDURE, where) == FAILURE)
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
     return FAILURE;
 
   attr->function = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_subroutine (symbol_attribute * attr, locus * where)
+gfc_add_subroutine (symbol_attribute * attr, const char *name, locus * where)
 {
 
   if (attr->flavor != FL_PROCEDURE
-      && gfc_add_flavor (attr, FL_PROCEDURE, where) == FAILURE)
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
     return FAILURE;
 
   attr->subroutine = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_generic (symbol_attribute * attr, locus * where)
+gfc_add_generic (symbol_attribute * attr, const char *name, locus * where)
 {
 
   if (attr->flavor != FL_PROCEDURE
-      && gfc_add_flavor (attr, FL_PROCEDURE, where) == FAILURE)
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
     return FAILURE;
 
   attr->generic = 1;
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
@@ -829,12 +840,13 @@ gfc_add_generic (symbol_attribute * attr, locus * where)
    considers attributes and can be reaffirmed multiple times.  */
 
 try
-gfc_add_flavor (symbol_attribute * attr, sym_flavor f, locus * where)
+gfc_add_flavor (symbol_attribute * attr, sym_flavor f, const char *name,
+               locus * where)
 {
 
   if ((f == FL_PROGRAM || f == FL_BLOCK_DATA || f == FL_MODULE
        || f == FL_PARAMETER || f == FL_LABEL || f == FL_DERIVED
-       || f == FL_NAMELIST) && check_used (attr, where))
+       || f == FL_NAMELIST) && check_used (attr, name, where))
     return FAILURE;
 
   if (attr->flavor == f && f == FL_VARIABLE)
@@ -854,19 +866,20 @@ gfc_add_flavor (symbol_attribute * attr, sym_flavor f, locus * where)
 
   attr->flavor = f;
 
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
 try
-gfc_add_procedure (symbol_attribute * attr, procedure_type t, locus * where)
+gfc_add_procedure (symbol_attribute * attr, procedure_type t,
+                  const char *name, locus * where)
 {
 
-  if (check_used (attr, where) || check_done (attr, where))
+  if (check_used (attr, name, where) || check_done (attr, where))
     return FAILURE;
 
   if (attr->flavor != FL_PROCEDURE
-      && gfc_add_flavor (attr, FL_PROCEDURE, where) == FAILURE)
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
     return FAILURE;
 
   if (where == NULL)
@@ -886,11 +899,11 @@ gfc_add_procedure (symbol_attribute * attr, procedure_type t, locus * where)
 
   /* Statement functions are always scalar and functions.  */
   if (t == PROC_ST_FUNCTION
-      && ((!attr->function && gfc_add_function (attr, where) == FAILURE)
+      && ((!attr->function && gfc_add_function (attr, name, where) == FAILURE)
          || attr->dimension))
     return FAILURE;
 
-  return check_conflict (attr, where);
+  return check_conflict (attr, name, where);
 }
 
 
@@ -898,13 +911,13 @@ try
 gfc_add_intent (symbol_attribute * attr, sym_intent intent, locus * where)
 {
 
-  if (check_used (attr, where))
+  if (check_used (attr, NULL, where))
     return FAILURE;
 
   if (attr->intent == INTENT_UNKNOWN)
     {
       attr->intent = intent;
-      return check_conflict (attr, where);
+      return check_conflict (attr, NULL, where);
     }
 
   if (where == NULL)
@@ -921,13 +934,14 @@ gfc_add_intent (symbol_attribute * attr, sym_intent intent, locus * where)
 /* No checks for use-association in public and private statements.  */
 
 try
-gfc_add_access (symbol_attribute * attr, gfc_access access, locus * where)
+gfc_add_access (symbol_attribute * attr, gfc_access access,
+               const char *name, locus * where)
 {
 
   if (attr->access == ACCESS_UNKNOWN)
     {
       attr->access = access;
-      return check_conflict (attr, where);
+      return check_conflict (attr, name, where);
     }
 
   if (where == NULL)
@@ -943,7 +957,7 @@ gfc_add_explicit_interface (gfc_symbol * sym, ifsrc source,
                            gfc_formal_arglist * formal, locus * where)
 {
 
-  if (check_used (&sym->attr, where))
+  if (check_used (&sym->attr, sym->name, where))
     return FAILURE;
 
   if (where == NULL)
@@ -1033,37 +1047,37 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
   if (src->allocatable && gfc_add_allocatable (dest, where) == FAILURE)
     goto fail;
 
-  if (src->dimension && gfc_add_dimension (dest, where) == FAILURE)
+  if (src->dimension && gfc_add_dimension (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->optional && gfc_add_optional (dest, where) == FAILURE)
     goto fail;
   if (src->pointer && gfc_add_pointer (dest, where) == FAILURE)
     goto fail;
-  if (src->save && gfc_add_save (dest, where) == FAILURE)
+  if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->target && gfc_add_target (dest, where) == FAILURE)
     goto fail;
-  if (src->dummy && gfc_add_dummy (dest, where) == FAILURE)
+  if (src->dummy && gfc_add_dummy (dest, NULL, where) == FAILURE)
     goto fail;
-  if (src->result && gfc_add_result (dest, where) == FAILURE)
+  if (src->result && gfc_add_result (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->entry)
     dest->entry = 1;
 
-  if (src->in_namelist && gfc_add_in_namelist (dest, where) == FAILURE)
+  if (src->in_namelist && gfc_add_in_namelist (dest, NULL, where) == FAILURE)
     goto fail;
 
-  if (src->in_common && gfc_add_in_common (dest, where) == FAILURE)
+  if (src->in_common && gfc_add_in_common (dest, NULL, where) == FAILURE)
     goto fail;
 
-  if (src->generic && gfc_add_generic (dest, where) == FAILURE)
+  if (src->generic && gfc_add_generic (dest, NULL, where) == FAILURE)
     goto fail;
-  if (src->function && gfc_add_function (dest, where) == FAILURE)
+  if (src->function && gfc_add_function (dest, NULL, where) == FAILURE)
     goto fail;
-  if (src->subroutine && gfc_add_subroutine (dest, where) == FAILURE)
+  if (src->subroutine && gfc_add_subroutine (dest, NULL, where) == FAILURE)
     goto fail;
 
-  if (src->sequence && gfc_add_sequence (dest, where) == FAILURE)
+  if (src->sequence && gfc_add_sequence (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->elemental && gfc_add_elemental (dest, where) == FAILURE)
     goto fail;
@@ -1073,7 +1087,7 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
     goto fail;
 
   if (src->flavor != FL_UNKNOWN
-      && gfc_add_flavor (dest, src->flavor, where) == FAILURE)
+      && gfc_add_flavor (dest, src->flavor, NULL, where) == FAILURE)
     goto fail;
 
   if (src->intent != INTENT_UNKNOWN
@@ -1081,7 +1095,7 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
     goto fail;
 
   if (src->access != ACCESS_UNKNOWN
-      && gfc_add_access (dest, src->access, where) == FAILURE)
+      && gfc_add_access (dest, src->access, NULL, where) == FAILURE)
     goto fail;
 
   if (gfc_missing_attr (dest, where) == FAILURE)
@@ -2326,7 +2340,7 @@ save_symbol (gfc_symbol * sym)
       || sym->attr.flavor != FL_VARIABLE)
     return;
 
-  gfc_add_save (&sym->attr, &sym->declared_at);
+  gfc_add_save (&sym->attr, sym->name, &sym->declared_at);
 }