@@ -352,7 +352,7 @@ syntax:
static match
match_data_constant (gfc_expr **result)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol *sym, *dt_sym = NULL;
gfc_expr *expr;
match m;
@@ -404,7 +404,7 @@ match_data_constant (gfc_expr **result)
gfc_current_locus = old_loc;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -2261,7 +2261,7 @@ match_pointer_init (gfc_expr **init, int procptr)
static bool
-check_function_name (char *name)
+check_function_name (const char *name)
{
/* In functions that have a RESULT variable defined, the function name always
refers to function calls. Therefore, the name is not allowed to appear in
@@ -2294,7 +2294,7 @@ check_function_name (char *name)
static match
variable_decl (int elem)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
static unsigned int fill_id = 0;
gfc_expr *initializer, *char_len;
gfc_array_spec *as;
@@ -2326,7 +2326,7 @@ variable_decl (int elem)
if (m != MATCH_YES)
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
goto cleanup;
}
@@ -2351,7 +2351,7 @@ variable_decl (int elem)
}
/* %FILL components are given invalid fortran names. */
- snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "%%FILL%u", fill_id++);
+ name = gfc_get_string ("%%FILL%u", fill_id++);
m = MATCH_YES;
}
@@ -2584,13 +2584,13 @@ variable_decl (int elem)
if (gfc_current_state () == COMP_FUNCTION
&& strcmp ("ppr@", gfc_current_block ()->name) == 0
&& strcmp (name, gfc_current_block ()->ns->proc_name->name) == 0)
- strcpy (name, "ppr@");
+ name = gfc_get_string ("%s", "ppr@");
if (gfc_current_state () == COMP_FUNCTION
&& strcmp (name, gfc_current_block ()->name) == 0
&& gfc_current_block ()->result
&& strcmp ("ppr@", gfc_current_block ()->result->name) == 0)
- strcpy (name, "ppr@");
+ name = gfc_get_string ("%s", "ppr@");
/* OK, we've successfully matched the declaration. Now put the
symbol in the current namespace, because it might be used in the
@@ -5694,13 +5694,13 @@ set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents)
bool
get_bind_c_idents (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
int num_idents = 0;
gfc_symbol *tmp_sym = NULL;
match found_id;
gfc_common_head *com_block = NULL;
- if (gfc_match_name (name) == MATCH_YES)
+ if (gfc_match_name (&name) == MATCH_YES)
{
found_id = MATCH_YES;
gfc_get_ha_symbol (name, &tmp_sym);
@@ -5745,7 +5745,7 @@ get_bind_c_idents (void)
found_id = MATCH_NO;
else if (gfc_match_char (',') != MATCH_YES)
found_id = MATCH_NO;
- else if (gfc_match_name (name) == MATCH_YES)
+ else if (gfc_match_name (&name) == MATCH_YES)
{
found_id = MATCH_YES;
gfc_get_ha_symbol (name, &tmp_sym);
@@ -6126,7 +6126,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
int null_flag, bool typeparam)
{
gfc_formal_arglist *head, *tail, *p, *q;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol *sym;
match m;
gfc_formal_arglist *formal = NULL;
@@ -6173,7 +6173,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
}
else
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
{
if(typeparam)
@@ -6317,14 +6317,14 @@ cleanup:
static match
match_result (gfc_symbol *function, gfc_symbol **result)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol *r;
match m;
if (gfc_match (" result (") != MATCH_YES)
return MATCH_NO;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -6515,7 +6515,7 @@ match_procedure_interface (gfc_symbol **proc_if)
gfc_symtree *st;
locus old_loc, entry_loc;
gfc_namespace *old_ns = gfc_current_ns;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
old_loc = entry_loc = gfc_current_locus;
gfc_clear_ts (¤t_ts);
@@ -6538,7 +6538,7 @@ match_procedure_interface (gfc_symbol **proc_if)
/* Procedure interface is itself a procedure. */
gfc_current_locus = old_loc;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
/* First look to see if it is already accessible in the current
namespace because it is use associated or contained. */
@@ -6737,7 +6737,7 @@ match_ppc_decl (void)
gfc_component *c;
gfc_expr *initializer = NULL;
gfc_typebound_proc* tb;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
/* Parse interface (with brackets). */
m = match_procedure_interface (&proc_if);
@@ -6778,7 +6778,7 @@ match_ppc_decl (void)
ts = current_ts;
for(num=1;;num++)
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
goto syntax;
else if (m == MATCH_ERROR)
@@ -6855,7 +6855,7 @@ match_procedure_in_interface (void)
{
match m;
gfc_symbol *sym;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
locus old_locus;
if (current_interface.type == INTERFACE_NAMELESS
@@ -6879,7 +6879,7 @@ match_procedure_in_interface (void)
for(;;)
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
goto syntax;
else if (m == MATCH_ERROR)
@@ -7180,7 +7180,7 @@ gfc_match_entry (void)
gfc_symbol *proc;
gfc_symbol *result;
gfc_symbol *entry;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_compile_state state;
match m;
gfc_entry_list *el;
@@ -7189,7 +7189,7 @@ gfc_match_entry (void)
char peek_char;
match is_bind_c;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -7787,7 +7787,7 @@ set_enum_kind(void)
match
gfc_match_end (gfc_statement *st)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_compile_state state;
locus old_loc;
const char *block_name;
@@ -8031,7 +8031,7 @@ gfc_match_end (gfc_statement *st)
end-name. */
m = gfc_match_space ();
if (m == MATCH_YES)
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
gfc_error ("Expected terminating name at %C");
@@ -8113,7 +8113,7 @@ cleanup:
static match
attr_decl1 (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_array_spec *as;
/* Workaround -Wmaybe-uninitialized false positive during
@@ -8124,7 +8124,7 @@ attr_decl1 (void)
as = NULL;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
goto cleanup;
@@ -9384,7 +9384,7 @@ cleanup:
match
gfc_match_modproc (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol *sym;
match m;
locus old_locus;
@@ -9433,7 +9433,7 @@ gfc_match_modproc (void)
bool last = false;
old_locus = gfc_current_locus;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
goto syntax;
if (m != MATCH_YES)
@@ -9818,7 +9818,7 @@ gfc_match_structure_decl (void)
match
gfc_match_type (gfc_statement *st)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
match m;
locus old_loc;
@@ -9844,7 +9844,7 @@ gfc_match_type (gfc_statement *st)
/* By now "TYPE" has already been matched. If we do not see a name, this may
* be something like "TYPE *" or "TYPE <fmt>". */
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
{
/* Let print match if it can, otherwise throw an error from
@@ -10236,7 +10236,7 @@ enum_initializer (gfc_expr *last_initializer, locus where)
static match
enumerator_decl (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_expr *initializer;
gfc_array_spec *as = NULL;
gfc_symbol *sym;
@@ -10251,7 +10251,7 @@ enumerator_decl (void)
/* When we get here, we've just matched a list of attributes and
maybe a type and a double colon. The next thing we expect to see
is the name of the symbol. */
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
goto cleanup;
@@ -10591,9 +10591,9 @@ error:
static match
match_procedure_in_type (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
- char target_buf[GFC_MAX_SYMBOL_LEN + 1];
- char* target = NULL, *ifc = NULL;
+ const char *name = NULL;
+ const char *target_buf = NULL;
+ const char *target = NULL, *ifc = NULL;
gfc_typebound_proc tb;
bool seen_colons;
bool seen_attrs;
@@ -10611,7 +10611,7 @@ match_procedure_in_type (void)
/* Try to match PROCEDURE(interface). */
if (gfc_match (" (") == MATCH_YES)
{
- m = gfc_match_name (target_buf);
+ m = gfc_match_name (&target_buf);
if (m == MATCH_ERROR)
return m;
if (m != MATCH_YES)
@@ -10665,7 +10665,7 @@ match_procedure_in_type (void)
/* Match the binding names. */
for(num=1;;num++)
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_ERROR)
return m;
if (m == MATCH_NO)
@@ -10697,7 +10697,7 @@ match_procedure_in_type (void)
return MATCH_ERROR;
}
- m = gfc_match_name (target_buf);
+ m = gfc_match_name (&target_buf);
if (m == MATCH_ERROR)
return m;
if (m == MATCH_NO)
@@ -10931,8 +10931,9 @@ gfc_match_generic (void)
{
gfc_symtree* target_st;
gfc_tbp_generic* target;
+ const char *name2 = NULL;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name2);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
@@ -10941,14 +10942,14 @@ gfc_match_generic (void)
goto error;
}
- target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name);
+ target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name2);
/* See if this is a duplicate specification. */
for (target = tb->u.generic; target; target = target->next)
if (target_st == target->specific_st)
{
gfc_error ("%qs already defined as specific binding for the"
- " generic %qs at %C", name, bind_name);
+ " generic %qs at %C", name2, bind_name);
goto error;
}
@@ -10981,7 +10982,7 @@ error:
match
gfc_match_final_decl (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol* sym;
match m;
gfc_namespace* module_ns;
@@ -11037,7 +11038,7 @@ gfc_match_final_decl (void)
return MATCH_ERROR;
}
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
{
gfc_error ("Expected module procedure name at %C");
@@ -11120,7 +11121,7 @@ match
gfc_match_gcc_attributes (void)
{
symbol_attribute attr;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
unsigned id;
gfc_symbol *sym;
match m;
@@ -11130,7 +11131,7 @@ gfc_match_gcc_attributes (void)
{
char ch;
- if (gfc_match_name (name) != MATCH_YES)
+ if (gfc_match_name (&name) != MATCH_YES)
return MATCH_ERROR;
for (id = 0; id < EXT_ATTR_LAST; id++)
@@ -11166,7 +11167,7 @@ gfc_match_gcc_attributes (void)
for(;;)
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -140,6 +140,7 @@ gfc_match_generic_spec (interface_type *type,
gfc_intrinsic_op *op)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name2 = NULL;
match m;
gfc_intrinsic_op i;
@@ -212,9 +213,9 @@ gfc_match_generic_spec (interface_type *type,
return MATCH_YES;
}
- if (gfc_match_name (buffer) == MATCH_YES)
+ if (gfc_match_name (&name2) == MATCH_YES)
{
- strcpy (name, buffer);
+ strcpy (name, name2);
*type = INTERFACE_GENERIC;
return MATCH_YES;
}
@@ -4071,7 +4071,7 @@ if (condition) \
static match
match_io (io_kind k)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_code *io_code;
gfc_symbol *sym;
int comma_flag;
@@ -4093,7 +4093,7 @@ match_io (io_kind k)
{
/* Treat the non-standard case of PRINT namelist. */
if ((gfc_current_form == FORM_FIXED || gfc_peek_ascii_char () == ' ')
- && gfc_match_name (name) == MATCH_YES)
+ && gfc_match_name (&name) == MATCH_YES)
{
gfc_find_symbol (name, NULL, 1, &sym);
if (sym && sym->attr.flavor == FL_NAMELIST)
@@ -4219,7 +4219,7 @@ match_io (io_kind k)
where = gfc_current_locus;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_YES)
{
gfc_find_symbol (name, NULL, 1, &sym);
@@ -25,6 +25,8 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h"
#include "match.h"
#include "parse.h"
+#include "stringpool.h"
+#include "tree.h"
int gfc_matching_ptr_assignment = 0;
int gfc_matching_procptr_assignment = 0;
@@ -150,7 +152,7 @@ gfc_op2string (gfc_intrinsic_op op)
match
gfc_match_member_sep(gfc_symbol *sym)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
locus dot_loc, start_loc;
gfc_intrinsic_op iop;
match m;
@@ -176,7 +178,6 @@ gfc_match_member_sep(gfc_symbol *sym)
tsym = sym->ts.u.derived;
iop = INTRINSIC_NONE;
- name[0] = '\0';
m = MATCH_NO;
/* If we have to reject come back here later. */
@@ -190,7 +191,7 @@ gfc_match_member_sep(gfc_symbol *sym)
dot_loc = gfc_current_locus;
/* Try to match a symbol name following the dot. */
- if (gfc_match_name (name) != MATCH_YES)
+ if (gfc_match_name (&name) != MATCH_YES)
{
gfc_error ("Expected structure component or operator name "
"after '.' at %C");
@@ -634,17 +635,18 @@ gfc_match_label (void)
}
-/* See if the current input looks like a name of some sort. Modifies
- the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long.
+/* See if the current input looks like a name of some sort.
+ Upon success RESULT is set to the matched name and MATCH_YES is returned.
Note that options.c restricts max_identifier_length to not more
than GFC_MAX_SYMBOL_LEN. */
match
-gfc_match_name (char *buffer)
+gfc_match_name (const char **result)
{
locus old_loc;
int i;
char c;
+ char buffer[GFC_MAX_SYMBOL_LEN + 1];
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
@@ -685,7 +687,7 @@ gfc_match_name (char *buffer)
return MATCH_ERROR;
}
- buffer[i] = '\0';
+ *result = IDENTIFIER_POINTER (get_identifier_with_length (buffer, i));
gfc_current_locus = old_loc;
return MATCH_YES;
@@ -698,10 +700,10 @@ gfc_match_name (char *buffer)
match
gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc)
{
- char buffer[GFC_MAX_SYMBOL_LEN + 1];
+ const char *buffer = NULL;
match m;
- m = gfc_match_name (buffer);
+ m = gfc_match_name (&buffer);
if (m != MATCH_YES)
return m;
@@ -1123,6 +1125,7 @@ gfc_match (const char *target, ...)
locus old_loc;
va_list argp;
char c, *np;
+ const char *name2_hack = NULL;
match m, n;
void **vp;
const char *p;
@@ -1186,12 +1189,13 @@ loop:
case 'n':
np = va_arg (argp, char *);
- n = gfc_match_name (np);
+ n = gfc_match_name (&name2_hack);
if (n != MATCH_YES)
{
m = n;
goto not_yes;
}
+ strcpy (np, name2_hack);
matches++;
goto loop;
@@ -1694,12 +1698,12 @@ got_match:
match
gfc_match_else (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
if (gfc_match_eos () == MATCH_YES)
return MATCH_YES;
- if (gfc_match_name (name) != MATCH_YES
+ if (gfc_match_name (&name) != MATCH_YES
|| gfc_current_block () == NULL
|| gfc_match_eos () != MATCH_YES)
{
@@ -1723,7 +1727,7 @@ gfc_match_else (void)
match
gfc_match_elseif (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_expr *expr;
match m;
@@ -1734,7 +1738,7 @@ gfc_match_elseif (void)
if (gfc_match_eos () == MATCH_YES)
goto done;
- if (gfc_match_name (name) != MATCH_YES
+ if (gfc_match_name (&name) != MATCH_YES
|| gfc_current_block () == NULL
|| gfc_match_eos () != MATCH_YES)
{
@@ -5029,23 +5033,23 @@ gfc_get_common (const char *name, int from_module)
/* Match a common block name. */
-match match_common_name (char *name)
+match match_common_name (const char *&name)
{
match m;
if (gfc_match_char ('/') == MATCH_NO)
{
- name[0] = '\0';
+ name = NULL;
return MATCH_YES;
}
if (gfc_match_char ('/') == MATCH_YES)
{
- name[0] = '\0';
+ name = NULL;
return MATCH_YES;
}
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_ERROR)
return MATCH_ERROR;
@@ -5063,7 +5067,7 @@ match
gfc_match_common (void)
{
gfc_symbol *sym, **head, *tail, *other;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_common_head *t;
gfc_array_spec *as;
gfc_equiv *e1, *e2;
@@ -5077,7 +5081,7 @@ gfc_match_common (void)
if (m == MATCH_ERROR)
goto cleanup;
- if (name[0] == '\0')
+ if (name == NULL)
{
t = &gfc_current_ns->blank_common;
if (t->head == NULL)
@@ -5736,10 +5740,10 @@ gfc_match_ptr_fcn_assign (void)
gfc_symbol *sym;
gfc_expr *expr;
match m;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
old_loc = gfc_current_locus;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -5888,7 +5892,7 @@ cleanup:
static match
match_case_eos (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
match m;
if (gfc_match_eos () == MATCH_YES)
@@ -5901,7 +5905,7 @@ match_case_eos (void)
gfc_gobble_whitespace ();
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -6589,7 +6593,7 @@ gfc_match_where (gfc_statement *st)
match
gfc_match_elsewhere (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_expr *expr;
match m;
@@ -6622,7 +6626,7 @@ gfc_match_elsewhere (void)
goto cleanup;
}
/* Better be a name at this point. */
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
goto syntax;
if (m == MATCH_ERROR)
@@ -50,7 +50,7 @@ match gfc_match_st_label (gfc_st_label **);
match gfc_match_label (void);
match gfc_match_small_int (int *);
match gfc_match_small_int_expr (int *, gfc_expr **);
-match gfc_match_name (char *);
+match gfc_match_name (const char **);
match gfc_match_name_C (const char **buffer);
match gfc_match_symbol (gfc_symbol **, int);
match gfc_match_sym_tree (gfc_symtree **, int);
@@ -107,7 +107,7 @@ match gfc_match_call (void);
TODO: should probably rename this now that it'll be globally seen to
gfc_match_common_name. */
-match match_common_name (char *name);
+match match_common_name (const char *&name);
match gfc_match_common (void);
match gfc_match_block_data (void);
@@ -520,6 +520,7 @@ match
gfc_match_use (void)
{
char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name2 = NULL;
gfc_use_rename *tail = NULL, *new_use;
interface_type type, type2;
gfc_intrinsic_op op;
@@ -583,14 +584,14 @@ gfc_match_use (void)
use_list->where = gfc_current_locus;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name2);
if (m != MATCH_YES)
{
free (use_list);
return m;
}
- use_list->module_name = gfc_get_string ("%s", name);
+ use_list->module_name = name2;
if (gfc_match_eos () == MATCH_YES)
goto done;
@@ -1580,8 +1580,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&& gfc_match ("reduction ( ") == MATCH_YES)
{
gfc_omp_reduction_op rop = OMP_REDUCTION_NONE;
- char buffer[GFC_MAX_SYMBOL_LEN + 3];
- const char *op = NULL;
+ const char *buffer = NULL;
if (gfc_match_char ('+') == MATCH_YES)
rop = OMP_REDUCTION_PLUS;
else if (gfc_match_char ('*') == MATCH_YES)
@@ -1597,11 +1596,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else if (gfc_match (".neqv.") == MATCH_YES)
rop = OMP_REDUCTION_NEQV;
if (rop != OMP_REDUCTION_NONE)
- op = gfc_get_string ("operator %s",
+ buffer = gfc_get_string ("operator %s",
gfc_op2string ((gfc_intrinsic_op) rop));
- else if (gfc_match_defined_op_name (op, 1, 1) == MATCH_YES)
+ else if (gfc_match_defined_op_name (buffer, 1, 1) == MATCH_YES)
;
- else if (gfc_match_name (buffer) == MATCH_YES)
+ else if (gfc_match_name (&buffer) == MATCH_YES)
{
gfc_symbol *sym;
const char *n = buffer;
@@ -1657,11 +1656,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
rop = OMP_REDUCTION_NONE;
}
else
- buffer[0] = '\0';
+ buffer = NULL;
gfc_omp_udr *udr;
- if (op != NULL)
- udr = gfc_find_omp_udr (gfc_current_ns, op, NULL);
- else if (buffer[0])
+ if (buffer != NULL)
udr = gfc_find_omp_udr (gfc_current_ns, buffer, NULL);
else
udr = NULL;
@@ -1680,7 +1677,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
n = *head;
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found "
- "at %L", op ? op : buffer, &old_loc);
+ "at %L", buffer, &old_loc);
gfc_free_omp_namelist (n);
}
else
@@ -2290,13 +2287,13 @@ gfc_match_oacc_routine (void)
if (m == MATCH_YES)
{
- char buffer[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symtree *st;
- m = gfc_match_name (buffer);
+ m = gfc_match_name (&name);
if (m == MATCH_YES)
{
- st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+ st = gfc_find_symtree (gfc_current_ns->sym_root, name);
if (st)
{
sym = st->n.sym;
@@ -2313,7 +2310,7 @@ gfc_match_oacc_routine (void)
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
"invalid function name %s",
- (sym) ? sym->name : buffer);
+ (sym) ? sym->name : name);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -39,7 +39,7 @@ int matching_actual_arglist = 0;
static match
match_kind_param (int *kind, int *is_iso_c)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol *sym;
match m;
@@ -49,7 +49,7 @@ match_kind_param (int *kind, int *is_iso_c)
if (m != MATCH_NO)
return m;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -1234,12 +1234,12 @@ match_logical_constant (gfc_expr **result)
static match
match_sym_complex_part (gfc_expr **result)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symbol *sym;
gfc_expr *e;
match m;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
@@ -1525,7 +1525,7 @@ gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns)
static match
match_actual_arg (gfc_expr **result)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_symtree *symtree;
locus where, w;
gfc_expr *e;
@@ -1534,7 +1534,7 @@ match_actual_arg (gfc_expr **result)
gfc_gobble_whitespace ();
where = gfc_current_locus;
- switch (gfc_match_name (name))
+ switch (gfc_match_name (&name))
{
case MATCH_ERROR:
return MATCH_ERROR;
@@ -1629,13 +1629,13 @@ match_actual_arg (gfc_expr **result)
static match
match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base, bool pdt)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_actual_arglist *a;
locus name_locus;
match m;
name_locus = gfc_current_locus;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
goto cleanup;
@@ -1667,7 +1667,7 @@ match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base, bool pd
/* Make sure this name has not appeared yet. */
add_name:
- if (name[0] != '\0')
+ if (name != NULL)
{
for (a = base; a; a = a->next)
if (a->name != NULL && strcmp (a->name, name) == 0)
@@ -1678,7 +1678,7 @@ add_name:
}
}
- actual->name = gfc_get_string ("%s", name);
+ actual->name = name;
return MATCH_YES;
cleanup:
@@ -1948,7 +1948,7 @@ match
gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
bool ppc_arg)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_ref *substring, *tail, *tmp;
gfc_component *component;
gfc_symbol *sym = primary->symtree->n.sym;
@@ -2136,7 +2136,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
bool t;
gfc_symtree *tbp;
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m == MATCH_NO)
gfc_error ("Expected structure component name at %C");
if (m != MATCH_YES)
@@ -3144,7 +3144,8 @@ match
gfc_match_rvalue (gfc_expr **result)
{
gfc_actual_arglist *actual_arglist;
- char name[GFC_MAX_SYMBOL_LEN + 1], argname[GFC_MAX_SYMBOL_LEN + 1];
+ char argname[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_state_data *st;
gfc_symbol *sym;
gfc_symtree *symtree;
@@ -3161,12 +3162,12 @@ gfc_match_rvalue (gfc_expr **result)
{
if (!gfc_notify_std (GFC_STD_LEGACY, "%%LOC() as an rvalue at %C"))
return MATCH_ERROR;
- strncpy (name, "loc", 4);
+ name = gfc_get_string ("%s", "loc");
}
else
{
- m = gfc_match_name (name);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
return m;
}
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org> Occurrences of name2 in this patch will be fixed later in this series. gcc/fortran/ChangeLog: 2017-10-23 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> * match.h (gfc_match_name): Pass argument by reference. Adjust all callers. (match_common_name): Likewise. * match.c (gfc_match_name): Set result to IDENTIFIER_POINTER of stringpool node. (gfc_match_member_sep, gfc_match_sym_tree, gfc_match, gfc_match_else, gfc_match_elseif, match_common_name, gfc_match_common, gfc_match_ptr_fcn_assign, match_case_eos, gfc_match_elsewhere): Adjust. * decl.c (variable_decl): Set name via gfc_get_string() and adjust calls to gfc_match_name. (match_data_constant, check_function_name, get_bind_c_idents, gfc_match_formal_arglist, match_result, match_procedure_interface, match_ppc_decl, match_procedure_in_interface, gfc_match_entry, gfc_match_end, attr_decl1, gfc_match_modproc, gfc_match_type, enumerator_decl, match_procedure_in_type, gfc_match_generic, gfc_match_final_decl, gfc_match_gcc_attributes): Adjust. * interface.c (gfc_match_generic_spec): Adjust. * io.c (match_io): Adjust. * module.c (gfc_match_use): Adjust. * openmp.c (gfc_match_omp_clauses, gfc_match_oacc_routine): Adjust. * primary.c (match_kind_param, match_sym_complex_part, match_actual_arg, match_keyword_arg, gfc_match_varspec, gfc_match_rvalue): Adjust. --- gcc/fortran/decl.c | 95 +++++++++++++++++++++-------------------- gcc/fortran/interface.c | 5 ++- gcc/fortran/io.c | 6 +-- gcc/fortran/match.c | 56 +++++++++++++----------- gcc/fortran/match.h | 4 +- gcc/fortran/module.c | 5 ++- gcc/fortran/openmp.c | 25 +++++------ gcc/fortran/primary.c | 31 +++++++------- 8 files changed, 116 insertions(+), 111 deletions(-)