Skip to content

R
riscv-gcc-1
Commit 231b2fcc by Tobias Schlüter Committed by Tobias Schlüter
Options

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
parent f55db9c2
Showing with 134 additions and 79 deletions
gcc/fortran/ChangeLog
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> 2005-02-06 Joseph S. Myers <joseph@codesourcery.com>
* gfortran.texi: Don't give last update date. * gfortran.texi: Don't give last update date.
......
gcc/fortran/array.c
...@@ -457,7 +457,7 @@ gfc_set_array_spec (gfc_symbol * sym, gfc_array_spec * as, locus * error_loc) ...@@ -457,7 +457,7 @@ gfc_set_array_spec (gfc_symbol * sym, gfc_array_spec * as, locus * error_loc)
if (as == NULL) if (as == NULL)
return SUCCESS; return SUCCESS;
if (gfc_add_dimension (&sym->attr, error_loc) == FAILURE) if (gfc_add_dimension (&sym->attr, sym->name, error_loc) == FAILURE)
return FAILURE; return FAILURE;
sym->as = as; sym->as = as;
......
gcc/fortran/decl.c
...@@ -198,7 +198,7 @@ var_element (gfc_data_variable * new) ...@@ -198,7 +198,7 @@ var_element (gfc_data_variable * new)
} }
#endif #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_ERROR;
return MATCH_YES; return MATCH_YES;
...@@ -598,7 +598,8 @@ get_proc_name (const char *name, gfc_symbol ** result) ...@@ -598,7 +598,8 @@ get_proc_name (const char *name, gfc_symbol ** result)
if (sym->ns->proc_name != NULL if (sym->ns->proc_name != NULL
&& sym->ns->proc_name->attr.flavor == FL_MODULE && sym->ns->proc_name->attr.flavor == FL_MODULE
&& sym->attr.proc != PROC_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; rc = 2;
return rc; return rc;
...@@ -818,8 +819,9 @@ gfc_match_null (gfc_expr ** result) ...@@ -818,8 +819,9 @@ gfc_match_null (gfc_expr ** result)
gfc_intrinsic_symbol (sym); gfc_intrinsic_symbol (sym);
if (sym->attr.proc != PROC_INTRINSIC if (sym->attr.proc != PROC_INTRINSIC
&& (gfc_add_procedure (&sym->attr, PROC_INTRINSIC, NULL) == FAILURE && (gfc_add_procedure (&sym->attr, PROC_INTRINSIC,
|| gfc_add_function (&sym->attr, NULL) == FAILURE)) sym->name, NULL) == FAILURE
|| gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE))
return MATCH_ERROR; return MATCH_ERROR;
e = gfc_get_expr (); e = gfc_get_expr ();
...@@ -1369,7 +1371,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag) ...@@ -1369,7 +1371,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
} }
if (sym->attr.flavor != FL_DERIVED 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; return MATCH_ERROR;
ts->type = BT_DERIVED; ts->type = BT_DERIVED;
...@@ -1801,7 +1803,7 @@ match_attr_spec (void) ...@@ -1801,7 +1803,7 @@ match_attr_spec (void)
break; break;
case DECL_DIMENSION: case DECL_DIMENSION:
t = gfc_add_dimension (&current_attr, &seen_at[d]); t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
break; break;
case DECL_EXTERNAL: case DECL_EXTERNAL:
...@@ -1829,7 +1831,7 @@ match_attr_spec (void) ...@@ -1829,7 +1831,7 @@ match_attr_spec (void)
break; break;
case DECL_PARAMETER: 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; break;
case DECL_POINTER: case DECL_POINTER:
...@@ -1837,15 +1839,17 @@ match_attr_spec (void) ...@@ -1837,15 +1839,17 @@ match_attr_spec (void)
break; break;
case DECL_PRIVATE: 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; break;
case DECL_PUBLIC: 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; break;
case DECL_SAVE: case DECL_SAVE:
t = gfc_add_save (&current_attr, &seen_at[d]); t = gfc_add_save (&current_attr, NULL, &seen_at[d]);
break; break;
case DECL_TARGET: case DECL_TARGET:
...@@ -2080,7 +2084,7 @@ gfc_match_formal_arglist (gfc_symbol * progname, int st_flag, int null_flag) ...@@ -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 dummy procedure. We don't apply these attributes to formal
arguments of statement functions. */ arguments of statement functions. */
if (sym != NULL && !st_flag 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)) || gfc_missing_attr (&sym->attr, NULL) == FAILURE))
{ {
m = MATCH_ERROR; m = MATCH_ERROR;
...@@ -2180,8 +2184,8 @@ match_result (gfc_symbol * function, gfc_symbol ** result) ...@@ -2180,8 +2184,8 @@ match_result (gfc_symbol * function, gfc_symbol ** result)
if (gfc_get_symbol (name, NULL, &r)) if (gfc_get_symbol (name, NULL, &r))
return MATCH_ERROR; return MATCH_ERROR;
if (gfc_add_flavor (&r->attr, FL_VARIABLE, NULL) == FAILURE if (gfc_add_flavor (&r->attr, FL_VARIABLE, r->name, NULL) == FAILURE
|| gfc_add_result (&r->attr, NULL) == FAILURE) || gfc_add_result (&r->attr, r->name, NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
*result = r; *result = r;
...@@ -2251,7 +2255,7 @@ gfc_match_function_decl (void) ...@@ -2251,7 +2255,7 @@ gfc_match_function_decl (void)
/* Make changes to the symbol. */ /* Make changes to the symbol. */
m = MATCH_ERROR; m = MATCH_ERROR;
if (gfc_add_function (&sym->attr, NULL) == FAILURE) if (gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
goto cleanup; goto cleanup;
if (gfc_missing_attr (&sym->attr, NULL) == FAILURE if (gfc_missing_attr (&sym->attr, NULL) == FAILURE
...@@ -2326,13 +2330,13 @@ gfc_match_entry (void) ...@@ -2326,13 +2330,13 @@ gfc_match_entry (void)
if (state == COMP_SUBROUTINE) if (state == COMP_SUBROUTINE)
{ {
/* And entry in a subroutine. */ /* An entry in a subroutine. */
m = gfc_match_formal_arglist (entry, 0, 1); m = gfc_match_formal_arglist (entry, 0, 1);
if (m != MATCH_YES) if (m != MATCH_YES)
return MATCH_ERROR; return MATCH_ERROR;
if (gfc_add_entry (&entry->attr, NULL) == FAILURE if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
|| gfc_add_subroutine (&entry->attr, NULL) == FAILURE) || gfc_add_subroutine (&entry->attr, entry->name, NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
} }
else else
...@@ -2346,8 +2350,8 @@ gfc_match_entry (void) ...@@ -2346,8 +2350,8 @@ gfc_match_entry (void)
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
{ {
if (gfc_add_entry (&entry->attr, NULL) == FAILURE if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
|| gfc_add_function (&entry->attr, NULL) == FAILURE) || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
entry->result = proc->result; entry->result = proc->result;
...@@ -2361,9 +2365,10 @@ gfc_match_entry (void) ...@@ -2361,9 +2365,10 @@ gfc_match_entry (void)
if (m != MATCH_YES) if (m != MATCH_YES)
return MATCH_ERROR; return MATCH_ERROR;
if (gfc_add_result (&result->attr, NULL) == FAILURE if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
|| gfc_add_entry (&entry->attr, NULL) == FAILURE || gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
|| gfc_add_function (&entry->attr, NULL) == FAILURE) || gfc_add_function (&entry->attr, result->name,
NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
} }
...@@ -2426,7 +2431,7 @@ gfc_match_subroutine (void) ...@@ -2426,7 +2431,7 @@ gfc_match_subroutine (void)
return MATCH_ERROR; return MATCH_ERROR;
gfc_new_block = sym; 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; return MATCH_ERROR;
if (gfc_match_formal_arglist (sym, 0, 1) != MATCH_YES) if (gfc_match_formal_arglist (sym, 0, 1) != MATCH_YES)
...@@ -2713,7 +2718,7 @@ attr_decl1 (void) ...@@ -2713,7 +2718,7 @@ attr_decl1 (void)
if ((current_attr.external || current_attr.intrinsic) if ((current_attr.external || current_attr.intrinsic)
&& sym->attr.flavor != FL_PROCEDURE && 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; m = MATCH_ERROR;
goto cleanup; goto cleanup;
...@@ -2840,7 +2845,7 @@ gfc_match_dimension (void) ...@@ -2840,7 +2845,7 @@ gfc_match_dimension (void)
{ {
gfc_clear_attr (&current_attr); gfc_clear_attr (&current_attr);
gfc_add_dimension (&current_attr, NULL); gfc_add_dimension (&current_attr, NULL, NULL);
return attr_decl (); return attr_decl ();
} }
...@@ -2893,7 +2898,7 @@ access_attr_decl (gfc_statement st) ...@@ -2893,7 +2898,7 @@ access_attr_decl (gfc_statement st)
if (gfc_add_access (&sym->attr, if (gfc_add_access (&sym->attr,
(st == (st ==
ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE, ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE,
NULL) == FAILURE) sym->name, NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
break; break;
...@@ -3036,7 +3041,7 @@ do_parm (void) ...@@ -3036,7 +3041,7 @@ do_parm (void)
} }
if (gfc_check_assign_symbol (sym, init) == FAILURE 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; m = MATCH_ERROR;
goto cleanup; goto cleanup;
...@@ -3120,7 +3125,8 @@ gfc_match_save (void) ...@@ -3120,7 +3125,8 @@ gfc_match_save (void)
switch (m) switch (m)
{ {
case MATCH_YES: 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; return MATCH_ERROR;
goto next_item; goto next_item;
...@@ -3189,7 +3195,8 @@ gfc_match_modproc (void) ...@@ -3189,7 +3195,8 @@ gfc_match_modproc (void)
return MATCH_ERROR; return MATCH_ERROR;
if (sym->attr.proc != PROC_MODULE 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; return MATCH_ERROR;
if (gfc_add_interface (sym) == FAILURE) if (gfc_add_interface (sym) == FAILURE)
...@@ -3236,7 +3243,7 @@ loop: ...@@ -3236,7 +3243,7 @@ loop:
return MATCH_ERROR; 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; return MATCH_ERROR;
goto loop; goto loop;
} }
...@@ -3249,7 +3256,7 @@ loop: ...@@ -3249,7 +3256,7 @@ loop:
return MATCH_ERROR; 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; return MATCH_ERROR;
goto loop; goto loop;
} }
...@@ -3294,7 +3301,7 @@ loop: ...@@ -3294,7 +3301,7 @@ loop:
derived type that is a pointer. The first part of the AND clause 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. */ is true if a the symbol is not the return value of a function. */
if (sym->attr.flavor != FL_DERIVED 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; return MATCH_ERROR;
if (sym->components != NULL) if (sym->components != NULL)
...@@ -3306,7 +3313,7 @@ loop: ...@@ -3306,7 +3313,7 @@ loop:
} }
if (attr.access != ACCESS_UNKNOWN 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; return MATCH_ERROR;
gfc_new_block = sym; gfc_new_block = sym;
......
gcc/fortran/gfortran.h
...@@ -1573,32 +1573,33 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *); ...@@ -1573,32 +1573,33 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *);
void gfc_set_sym_referenced (gfc_symbol * sym); void gfc_set_sym_referenced (gfc_symbol * sym);
try gfc_add_allocatable (symbol_attribute *, locus *); 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_external (symbol_attribute *, locus *);
try gfc_add_intrinsic (symbol_attribute *, locus *); try gfc_add_intrinsic (symbol_attribute *, locus *);
try gfc_add_optional (symbol_attribute *, locus *); try gfc_add_optional (symbol_attribute *, locus *);
try gfc_add_pointer (symbol_attribute *, locus *); try gfc_add_pointer (symbol_attribute *, locus *);
try gfc_add_result (symbol_attribute *, locus *); try gfc_add_result (symbol_attribute *, const char *, locus *);
try gfc_add_save (symbol_attribute *, locus *); try gfc_add_save (symbol_attribute *, const char *, locus *);
try gfc_add_saved_common (symbol_attribute *, locus *); try gfc_add_saved_common (symbol_attribute *, locus *);
try gfc_add_target (symbol_attribute *, locus *); try gfc_add_target (symbol_attribute *, locus *);
try gfc_add_dummy (symbol_attribute *, locus *); try gfc_add_dummy (symbol_attribute *, const char *, locus *);
try gfc_add_generic (symbol_attribute *, locus *); try gfc_add_generic (symbol_attribute *, const char *, locus *);
try gfc_add_common (symbol_attribute *, locus *); try gfc_add_common (symbol_attribute *, locus *);
try gfc_add_in_common (symbol_attribute *, locus *); try gfc_add_in_common (symbol_attribute *, const char *, locus *);
try gfc_add_data (symbol_attribute *, locus *); try gfc_add_data (symbol_attribute *, const char *, locus *);
try gfc_add_in_namelist (symbol_attribute *, locus *); try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
try gfc_add_sequence (symbol_attribute *, locus *); try gfc_add_sequence (symbol_attribute *, const char *, locus *);
try gfc_add_elemental (symbol_attribute *, locus *); try gfc_add_elemental (symbol_attribute *, locus *);
try gfc_add_pure (symbol_attribute *, locus *); try gfc_add_pure (symbol_attribute *, locus *);
try gfc_add_recursive (symbol_attribute *, locus *); try gfc_add_recursive (symbol_attribute *, locus *);
try gfc_add_function (symbol_attribute *, locus *); try gfc_add_function (symbol_attribute *, const char *, locus *);
try gfc_add_subroutine (symbol_attribute *, locus *); try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, locus *); try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
try gfc_add_flavor (symbol_attribute *, sym_flavor, locus *); try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
try gfc_add_entry (symbol_attribute *, locus *); try gfc_add_entry (symbol_attribute *, const char *, locus *);
try gfc_add_procedure (symbol_attribute *, procedure_type, locus *); try gfc_add_procedure (symbol_attribute *, procedure_type,
const char *, locus *);
try gfc_add_intent (symbol_attribute *, sym_intent, locus *); try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
try gfc_add_explicit_interface (gfc_symbol *, ifsrc, try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
gfc_formal_arglist *, locus *); gfc_formal_arglist *, locus *);
......
gcc/fortran/interface.c
...@@ -213,7 +213,8 @@ gfc_match_interface (void) ...@@ -213,7 +213,8 @@ gfc_match_interface (void)
if (gfc_get_symbol (name, NULL, &sym)) if (gfc_get_symbol (name, NULL, &sym))
return MATCH_ERROR; 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; return MATCH_ERROR;
current_interface.sym = gfc_new_block = sym; current_interface.sym = gfc_new_block = sym;
......
gcc/fortran/match.c
...@@ -266,7 +266,8 @@ gfc_match_label (void) ...@@ -266,7 +266,8 @@ gfc_match_label (void)
} }
if (gfc_new_block->attr.flavor != FL_LABEL 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; return MATCH_ERROR;
for (p = gfc_state_stack; p; p = p->previous) for (p = gfc_state_stack; p; p = p->previous)
...@@ -806,7 +807,7 @@ gfc_match_program (void) ...@@ -806,7 +807,7 @@ gfc_match_program (void)
if (m == MATCH_ERROR) if (m == MATCH_ERROR)
return m; 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; return MATCH_ERROR;
gfc_new_block = sym; gfc_new_block = sym;
...@@ -2013,7 +2014,7 @@ gfc_match_call (void) ...@@ -2013,7 +2014,7 @@ gfc_match_call (void)
if (!sym->attr.generic if (!sym->attr.generic
&& !sym->attr.subroutine && !sym->attr.subroutine
&& gfc_add_subroutine (&sym->attr, NULL) == FAILURE) && gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
if (gfc_match_eos () != MATCH_YES) if (gfc_match_eos () != MATCH_YES)
...@@ -2237,7 +2238,7 @@ gfc_match_common (void) ...@@ -2237,7 +2238,7 @@ gfc_match_common (void)
goto cleanup; goto cleanup;
} }
if (gfc_add_in_common (&sym->attr, NULL) == FAILURE) if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE)
goto cleanup; goto cleanup;
if (sym->value != NULL if (sym->value != NULL
...@@ -2252,7 +2253,7 @@ gfc_match_common (void) ...@@ -2252,7 +2253,7 @@ gfc_match_common (void)
goto cleanup; goto cleanup;
} }
if (gfc_add_in_common (&sym->attr, NULL) == FAILURE) if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE)
goto cleanup; goto cleanup;
/* Derived type names must have the SEQUENCE attribute. */ /* Derived type names must have the SEQUENCE attribute. */
...@@ -2287,7 +2288,7 @@ gfc_match_common (void) ...@@ -2287,7 +2288,7 @@ gfc_match_common (void)
goto cleanup; goto cleanup;
} }
if (gfc_add_dimension (&sym->attr, NULL) == FAILURE) if (gfc_add_dimension (&sym->attr, sym->name, NULL) == FAILURE)
goto cleanup; goto cleanup;
if (sym->attr.pointer) if (sym->attr.pointer)
...@@ -2353,7 +2354,7 @@ gfc_match_block_data (void) ...@@ -2353,7 +2354,7 @@ gfc_match_block_data (void)
if (gfc_get_symbol (name, NULL, &sym)) if (gfc_get_symbol (name, NULL, &sym))
return MATCH_ERROR; 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; return MATCH_ERROR;
gfc_new_block = sym; gfc_new_block = sym;
...@@ -2403,7 +2404,8 @@ gfc_match_namelist (void) ...@@ -2403,7 +2404,8 @@ gfc_match_namelist (void)
} }
if (group_name->attr.flavor != FL_NAMELIST 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; return MATCH_ERROR;
for (;;) for (;;)
...@@ -2415,7 +2417,7 @@ gfc_match_namelist (void) ...@@ -2415,7 +2417,7 @@ gfc_match_namelist (void)
goto error; goto error;
if (sym->attr.in_namelist == 0 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; goto error;
nl = gfc_get_namelist (); nl = gfc_get_namelist ();
...@@ -2471,7 +2473,8 @@ gfc_match_module (void) ...@@ -2471,7 +2473,8 @@ gfc_match_module (void)
if (m != MATCH_YES) if (m != MATCH_YES)
return m; 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_ERROR;
return MATCH_YES; return MATCH_YES;
...@@ -2587,7 +2590,8 @@ gfc_match_st_function (void) ...@@ -2587,7 +2590,8 @@ gfc_match_st_function (void)
gfc_push_error (&old_error); 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; goto undo_error;
if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES) if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES)
......
gcc/fortran/parse.c
...@@ -1349,7 +1349,8 @@ parse_derived (void) ...@@ -1349,7 +1349,8 @@ parse_derived (void)
} }
seen_sequence = 1; seen_sequence = 1;
gfc_add_sequence (&gfc_current_block ()->attr, NULL); gfc_add_sequence (&gfc_current_block ()->attr,
gfc_current_block ()->name, NULL);
break; break;
default: default:
...@@ -1451,9 +1452,9 @@ loop: ...@@ -1451,9 +1452,9 @@ loop:
if (current_state == COMP_NONE) if (current_state == COMP_NONE)
{ {
if (new_state == COMP_FUNCTION) if (new_state == COMP_FUNCTION)
gfc_add_function (&sym->attr, NULL); gfc_add_function (&sym->attr, sym->name, NULL);
if (new_state == COMP_SUBROUTINE) else if (new_state == COMP_SUBROUTINE)
gfc_add_subroutine (&sym->attr, NULL); gfc_add_subroutine (&sym->attr, sym->name, NULL);
current_state = new_state; current_state = new_state;
} }
...@@ -2200,15 +2201,15 @@ parse_contained (int module) ...@@ -2200,15 +2201,15 @@ parse_contained (int module)
gfc_new_block->name); gfc_new_block->name);
else else
{ {
if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, sym->name,
&gfc_new_block->declared_at) == &gfc_new_block->declared_at) ==
SUCCESS) SUCCESS)
{ {
if (st == ST_FUNCTION) if (st == ST_FUNCTION)
gfc_add_function (&sym->attr, gfc_add_function (&sym->attr, sym->name,
&gfc_new_block->declared_at); &gfc_new_block->declared_at);
else else
gfc_add_subroutine (&sym->attr, gfc_add_subroutine (&sym->attr, sym->name,
&gfc_new_block->declared_at); &gfc_new_block->declared_at);
} }
} }
......
gcc/fortran/primary.c
...@@ -1877,7 +1877,7 @@ gfc_match_rvalue (gfc_expr ** result) ...@@ -1877,7 +1877,7 @@ gfc_match_rvalue (gfc_expr ** result)
e->rank = sym->as->rank; e->rank = sym->as->rank;
if (!sym->attr.function if (!sym->attr.function
&& gfc_add_function (&sym->attr, NULL) == FAILURE) && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
{ {
m = MATCH_ERROR; m = MATCH_ERROR;
break; break;
...@@ -1905,7 +1905,8 @@ gfc_match_rvalue (gfc_expr ** result) ...@@ -1905,7 +1905,8 @@ gfc_match_rvalue (gfc_expr ** result)
if (sym->attr.dimension) 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; m = MATCH_ERROR;
break; break;
...@@ -1930,7 +1931,8 @@ gfc_match_rvalue (gfc_expr ** result) ...@@ -1930,7 +1931,8 @@ gfc_match_rvalue (gfc_expr ** result)
e->symtree = symtree; e->symtree = symtree;
e->expr_type = EXPR_VARIABLE; 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; m = MATCH_ERROR;
break; break;
...@@ -1964,7 +1966,8 @@ gfc_match_rvalue (gfc_expr ** result) ...@@ -1964,7 +1966,8 @@ gfc_match_rvalue (gfc_expr ** result)
e->expr_type = EXPR_VARIABLE; e->expr_type = EXPR_VARIABLE;
if (sym->attr.flavor != FL_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; m = MATCH_ERROR;
break; break;
...@@ -1990,7 +1993,7 @@ gfc_match_rvalue (gfc_expr ** result) ...@@ -1990,7 +1993,7 @@ gfc_match_rvalue (gfc_expr ** result)
e->expr_type = EXPR_FUNCTION; e->expr_type = EXPR_FUNCTION;
if (!sym->attr.function if (!sym->attr.function
&& gfc_add_function (&sym->attr, NULL) == FAILURE) && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
{ {
m = MATCH_ERROR; m = MATCH_ERROR;
break; break;
...@@ -2072,7 +2075,8 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag) ...@@ -2072,7 +2075,8 @@ gfc_match_variable (gfc_expr ** result, int equiv_flag)
break; break;
case FL_UNKNOWN: 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; return MATCH_ERROR;
break; break;
......
gcc/fortran/resolve.c
...@@ -151,7 +151,7 @@ resolve_formal_arglist (gfc_symbol * proc) ...@@ -151,7 +151,7 @@ resolve_formal_arglist (gfc_symbol * proc)
A procedure specification would have already set the type. */ A procedure specification would have already set the type. */
if (sym->attr.flavor == FL_UNKNOWN) 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)) if (gfc_pure (proc))
{ {
...@@ -364,12 +364,12 @@ resolve_entries (gfc_namespace * ns) ...@@ -364,12 +364,12 @@ resolve_entries (gfc_namespace * ns)
gfc_get_ha_symbol (name, &proc); gfc_get_ha_symbol (name, &proc);
gcc_assert (proc != NULL); 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) if (ns->proc_name->attr.subroutine)
gfc_add_subroutine (&proc->attr, NULL); gfc_add_subroutine (&proc->attr, proc->name, NULL);
else else
{ {
gfc_add_function (&proc->attr, NULL); gfc_add_function (&proc->attr, proc->name, NULL);
gfc_internal_error ("TODO: Functions with alternate entry points"); gfc_internal_error ("TODO: Functions with alternate entry points");
} }
proc->attr.access = ACCESS_PRIVATE; proc->attr.access = ACCESS_PRIVATE;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment