This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] Fix Fortran FE -Wformat-security warnings


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  <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.

--- 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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]