[Patch, fortran] PR115315 - [PDT] valgrind error in gfc_simplify_expr

[Paul Richard Thomas]

Hello All,

This looks to be a regression in that the error emitted by all current
versions of gfortran:

rm: cannot remove '*.original': No such file or directory
pr115315.f90:21:25:

   21 |     integer :: c2(iachar('ABCDEFGHIJ'(n1:n1)))
      |                         1
Error: Argument of IACHAR at (1) must be of length one
pr115315.f90:21:25:

   21 |     integer :: c2(iachar('ABCDEFGHIJ'(n1:n1)))
      |                         1
Error: Argument of IACHAR at (1) must be of length one
bash: ./a.out: No such file or directory

is invalid and not reported in the PR. Even if it is not a regression,
it is a trivial fix for the above error. As far as I can see, the
valgrind error has gone.

Regtests on FC43/x86_64 - OK for mainline?

The patch does not apply to 15-branch because of the changes to
decl.cc but can be made to do if backporting is desired.

Paul

Change.Logs
Description: Binary data

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d8aa7d1c06f..454b65f2c47 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -3931,14 +3931,13 @@ insert_parameter_exprs (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED,
       || (e->expr_type == EXPR_FUNCTION && e->symtree->n.sym))
     {
       for (param = type_param_spec_list; param; param = param->next)
-	if (strcmp (e->symtree->n.sym->name, param->name) == 0)
+	if (!strcmp (e->symtree->n.sym->name, param->name))
 	  break;
 
       if (param && param->expr)
 	{
 	  copy = gfc_copy_expr (param->expr);
-	  *e = *copy;
-	  free (copy);
+	  gfc_replace_expr (e, copy);
 	  /* Catch variables declared without a value expression.  */
 	  if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_PROCEDURE)
 	    e->ts = e->symtree->n.sym->ts;
@@ -4456,14 +4455,16 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	      gfc_expr *e;
 	      e = gfc_copy_expr (c1->as->lower[i]);
 	      gfc_insert_kind_parameter_exprs (e);
-	      gfc_simplify_expr (e, 1);
-	      gfc_free_expr (c2->as->lower[i]);
-	      c2->as->lower[i] = e;
+	      if (gfc_simplify_expr (e, 1))
+		gfc_replace_expr (c2->as->lower[i], e);
+	      else
+		gfc_free_expr (e);
 	      e = gfc_copy_expr (c1->as->upper[i]);
 	      gfc_insert_kind_parameter_exprs (e);
-	      gfc_simplify_expr (e, 1);
-	      gfc_free_expr (c2->as->upper[i]);
-	      c2->as->upper[i] = e;
+	      if (gfc_simplify_expr (e, 1))
+		gfc_replace_expr (c2->as->upper[i], e);
+	      else
+		gfc_free_expr (e);
 	    }
 
 	  c2->attr.pdt_array = 1;
@@ -4483,9 +4484,10 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	  gfc_expr *e;
 	  e = gfc_copy_expr (c1->ts.u.cl->length);
 	  gfc_insert_kind_parameter_exprs (e);
-	  gfc_simplify_expr (e, 1);
-	  gfc_free_expr (c2->ts.u.cl->length);
-	  c2->ts.u.cl->length = e;
+	  if (gfc_simplify_expr (e, 1))
+	    gfc_replace_expr (c2->ts.u.cl->length, e);
+	  else
+	    gfc_free_expr (e);
 	  c2->attr.pdt_string = 1;
 	}
 
@@ -4530,7 +4532,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 		  if (!s)
 		    gfc_insert_parameter_exprs (c2->initializer,
 						type_param_spec_list);
-		  gfc_simplify_expr (params->expr, 1);
+		  gfc_simplify_expr (c2->initializer, 1);
 		}
 	    }
 
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index fa5aeced2f3..791474b1524 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -2506,6 +2506,9 @@ gfc_simplify_expr (gfc_expr *p, int type)
 	      start--;  /* Convert from one-based to zero-based.  */
 	    }
 
+	  if (start < 0)
+	    return false;
+
 	  end = p->value.character.length;
 	  if (p->ref && p->ref->u.ss.end)
 	    gfc_extract_hwi (p->ref->u.ss.end, &end);