procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gfortran.h (gfc_extract_int): Change return type to bool.

Browse source 
* gfortran.h (gfc_extract_int): Change return type to bool.  Add
	int argument with = 0.
	* decl.c (gfc_match_kind_spec): Adjust gfc_extract_int caller, pass
	1 as new last argument to it, don't emit gfc_error.
	(match_char_kind): Likewise.
	(gfc_match_decl_type_spec): Use gfc_get_string ("%s", x) instead of
	gfc_get_string (x).
	(gfc_match_derived_decl, match_binding_attributes): Likewise.
	(gfc_match_structure_decl): Don't sprintf back to name, call
	get_struct_decl directly with gfc_dt_upper_string (name) result.
	* trans-stmt.c (gfc_trans_allocate): Use gfc_get_string ("%s", x)
	instead of gfc_get_string (x).
	* module.c (gfc_dt_lower_string, gfc_dt_upper_string,
	gfc_match_use, gfc_match_submodule, find_true_name, mio_pool_string,
	mio_symtree_ref, mio_expr, mio_omp_udr_expr, load_generic_interfaces,
	load_omp_udrs, load_needed, read_module, dump_module,
	create_intrinsic_function, import_iso_c_binding_module,
	create_int_parameter, create_int_parameter_array, create_derived_type,
	use_iso_fortran_env_module): Likewise.
	* error.c (gfc_diagnostic_starter, gfc_diagnostic_start_span): Use
	pp_verbatim (context->printer, "%s", x) instead of
	pp_verbatim (context->printer, x).
	* match.c (gfc_match_small_int): Adjust gfc_extract_int caller, pass
	1 as new last argument to it, don't emit gfc_error.
	(gfc_match_small_int_expr): Likewise.
	* iresolve.c (gfc_get_string): Optimize format "%s" case.
	(resolve_bound): Use gfc_get_string ("%s", x) instead of
	gfc_get_string (x).
	(resolve_transformational): Formatting fix.
	(gfc_resolve_char_achar): Change name argument to bool is_achar,
	use a single format string and if is_achar add "a" before "char".
	(gfc_resolve_achar, gfc_resolve_char): Adjust callers.
	* expr.c (gfc_extract_int): Change return type to bool, return true
	if some error occurred.  Add REPORT_ERROR argument, if non-zero
	call either gfc_error or gfc_error_now depending on its sign.
	* arith.c (arith_power): Adjust gfc_extract_int caller.
	* symbol.c (gfc_add_component): Use gfc_get_string ("%s", x) instead
	of gfc_get_string (x).
	(gfc_new_symtree, gfc_delete_symtree, gfc_get_uop, gfc_new_symbol,
	gfc_get_gsymbol, generate_isocbinding_symbol): Likewise.
	* openmp.c (gfc_match_omp_clauses): Adjust gfc_extract_int caller, pass
	-1 as new last argument to it, don't emit gfc_error_now.
	(gfc_match_omp_declare_reduction): Use gfc_get_string ("%s", x)
	instead of gfc_get_string (x).
	* check.c (kind_check): Adjust gfc_extract_int caller.
	* intrinsic.c (add_sym, find_sym, make_alias): Use
	gfc_get_string ("%s", x) instead of gfc_get_string (x).
	* simplify.c (get_kind, gfc_simplify_btest, gfc_simplify_maskr,
	gfc_simplify_maskl, gfc_simplify_poppar, gfc_simplify_repeat,
	gfc_simplify_selected_int_kind, gfc_simplify_selected_real_kind):
	Adjust gfc_extract_int callers.
	* trans-decl.c (gfc_find_module): Use gfc_get_string ("%s", x)
	instead of gfc_get_string (x).
	* matchexp.c (expression_syntax): Add const.
	* primary.c (match_kind_param, match_hollerith_constant,
	match_string_constant): Adjust gfc_extract_int callers.
	(match_keyword_arg): Use gfc_get_string ("%s", x) instead of
	gfc_get_string (x).
	* frontend-passes.c (optimize_minmaxloc): Likewise.

From-SVN: r244744
This commit is contained in:
Jakub Jelinek 2017-01-21 11:30:54 +01:00 • committed by Jakub Jelinek
parent c6c82710ed
commit 51f03c6b11
19 changed files with 201 additions and 150 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
gcc/fortran/ChangeLog
View file

@ -1,3 +1,65 @@
2017-01-21 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (gfc_extract_int): Change return type to bool. Add
int argument with = 0.
* decl.c (gfc_match_kind_spec): Adjust gfc_extract_int caller, pass
1 as new last argument to it, don't emit gfc_error.
(match_char_kind): Likewise.
(gfc_match_decl_type_spec): Use gfc_get_string ("%s", x) instead of
gfc_get_string (x).
(gfc_match_derived_decl, match_binding_attributes): Likewise.
(gfc_match_structure_decl): Don't sprintf back to name, call
get_struct_decl directly with gfc_dt_upper_string (name) result.
* trans-stmt.c (gfc_trans_allocate): Use gfc_get_string ("%s", x)
instead of gfc_get_string (x).
* module.c (gfc_dt_lower_string, gfc_dt_upper_string,
gfc_match_use, gfc_match_submodule, find_true_name, mio_pool_string,
mio_symtree_ref, mio_expr, mio_omp_udr_expr, load_generic_interfaces,
load_omp_udrs, load_needed, read_module, dump_module,
create_intrinsic_function, import_iso_c_binding_module,
create_int_parameter, create_int_parameter_array, create_derived_type,
use_iso_fortran_env_module): Likewise.
* error.c (gfc_diagnostic_starter, gfc_diagnostic_start_span): Use
pp_verbatim (context->printer, "%s", x) instead of
pp_verbatim (context->printer, x).
* match.c (gfc_match_small_int): Adjust gfc_extract_int caller, pass
1 as new last argument to it, don't emit gfc_error.
(gfc_match_small_int_expr): Likewise.
* iresolve.c (gfc_get_string): Optimize format "%s" case.
(resolve_bound): Use gfc_get_string ("%s", x) instead of
gfc_get_string (x).
(resolve_transformational): Formatting fix.
(gfc_resolve_char_achar): Change name argument to bool is_achar,
use a single format string and if is_achar add "a" before "char".
(gfc_resolve_achar, gfc_resolve_char): Adjust callers.
* expr.c (gfc_extract_int): Change return type to bool, return true
if some error occurred. Add REPORT_ERROR argument, if non-zero
call either gfc_error or gfc_error_now depending on its sign.
* arith.c (arith_power): Adjust gfc_extract_int caller.
* symbol.c (gfc_add_component): Use gfc_get_string ("%s", x) instead
of gfc_get_string (x).
(gfc_new_symtree, gfc_delete_symtree, gfc_get_uop, gfc_new_symbol,
gfc_get_gsymbol, generate_isocbinding_symbol): Likewise.
* openmp.c (gfc_match_omp_clauses): Adjust gfc_extract_int caller, pass
-1 as new last argument to it, don't emit gfc_error_now.
(gfc_match_omp_declare_reduction): Use gfc_get_string ("%s", x)
instead of gfc_get_string (x).
* check.c (kind_check): Adjust gfc_extract_int caller.
* intrinsic.c (add_sym, find_sym, make_alias): Use
gfc_get_string ("%s", x) instead of gfc_get_string (x).
* simplify.c (get_kind, gfc_simplify_btest, gfc_simplify_maskr,
gfc_simplify_maskl, gfc_simplify_poppar, gfc_simplify_repeat,
gfc_simplify_selected_int_kind, gfc_simplify_selected_real_kind):
Adjust gfc_extract_int callers.
* trans-decl.c (gfc_find_module): Use gfc_get_string ("%s", x)
instead of gfc_get_string (x).
* matchexp.c (expression_syntax): Add const.
* primary.c (match_kind_param, match_hollerith_constant,
match_string_constant): Adjust gfc_extract_int callers.
(match_keyword_arg): Use gfc_get_string ("%s", x) instead of
gfc_get_string (x).
* frontend-passes.c (optimize_minmaxloc): Likewise.
2017-01-19 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/70696

2
gcc/fortran/arith.c
View file

@ -875,7 +875,7 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
/* if op2 < 0, op1**op2 == 0 because abs(op1) > 1. */
mpz_set_si (result->value.integer, 0);
}
else if (gfc_extract_int (op2, &power) != NULL)
else if (gfc_extract_int (op2, &power))
{
/* If op2 doesn't fit in an int, the exponentiation will
overflow, because op2 > 0 and abs(op1) > 1. */

2
gcc/fortran/check.c
View file

@ -177,7 +177,7 @@ kind_check (gfc_expr *k, int n, bt type)
return false;
}
if (gfc_extract_int (k, &kind) != NULL
if (gfc_extract_int (k, &kind)
|| gfc_validate_kind (type, kind, true) < 0)
{
gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type),

22
gcc/fortran/decl.c
View file

@ -2540,7 +2540,6 @@ gfc_match_kind_spec (gfc_typespec *ts, bool kind_expr_only)
gfc_expr *e;
match m, n;
char c;
const char *msg;
m = MATCH_NO;
n = MATCH_YES;
@ -2598,11 +2597,8 @@ kind_expr:
goto no_match;
}
msg = gfc_extract_int (e, &ts->kind);
if (msg != NULL)
if (gfc_extract_int (e, &ts->kind, 1))
{
gfc_error (msg);
m = MATCH_ERROR;
goto no_match;
}
@ -2700,7 +2696,7 @@ match_char_kind (int * kind, int * is_iso_c)
locus where;
gfc_expr *e;
match m, n;
const char *msg;
bool fail;
m = MATCH_NO;
e = NULL;
@ -2730,11 +2726,10 @@ match_char_kind (int * kind, int * is_iso_c)
goto no_match;
}
msg = gfc_extract_int (e, kind);
fail = gfc_extract_int (e, kind, 1);
*is_iso_c = e->ts.is_iso_c;
if (msg != NULL)
if (fail)
{
gfc_error (msg);
m = MATCH_ERROR;
goto no_match;
}
@ -3302,7 +3297,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
/* Use upper case to save the actual derived-type symbol. */
gfc_get_symbol (dt_name, NULL, &dt_sym);
dt_sym->name = gfc_get_string (sym->name);
dt_sym->name = gfc_get_string ("%s", sym->name);
head = sym->generic;
intr = gfc_get_interface ();
intr->sym = dt_sym;
@ -8743,8 +8738,7 @@ gfc_match_structure_decl (void)
/* Store the actual type symbol for the structure with an upper-case first
letter (an invalid Fortran identifier). */
sprintf (name, gfc_dt_upper_string (name));
if (!get_struct_decl (name, FL_STRUCT, &where, &sym))
if (!get_struct_decl (gfc_dt_upper_string (name), FL_STRUCT, &where, &sym))
return MATCH_ERROR;
gfc_new_block = sym;
@ -8937,7 +8931,7 @@ gfc_match_derived_decl (void)
{
/* Use upper case to save the actual derived-type symbol. */
gfc_get_symbol (gfc_dt_upper_string (gensym->name), NULL, &sym);
sym->name = gfc_get_string (gensym->name);
sym->name = gfc_get_string ("%s", gensym->name);
head = gensym->generic;
intr = gfc_get_interface ();
intr->sym = sym;
@ -9357,7 +9351,7 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc)
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_YES)
ba->pass_arg = gfc_get_string (arg);
ba->pass_arg = gfc_get_string ("%s", arg);
gcc_assert ((m == MATCH_YES) == (ba->pass_arg != NULL));
found_passing = true;

4
gcc/fortran/error.c
View file

@ -1089,7 +1089,7 @@ gfc_diagnostic_starter (diagnostic_context *context,
}
else
{
pp_verbatim (context->printer, locus_prefix);
pp_verbatim (context->printer, "%s", locus_prefix);
free (locus_prefix);
/* Fortran uses an empty line between locus and caret line. */
pp_newline (context->printer);
@ -1106,7 +1106,7 @@ gfc_diagnostic_start_span (diagnostic_context *context,
{
char *locus_prefix;
locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc);
pp_verbatim (context->printer, locus_prefix);
pp_verbatim (context->printer, "%s", locus_prefix);
free (locus_prefix);
pp_newline (context->printer);
/* Fortran uses an empty line between locus and caret line. */

34
gcc/fortran/expr.c
View file

@ -611,28 +611,44 @@ gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
/* Try to extract an integer constant from the passed expression node.
Returns an error message or NULL if the result is set. It is
tempting to generate an error and return true or false, but
failure is OK for some callers. */
Return true if some error occurred, false on success. If REPORT_ERROR
is non-zero, emit error, for positive REPORT_ERROR using gfc_error,
for negative using gfc_error_now. */
const char *
gfc_extract_int (gfc_expr *expr, int *result)
bool
gfc_extract_int (gfc_expr *expr, int *result, int report_error)
{
if (expr->expr_type != EXPR_CONSTANT)
return _("Constant expression required at %C");
{
if (report_error > 0)
gfc_error ("Constant expression required at %C");
else if (report_error < 0)
gfc_error_now ("Constant expression required at %C");
return true;
}
if (expr->ts.type != BT_INTEGER)
return _("Integer expression required at %C");
{
if (report_error > 0)
gfc_error ("Integer expression required at %C");
else if (report_error < 0)
gfc_error_now ("Integer expression required at %C");
return true;
}
if ((mpz_cmp_si (expr->value.integer, INT_MAX) > 0)
|| (mpz_cmp_si (expr->value.integer, INT_MIN) < 0))
{
return _("Integer value too large in expression at %C");
if (report_error > 0)
gfc_error ("Integer value too large in expression at %C");
else if (report_error < 0)
gfc_error_now ("Integer value too large in expression at %C");
return true;
}
*result = (int) mpz_get_si (expr->value.integer);
return NULL;
return false;
}

2
gcc/fortran/frontend-passes.c
View file

@ -1911,7 +1911,7 @@ optimize_minmaxloc (gfc_expr **e)
strcpy (name, fn->value.function.name);
p = strstr (name, "loc0");
p[3] = '1';
fn->value.function.name = gfc_get_string (name);
fn->value.function.name = gfc_get_string ("%s", name);
if (fn->value.function.actual->next)
{
a = fn->value.function.actual->next;

2
gcc/fortran/gfortran.h
View file

@ -3080,7 +3080,7 @@ void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
const char *gfc_extract_int (gfc_expr *, int *);
bool gfc_extract_int (gfc_expr *, int *, int = 0);
bool is_subref_array (gfc_expr *);
bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
bool gfc_check_init_expr (gfc_expr *);

8
gcc/fortran/intrinsic.c
View file

@ -333,11 +333,11 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
break;
case SZ_NOTHING:
next_sym->name = gfc_get_string (name);
next_sym->name = gfc_get_string ("%s", name);
strcpy (buf, "_gfortran_");
strcat (buf, name);
next_sym->lib_name = gfc_get_string (buf);
next_sym->lib_name = gfc_get_string ("%s", buf);
next_sym->pure = (cl != CLASS_IMPURE);
next_sym->elemental = (cl == CLASS_ELEMENTAL);
@ -884,7 +884,7 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name)
/* name may be a user-supplied string, so we must first make sure
that we're comparing against a pointer into the global string
table. */
const char *p = gfc_get_string (name);
const char *p = gfc_get_string ("%s", name);
while (n > 0)
{
@ -1153,7 +1153,7 @@ make_alias (const char *name, int standard)
case SZ_NOTHING:
next_sym[0] = next_sym[-1];
next_sym->name = gfc_get_string (name);
next_sym->name = gfc_get_string ("%s", name);
next_sym->standard = standard;
next_sym++;
break;

38
gcc/fortran/iresolve.c
View file

@ -47,15 +47,27 @@ const char *
gfc_get_string (const char *format, ...)
{
char temp_name[128];
const char *str;
va_list ap;
tree ident;
va_start (ap, format);
vsnprintf (temp_name, sizeof (temp_name), format, ap);
va_end (ap);
temp_name[sizeof (temp_name) - 1] = 0;
/* Handle common case without vsnprintf and temporary buffer. */
if (format[0] == '%' && format[1] == 's' && format[2] == '\0')
{
va_start (ap, format);
str = va_arg (ap, const char *);
va_end (ap);
}
else
{
va_start (ap, format);
vsnprintf (temp_name, sizeof (temp_name), format, ap);
va_end (ap);
temp_name[sizeof (temp_name) - 1] = 0;
str = temp_name;
}
ident = get_identifier (temp_name);
ident = get_identifier (str);
return IDENTIFIER_POINTER (ident);
}
@ -141,7 +153,7 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
}
}
f->value.function.name = gfc_get_string (name);
f->value.function.name = gfc_get_string ("%s", name);
}
@ -174,7 +186,7 @@ resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
f->value.function.name
= gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
gfc_type_letter (array->ts.type), array->ts.kind);
gfc_type_letter (array->ts.type), array->ts.kind);
}
@ -229,7 +241,7 @@ gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string)
static void
gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
const char *name)
bool is_achar)
{
f->ts.type = BT_CHARACTER;
f->ts.kind = (kind == NULL)
@ -237,16 +249,16 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
f->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
f->value.function.name = gfc_get_string (name, f->ts.kind,
gfc_type_letter (x->ts.type),
x->ts.kind);
f->value.function.name
= gfc_get_string ("__%schar_%d_%c%d", is_achar ? "a" : "", f->ts.kind,
gfc_type_letter (x->ts.type), x->ts.kind);
}
void
gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind)
{
gfc_resolve_char_achar (f, x, kind, "__achar_%d_%c%d");
gfc_resolve_char_achar (f, x, kind, true);
}
@ -536,7 +548,7 @@ gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
void
gfc_resolve_char (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
{
gfc_resolve_char_achar (f, a, kind, "__char_%d_%c%d");
gfc_resolve_char_achar (f, a, kind, false);
}

20
gcc/fortran/match.c
View file

@ -514,7 +514,6 @@ match
gfc_match_small_int (int *value)
{
gfc_expr *expr;
const char *p;
match m;
int i;
@ -522,15 +521,10 @@ gfc_match_small_int (int *value)
if (m != MATCH_YES)
return m;
p = gfc_extract_int (expr, &i);
if (gfc_extract_int (expr, &i, 1))
m = MATCH_ERROR;
gfc_free_expr (expr);
if (p != NULL)
{
gfc_error (p);
m = MATCH_ERROR;
}
*value = i;
return m;
}
@ -547,7 +541,6 @@ gfc_match_small_int (int *value)
match
gfc_match_small_int_expr (int *value, gfc_expr **expr)
{
const char *p;
match m;
int i;
@ -555,13 +548,8 @@ gfc_match_small_int_expr (int *value, gfc_expr **expr)
if (m != MATCH_YES)
return m;
p = gfc_extract_int (*expr, &i);
if (p != NULL)
{
gfc_error (p);
m = MATCH_ERROR;
}
if (gfc_extract_int (*expr, &i, 1))
m = MATCH_ERROR;
*value = i;
return m;

2
gcc/fortran/matchexp.c
View file

@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h"
#include "match.h"
static char expression_syntax[] = N_("Syntax error in expression at %C");
static const char expression_syntax[] = N_("Syntax error in expression at %C");
/* Match a user-defined operator name. This is a normal name with a

56
gcc/fortran/module.c
View file

@ -428,7 +428,7 @@ gfc_dt_lower_string (const char *name)
if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
return gfc_get_string ("%c%s", (char) TOLOWER ((unsigned char) name[0]),
&name[1]);
return gfc_get_string (name);
return gfc_get_string ("%s", name);
}
@ -443,7 +443,7 @@ gfc_dt_upper_string (const char *name)
if (name[0] != (char) TOUPPER ((unsigned char) name[0]))
return gfc_get_string ("%c%s", (char) TOUPPER ((unsigned char) name[0]),
&name[1]);
return gfc_get_string (name);
return gfc_get_string ("%s", name);
}
/* Call here during module reading when we know what pointer to
@ -594,7 +594,7 @@ gfc_match_use (void)
return m;
}
use_list->module_name = gfc_get_string (name);
use_list->module_name = gfc_get_string ("%s", name);
if (gfc_match_eos () == MATCH_YES)
goto done;
@ -774,7 +774,7 @@ gfc_match_submodule (void)
else
{
module_list = use_list;
use_list->module_name = gfc_get_string (name);
use_list->module_name = gfc_get_string ("%s", name);
use_list->submodule_name = use_list->module_name;
}
@ -963,9 +963,9 @@ find_true_name (const char *name, const char *module)
gfc_symbol sym;
int c;
t.name = gfc_get_string (name);
t.name = gfc_get_string ("%s", name);
if (module != NULL)
sym.module = gfc_get_string (module);
sym.module = gfc_get_string ("%s", module);
else
sym.module = NULL;
t.sym = &sym;
@ -1955,7 +1955,8 @@ mio_pool_string (const char **stringp)
else
{
require_atom (ATOM_STRING);
*stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string);
*stringp = (atom_string[0] == '\0'
? NULL : gfc_get_string ("%s", atom_string));
free (atom_string);
}
}
@ -2967,7 +2968,7 @@ mio_symtree_ref (gfc_symtree **stp)
{
p->u.rsym.sym = gfc_new_symbol (p->u.rsym.true_name,
gfc_current_ns);
p->u.rsym.sym->module = gfc_get_string (p->u.rsym.module);
p->u.rsym.sym->module = gfc_get_string ("%s", p->u.rsym.module);
}
p->u.rsym.symtree->n.sym = p->u.rsym.sym;
@ -3531,7 +3532,7 @@ mio_expr (gfc_expr **ep)
if (atom_string[0] == '\0')
e->value.function.name = NULL;
else
e->value.function.name = gfc_get_string (atom_string);
e->value.function.name = gfc_get_string ("%s", atom_string);
free (atom_string);
mio_integer (&flag);
@ -4166,13 +4167,13 @@ mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2,
q->u.pointer = (void *) ns;
sym = gfc_new_symbol (is_initializer ? "omp_priv" : "omp_out", ns);
sym->ts = udr->ts;
sym->module = gfc_get_string (p1->u.rsym.module);
sym->module = gfc_get_string ("%s", p1->u.rsym.module);
associate_integer_pointer (p1, sym);
sym->attr.omp_udr_artificial_var = 1;
gcc_assert (p2->u.rsym.sym == NULL);
sym = gfc_new_symbol (is_initializer ? "omp_orig" : "omp_in", ns);
sym->ts = udr->ts;
sym->module = gfc_get_string (p2->u.rsym.module);
sym->module = gfc_get_string ("%s", p2->u.rsym.module);
associate_integer_pointer (p2, sym);
sym->attr.omp_udr_artificial_var = 1;
if (mio_name (0, omp_declare_reduction_stmt) == 0)
@ -4514,7 +4515,7 @@ load_generic_interfaces (void)
if (!sym)
{
gfc_get_symbol (p, NULL, &sym);
sym->name = gfc_get_string (name);
sym->name = gfc_get_string ("%s", name);
sym->module = module_name;
sym->attr.flavor = FL_PROCEDURE;
sym->attr.generic = 1;
@ -4757,7 +4758,7 @@ load_omp_udrs (void)
memcpy (altname + 1, newname, len);
altname[len + 1] = '.';
altname[len + 2] = '\0';
name = gfc_get_string (altname);
name = gfc_get_string ("%s", altname);
}
st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name);
gfc_omp_udr *udr = gfc_omp_udr_find (st, &ts);
@ -4859,7 +4860,7 @@ load_needed (pointer_info *p)
sym = gfc_new_symbol (p->u.rsym.true_name, ns);
sym->name = gfc_dt_lower_string (p->u.rsym.true_name);
sym->module = gfc_get_string (p->u.rsym.module);
sym->module = gfc_get_string ("%s", p->u.rsym.module);
if (p->u.rsym.binding_label)
sym->binding_label = IDENTIFIER_POINTER (get_identifier
(p->u.rsym.binding_label));
@ -5234,12 +5235,13 @@ read_module (void)
gfc_current_ns);
info->u.rsym.sym->name = gfc_dt_lower_string (info->u.rsym.true_name);
sym = info->u.rsym.sym;
sym->module = gfc_get_string (info->u.rsym.module);
sym->module = gfc_get_string ("%s", info->u.rsym.module);
if (info->u.rsym.binding_label)
sym->binding_label =
IDENTIFIER_POINTER (get_identifier
(info->u.rsym.binding_label));
{
tree id = get_identifier (info->u.rsym.binding_label);
sym->binding_label = IDENTIFIER_POINTER (id);
}
}
st->n.sym = sym;
@ -6045,7 +6047,7 @@ dump_module (const char *name, int dump_flag)
char *filename, *filename_tmp;
uLong crc, crc_old;
module_name = gfc_get_string (name);
module_name = gfc_get_string ("%s", name);
if (dump_smod)
{
@ -6210,7 +6212,7 @@ create_intrinsic_function (const char *name, int id,
sym->attr.flavor = FL_PROCEDURE;
sym->attr.intrinsic = 1;
sym->module = gfc_get_string (modname);
sym->module = gfc_get_string ("%s", modname);
sym->attr.use_assoc = 1;
sym->from_intmod = module;
sym->intmod_sym_id = id;
@ -6250,7 +6252,7 @@ import_iso_c_binding_module (void)
mod_sym->attr.flavor = FL_MODULE;
mod_sym->attr.intrinsic = 1;
mod_sym->module = gfc_get_string (iso_c_module_name);
mod_sym->module = gfc_get_string ("%s", iso_c_module_name);
mod_sym->from_intmod = INTMOD_ISO_C_BINDING;
}
@ -6508,7 +6510,7 @@ create_int_parameter (const char *name, int value, const char *modname,
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
sym = tmp_symtree->n.sym;
sym->module = gfc_get_string (modname);
sym->module = gfc_get_string ("%s", modname);
sym->attr.flavor = FL_PARAMETER;
sym->ts.type = BT_INTEGER;
sym->ts.kind = gfc_default_integer_kind;
@ -6541,7 +6543,7 @@ create_int_parameter_array (const char *name, int size, gfc_expr *value,
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
sym = tmp_symtree->n.sym;
sym->module = gfc_get_string (modname);
sym->module = gfc_get_string ("%s", modname);
sym->attr.flavor = FL_PARAMETER;
sym->ts.type = BT_INTEGER;
sym->ts.kind = gfc_default_integer_kind;
@ -6582,7 +6584,7 @@ create_derived_type (const char *name, const char *modname,
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
sym = tmp_symtree->n.sym;
sym->module = gfc_get_string (modname);
sym->module = gfc_get_string ("%s", modname);
sym->from_intmod = module;
sym->intmod_sym_id = id;
sym->attr.flavor = FL_PROCEDURE;
@ -6592,12 +6594,12 @@ create_derived_type (const char *name, const char *modname,
gfc_get_sym_tree (gfc_dt_upper_string (sym->name),
gfc_current_ns, &tmp_symtree, false);
dt_sym = tmp_symtree->n.sym;
dt_sym->name = gfc_get_string (sym->name);
dt_sym->name = gfc_get_string ("%s", sym->name);
dt_sym->attr.flavor = FL_DERIVED;
dt_sym->attr.private_comp = 1;
dt_sym->attr.zero_comp = 1;
dt_sym->attr.use_assoc = 1;
dt_sym->module = gfc_get_string (modname);
dt_sym->module = gfc_get_string ("%s", modname);
dt_sym->from_intmod = module;
dt_sym->intmod_sym_id = id;
@ -6677,7 +6679,7 @@ use_iso_fortran_env_module (void)
mod_sym->attr.flavor = FL_MODULE;
mod_sym->attr.intrinsic = 1;
mod_sym->module = gfc_get_string (mod);
mod_sym->module = gfc_get_string ("%s", mod);
mod_sym->from_intmod = INTMOD_ISO_FORTRAN_ENV;
}
else

18
gcc/fortran/openmp.c
View file

@ -1025,12 +1025,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (m == MATCH_YES)
{
int collapse;
const char *p = gfc_extract_int (cexpr, &collapse);
if (p)
{
gfc_error_now (p);
collapse = 1;
}
if (gfc_extract_int (cexpr, &collapse, -1))
collapse = 1;
else if (collapse <= 0)
{
gfc_error_now ("COLLAPSE clause argument not"
@ -1485,12 +1481,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (m == MATCH_YES)
{
int ordered = 0;
const char *p = gfc_extract_int (cexpr, &ordered);
if (p)
{
gfc_error_now (p);
ordered = 0;
}
if (gfc_extract_int (cexpr, &ordered, -1))
ordered = 0;
else if (ordered <= 0)
{
gfc_error_now ("ORDERED clause argument not"
@ -2866,7 +2858,7 @@ gfc_match_omp_declare_reduction (void)
const char *predef_name = NULL;
omp_udr = gfc_get_omp_udr ();
omp_udr->name = gfc_get_string (name);
omp_udr->name = gfc_get_string ("%s", name);
omp_udr->rop = rop;
omp_udr->ts = tss[i];
omp_udr->where = where;

24
gcc/fortran/primary.c
View file

@ -41,7 +41,6 @@ match_kind_param (int *kind, int *is_iso_c)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
const char *p;
match m;
*is_iso_c = 0;
@ -68,8 +67,7 @@ match_kind_param (int *kind, int *is_iso_c)
if (sym->value == NULL)
return MATCH_NO;
p = gfc_extract_int (sym->value, kind);
if (p != NULL)
if (gfc_extract_int (sym->value, kind))
return MATCH_NO;
gfc_set_sym_referenced (sym);
@ -257,7 +255,6 @@ match_hollerith_constant (gfc_expr **result)
{
locus old_loc;
gfc_expr *e = NULL;
const char *msg;
int num, pad;
int i;
@ -270,12 +267,8 @@ match_hollerith_constant (gfc_expr **result)
if (!gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant at %C"))
goto cleanup;
msg = gfc_extract_int (e, &num);
if (msg != NULL)
{
gfc_error (msg);
goto cleanup;
}
if (gfc_extract_int (e, &num, 1))
goto cleanup;
if (num == 0)
{
gfc_error ("Invalid Hollerith constant: %L must contain at least "
@ -1017,7 +1010,6 @@ match_string_constant (gfc_expr **result)
locus old_locus, start_locus;
gfc_symbol *sym;
gfc_expr *e;
const char *q;
match m;
gfc_char_t c, delimiter, *p;
@ -1082,12 +1074,8 @@ match_string_constant (gfc_expr **result)
if (kind == -1)
{
q = gfc_extract_int (sym->value, &kind);
if (q != NULL)
{
gfc_error (q);
return MATCH_ERROR;
}
if (gfc_extract_int (sym->value, &kind, 1))
return MATCH_ERROR;
gfc_set_sym_referenced (sym);
}
@ -1659,7 +1647,7 @@ match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base)
}
}
actual->name = gfc_get_string (name);
actual->name = gfc_get_string ("%s", name);
return MATCH_YES;
cleanup:

31
gcc/fortran/simplify.c
View file

@ -127,7 +127,7 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
return -1;
}
if (gfc_extract_int (k, &kind) != NULL
if (gfc_extract_int (k, &kind)
|| gfc_validate_kind (type, kind, true) < 0)
{
gfc_error ("Invalid KIND parameter of %s at %L", name, &k->where);
@ -1499,7 +1499,7 @@ gfc_simplify_btest (gfc_expr *e, gfc_expr *bit)
if (e->expr_type != EXPR_CONSTANT || bit->expr_type != EXPR_CONSTANT)
return NULL;
if (gfc_extract_int (bit, &b) != NULL || b < 0)
if (gfc_extract_int (bit, &b) || b < 0)
return gfc_get_logical_expr (gfc_default_logical_kind, &e->where, false);
return gfc_get_logical_expr (gfc_default_logical_kind, &e->where,
@ -4234,7 +4234,6 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg)
{
gfc_expr *result;
int kind, arg, k;
const char *s;
if (i->expr_type != EXPR_CONSTANT)
return NULL;
@ -4244,8 +4243,8 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg)
return &gfc_bad_expr;
k = gfc_validate_kind (BT_INTEGER, kind, false);
s = gfc_extract_int (i, &arg);
gcc_assert (!s);
bool fail = gfc_extract_int (i, &arg);
gcc_assert (!fail);
result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
@ -4265,7 +4264,6 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
{
gfc_expr *result;
int kind, arg, k;
const char *s;
mpz_t z;
if (i->expr_type != EXPR_CONSTANT)
@ -4276,8 +4274,8 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
return &gfc_bad_expr;
k = gfc_validate_kind (BT_INTEGER, kind, false);
s = gfc_extract_int (i, &arg);
gcc_assert (!s);
bool fail = gfc_extract_int (i, &arg);
gcc_assert (!fail);
result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
@ -5060,7 +5058,6 @@ gfc_expr *
gfc_simplify_poppar (gfc_expr *e)
{
gfc_expr *popcnt;
const char *s;
int i;
if (e->expr_type != EXPR_CONSTANT)
@ -5069,8 +5066,8 @@ gfc_simplify_poppar (gfc_expr *e)
popcnt = gfc_simplify_popcnt (e);
gcc_assert (popcnt);
s = gfc_extract_int (popcnt, &i);
gcc_assert (!s);
bool fail = gfc_extract_int (popcnt, &i);
gcc_assert (!fail);
return gfc_get_int_expr (gfc_default_integer_kind, &e->where, i % 2);
}
@ -5282,8 +5279,8 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
(e->ts.u.cl->length &&
mpz_sgn (e->ts.u.cl->length->value.integer) != 0))
{
const char *res = gfc_extract_int (n, &ncop);
gcc_assert (res == NULL);
bool fail = gfc_extract_int (n, &ncop);
gcc_assert (!fail);
}
else
ncop = 0;
@ -5693,7 +5690,7 @@ gfc_simplify_selected_int_kind (gfc_expr *e)
{
int i, kind, range;
if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range) != NULL)
if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range))
return NULL;
kind = INT_MAX;
@ -5722,7 +5719,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
else
{
if (p->expr_type != EXPR_CONSTANT
|| gfc_extract_int (p, &precision) != NULL)
|| gfc_extract_int (p, &precision))
return NULL;
loc = &p->where;
}
@ -5732,7 +5729,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
else
{
if (q->expr_type != EXPR_CONSTANT
|| gfc_extract_int (q, &range) != NULL)
|| gfc_extract_int (q, &range))
return NULL;
if (!loc)
@ -5744,7 +5741,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
else
{
if (rdx->expr_type != EXPR_CONSTANT
|| gfc_extract_int (rdx, &radix) != NULL)
|| gfc_extract_int (rdx, &radix))
return NULL;
if (!loc)

18
gcc/fortran/symbol.c
View file

@ -2149,7 +2149,7 @@ gfc_add_component (gfc_symbol *sym, const char *name,
else
tail->next = p;
p->name = gfc_get_string (name);
p->name = gfc_get_string ("%s", name);
p->loc = gfc_current_locus;
p->ts.type = BT_UNKNOWN;
@ -2756,7 +2756,7 @@ gfc_new_symtree (gfc_symtree **root, const char *name)
gfc_symtree *st;
st = XCNEW (gfc_symtree);
st->name = gfc_get_string (name);
st->name = gfc_get_string ("%s", name);
gfc_insert_bbt (root, st, compare_symtree);
return st;
@ -2772,7 +2772,7 @@ gfc_delete_symtree (gfc_symtree **root, const char *name)
st0 = gfc_find_symtree (*root, name);
st.name = gfc_get_string (name);
st.name = gfc_get_string ("%s", name);
gfc_delete_bbt (root, &st, compare_symtree);
free (st0);
@ -2834,7 +2834,7 @@ gfc_get_uop (const char *name)
st = gfc_new_symtree (&ns->uop_root, name);
uop = st->n.uop = XCNEW (gfc_user_op);
uop->name = gfc_get_string (name);
uop->name = gfc_get_string ("%s", name);
uop->access = ACCESS_UNKNOWN;
uop->ns = ns;
@ -2955,7 +2955,7 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
if (strlen (name) > GFC_MAX_SYMBOL_LEN)
gfc_internal_error ("new_symbol(): Symbol name too long");
p->name = gfc_get_string (name);
p->name = gfc_get_string ("%s", name);
/* Make sure flags for symbol being C bound are clear initially. */
p->attr.is_bind_c = 0;
@ -4146,7 +4146,7 @@ gfc_get_gsymbol (const char *name)
s = XCNEW (gfc_gsymbol);
s->type = GSYM_UNKNOWN;
s->name = gfc_get_string (name);
s->name = gfc_get_string ("%s", name);
gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare);
@ -4609,7 +4609,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
}
/* Say what module this symbol belongs to. */
tmp_sym->module = gfc_get_string (mod_name);
tmp_sym->module = gfc_get_string ("%s", mod_name);
tmp_sym->from_intmod = INTMOD_ISO_C_BINDING;
tmp_sym->intmod_sym_id = s;
tmp_sym->attr.is_iso_c = 1;
@ -4706,7 +4706,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
gfc_get_sym_tree (hidden_name, gfc_current_ns, &tmp_symtree, false);
dt_sym = tmp_symtree->n.sym;
dt_sym->name = gfc_get_string (s == ISOCBINDING_PTR
? "c_ptr" : "c_funptr");
? "c_ptr" : "c_funptr");
/* Generate an artificial generic function. */
head = tmp_sym->generic;
@ -4726,7 +4726,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
}
/* Say what module this symbol belongs to. */
dt_sym->module = gfc_get_string (mod_name);
dt_sym->module = gfc_get_string ("%s", mod_name);
dt_sym->from_intmod = INTMOD_ISO_C_BINDING;
dt_sym->intmod_sym_id = s;
dt_sym->attr.use_assoc = 1;

2
gcc/fortran/trans-decl.c
View file

@ -4649,7 +4649,7 @@ gfc_find_module (const char *name)
{
module_htab_entry *entry = ggc_cleared_alloc<module_htab_entry> ();
entry->name = gfc_get_string (name);
entry->name = gfc_get_string ("%s", name);
entry->decls = hash_table<module_decl_hasher>::create_ggc (10);
*slot = entry;
}

4
gcc/fortran/trans-stmt.c
View file

@ -5883,8 +5883,8 @@ gfc_trans_allocate (gfc_code * code)
newsym = XCNEW (gfc_symtree);
/* The name of the symtree should be unique, because gfc_create_var ()
took care about generating the identifier. */
newsym->name = gfc_get_string (IDENTIFIER_POINTER (
DECL_NAME (expr3)));
newsym->name
= gfc_get_string ("%s", IDENTIFIER_POINTER (DECL_NAME (expr3)));
newsym->n.sym = gfc_new_symbol (newsym->name, NULL);
/* The backend_decl is known. It is expr3, which is inserted
here. */