Hi Jakub,
Yes, of course - OK for trunk.
Thanks
Paul
On 20 January 2017 at 23:32, Jakub Jelinek <ja...@redhat.com> wrote:
> Hi!
>
> The Fortran FE has huge amounts of -Wformat-security warnings everywhere,
> but in the end they are only a result of a few commonly used things:
> 1) gfc_get_string uses a printf-like format string, so calling it with
> a variable is something -Wformat-security warns about (and would be a bad bug
> if the string passed to it could ever contain any % characters);
> fixed by using gfc_get_string ("%s", x) instead and optimizing that
> as a common case so that it doesn't go through a temporary buffer in that
> case
> 2) gfc_extract_int used to return a _("...") string including formatting
> characters that didn't consume any va_arg and callers optionally passed
> that to gfc_error{,_now}. This e.g. means a second attempt to translate the
> string (something that could be easily fixed just by using N_("...")
> instead), but is really -Wformat-security unfriendly; fixed by moving
> that gfc_error{,_now} into gfc_extract_int and just pass it an extra
> argument whether error should be reported (and which) or not; the return
> value is then just a bool whether it failed
> 3) pp_verbatim is yet another function with formatting string, had to use
> "%s", ...
> 4) expression_syntax variable wasn't const (even when it isn't actually
> modified), so -Wformat-security couldn't verify it
>
> Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk?
>
> 2017-01-20 Jakub Jelinek <ja...@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.
>
> --- gcc/fortran/gfortran.h.jj 2017-01-16 12:28:34.000000000 +0100
> +++ gcc/fortran/gfortran.h 2017-01-20 13:50:58.889709470 +0100
> @@ -3080,7 +3080,7 @@ void gfc_resolve_oacc_blocks (gfc_code *
> /* 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 *);
> --- gcc/fortran/decl.c.jj 2017-01-09 22:46:03.000000000 +0100
> +++ gcc/fortran/decl.c 2017-01-20 14:04:11.043623360 +0100
> @@ -2540,7 +2540,6 @@ gfc_match_kind_spec (gfc_typespec *ts, b
> 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_is
> 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_is
> 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 *
>
> /* 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_
> 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;
> --- gcc/fortran/trans-stmt.c.jj 2017-01-19 16:58:24.000000000 +0100
> +++ gcc/fortran/trans-stmt.c 2017-01-20 13:46:42.466980848 +0100
> @@ -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. */
> --- gcc/fortran/module.c.jj 2017-01-16 12:28:34.000000000 +0100
> +++ gcc/fortran/module.c 2017-01-20 13:40:32.368702470 +0100
> @@ -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
> 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_
> 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_
> 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 *n
> 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,
> 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 *
> 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, c
>
> 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, c
> 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
> --- gcc/fortran/error.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/error.c 2017-01-20 13:01:43.909496065 +0100
> @@ -1089,7 +1089,7 @@ gfc_diagnostic_starter (diagnostic_conte
> }
> 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_co
> {
> 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. */
> --- gcc/fortran/match.c.jj 2017-01-16 12:28:34.000000000 +0100
> +++ gcc/fortran/match.c 2017-01-20 13:57:58.399363629 +0100
> @@ -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, gf
> 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;
> --- gcc/fortran/iresolve.c.jj 2017-01-16 12:28:34.000000000 +0100
> +++ gcc/fortran/iresolve.c 2017-01-20 14:09:12.479788903 +0100
> @@ -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 *ar
> }
> }
>
> - 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 *na
>
> 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_ex
>
> 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
> 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_ex
> 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);
> }
>
>
> --- gcc/fortran/expr.c.jj 2017-01-16 12:28:34.000000000 +0100
> +++ gcc/fortran/expr.c 2017-01-20 13:52:36.381465694 +0100
> @@ -611,28 +611,44 @@ gfc_replace_expr (gfc_expr *dest, gfc_ex
>
>
> /* 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;
> }
>
>
> --- gcc/fortran/arith.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/arith.c 2017-01-20 13:53:34.535723777 +0100
> @@ -875,7 +875,7 @@ arith_power (gfc_expr *op1, gfc_expr *op
> /* 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. */
> --- gcc/fortran/symbol.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/symbol.c 2017-01-20 13:45:21.312016203 +0100
> @@ -2149,7 +2149,7 @@ gfc_add_component (gfc_symbol *sym, cons
> 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, con
> 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,
>
> 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_na
> 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
> }
>
> /* 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
> 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
> }
>
> /* 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;
> --- gcc/fortran/openmp.c.jj 2017-01-09 22:46:03.000000000 +0100
> +++ gcc/fortran/openmp.c 2017-01-20 13:59:05.058515683 +0100
> @@ -1025,12 +1025,8 @@ gfc_match_omp_clauses (gfc_omp_clauses *
> 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 *
> 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;
> --- gcc/fortran/check.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/check.c 2017-01-20 13:54:31.850992563 +0100
> @@ -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),
> --- gcc/fortran/intrinsic.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/intrinsic.c 2017-01-20 13:06:46.612609303 +0100
> @@ -333,11 +333,11 @@ add_sym (const char *name, gfc_isym_id i
> 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
> /* 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 standa
>
> 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;
> --- gcc/fortran/simplify.c.jj 2017-01-16 12:28:34.000000000 +0100
> +++ gcc/fortran/simplify.c 2017-01-20 14:02:37.140817863 +0100
> @@ -127,7 +127,7 @@ get_kind (bt type, gfc_expr *k, const ch
> 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_exp
> 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_exp
> {
> 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_exp
> 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_exp
> {
> 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_exp
> 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_ex
> (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
> {
> 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_exp
> 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_exp
> 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_exp
> else
> {
> if (rdx->expr_type != EXPR_CONSTANT
> - || gfc_extract_int (rdx, &radix) != NULL)
> + || gfc_extract_int (rdx, &radix))
> return NULL;
>
> if (!loc)
> --- gcc/fortran/trans-decl.c.jj 2017-01-19 16:58:24.000000000 +0100
> +++ gcc/fortran/trans-decl.c 2017-01-20 13:45:50.289646513 +0100
> @@ -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;
> }
> --- gcc/fortran/matchexp.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/matchexp.c 2017-01-20 13:26:47.594231806 +0100
> @@ -25,7 +25,7 @@ along with GCC; see the file COPYING3.
> #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
> --- gcc/fortran/primary.c.jj 2017-01-19 16:58:24.000000000 +0100
> +++ gcc/fortran/primary.c 2017-01-20 14:00:04.305762021 +0100
> @@ -41,7 +41,6 @@ match_kind_param (int *kind, int *is_iso
> {
> 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
> 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 **res
> {
> locus old_loc;
> gfc_expr *e = NULL;
> - const char *msg;
> int num, pad;
> int i;
>
> @@ -270,12 +267,8 @@ match_hollerith_constant (gfc_expr **res
> 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 *a
> }
> }
>
> - actual->name = gfc_get_string (name);
> + actual->name = gfc_get_string ("%s", name);
> return MATCH_YES;
>
> cleanup:
> --- gcc/fortran/frontend-passes.c.jj 2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/frontend-passes.c 2017-01-20 13:15:00.119282521 +0100
> @@ -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;
>
> Jakub
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
