+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
/* 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. */
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),
gfc_expr *e;
match m, n;
char c;
- const char *msg;
m = MATCH_NO;
n = MATCH_YES;
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;
}
locus where;
gfc_expr *e;
match m, n;
- const char *msg;
+ bool fail;
m = MATCH_NO;
e = NULL;
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;
}
/* 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;
/* 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;
{
/* 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;
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;
}
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);
{
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. */
/* 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;
}
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;
/* 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 *);
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);
/* 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)
{
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;
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);
}
}
}
- f->value.function.name = gfc_get_string (name);
+ f->value.function.name = gfc_get_string ("%s", name);
}
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);
}
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)
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);
}
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);
}
gfc_match_small_int (int *value)
{
gfc_expr *expr;
- const char *p;
match m;
int i;
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;
}
match
gfc_match_small_int_expr (int *value, gfc_expr **expr)
{
- const char *p;
match m;
int i;
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;
#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
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);
}
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
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;
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;
}
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;
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);
}
}
{
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;
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);
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)
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;
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);
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));
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;
char *filename, *filename_tmp;
uLong crc, crc_old;
- module_name = gfc_get_string (name);
+ module_name = gfc_get_string ("%s", name);
if (dump_smod)
{
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;
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;
}
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;
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;
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;
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;
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
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"
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"
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;
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
- const char *p;
match m;
*is_iso_c = 0;
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);
{
locus old_loc;
gfc_expr *e = NULL;
- const char *msg;
int num, pad;
int i;
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 "
locus old_locus, start_locus;
gfc_symbol *sym;
gfc_expr *e;
- const char *q;
match m;
gfc_char_t c, delimiter, *p;
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);
}
}
}
- actual->name = gfc_get_string (name);
+ actual->name = gfc_get_string ("%s", name);
return MATCH_YES;
cleanup:
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);
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,
{
gfc_expr *result;
int kind, arg, k;
- const char *s;
if (i->expr_type != EXPR_CONSTANT)
return NULL;
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);
{
gfc_expr *result;
int kind, arg, k;
- const char *s;
mpz_t z;
if (i->expr_type != EXPR_CONSTANT)
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);
gfc_simplify_poppar (gfc_expr *e)
{
gfc_expr *popcnt;
- const char *s;
int i;
if (e->expr_type != EXPR_CONSTANT)
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);
}
(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;
{
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;
else
{
if (p->expr_type != EXPR_CONSTANT
- || gfc_extract_int (p, &precision) != NULL)
+ || gfc_extract_int (p, &precision))
return NULL;
loc = &p->where;
}
else
{
if (q->expr_type != EXPR_CONSTANT
- || gfc_extract_int (q, &range) != NULL)
+ || gfc_extract_int (q, &range))
return NULL;
if (!loc)
else
{
if (rdx->expr_type != EXPR_CONSTANT
- || gfc_extract_int (rdx, &radix) != NULL)
+ || gfc_extract_int (rdx, &radix))
return NULL;
if (!loc)
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;
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;
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);
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;
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;
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);
}
/* 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;
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;
}
/* 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;
{
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;
}
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. */
projects / gcc.git / commitdiff