From: Jakub Jelinek Date: Sat, 21 Jan 2017 10:30:54 +0000 (+0100) Subject: gfortran.h (gfc_extract_int): Change return type to bool. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=51f03c6b11a46d756ae05c67e34cca2ccb4fafaa;p=gcc.git gfortran.h (gfc_extract_int): Change return type to bool. * 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ca6ac2a9bd9..5382696a175 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,65 @@ +2017-01-21 Jakub Jelinek + + * 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 PR fortran/70696 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 86d88f19eb7..9d14487237f 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -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. */ diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index e936a934975..c22bfa965eb 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -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), diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 41acc94a0f4..a92e06aa6fc 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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; diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 47b7a710481..ccf0be019e2 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -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. */ diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 7b95d206c53..f90bdc39876 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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; } diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index e072b27df25..b255e98af31 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index f01a290e28f..814ce7847c8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 *); diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 86896a02883..e059a312dfd 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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; diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 5c3ad42990b..f5a44623946 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -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); } diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index ea9d315d7cf..003a0434eb0 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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; diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index 7b681760c3a..978702b3a2a 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -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 diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index b3b09672aca..5515fed4ab4 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -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 diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 16b75fda3af..d19ee948330 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -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; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 02e6dc17415..d7fc6c41b03 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -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: diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 942b4015447..8ffe75a4a46 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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) diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index af9bf13910b..9afa6d029f3 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5d246cd5624..3e54e80a69a 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4649,7 +4649,7 @@ gfc_find_module (const char *name) { module_htab_entry *entry = ggc_cleared_alloc (); - entry->name = gfc_get_string (name); + entry->name = gfc_get_string ("%s", name); entry->decls = hash_table::create_ggc (10); *slot = entry; } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 113545b8554..ad4b7373a21 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -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. */