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

1 files changed, 25 insertions, 13 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 5c3ad42..f5a4462 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);
 }