Fortran: Minor PDT cleanup and fix in gfc_simplify_exp [PR115315]

2026-03-26  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/115315
	* decl.cc (insert_parameter_exprs): Make strcmp condition more
	concise.
	(gfc_get_pdt_instance): Use gf_replace_expr where possible and
	use return value of gfc_simplify_expr. Correct error in which
	params->expr was being simplified instead of c2->initializer.
	* expr.cc (gfc_simplify_expr): If the substring 'start' value
	is less than zero, it is clearly out of range and so return
	false.

gcc/testsuite/
	PR fortran/115315
	* gfortran.dg/pdt_90.f03: New test.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d8aa7d1c06f7f8cda5b365fdb19c2b8af1acf069..454b65f2c47a5b6b5130944c762c87643f689a94 100644 (file)
--- 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 fa5aeced2f36e8052dd2c41cd1d2be748e8a6101..791474b1524263bf379c4c0bb79881aae4b86214 100644 (file)
--- 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);

diff --git a/gcc/testsuite/gfortran.dg/pdt_90.f03 b/gcc/testsuite/gfortran.dg/pdt_90.f03
new file mode 100644 (file)
index 0000000..af60b5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_90.f03
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Check the fix for PR115315.f90 in which line 14 caused the error,
+! "Argument of IACHAR at (1) must be of length one".
+!
+! Contributed by David Binderman  <dcb314@hotmail.com>
+!
+  call p2
+contains
+  subroutine p2
+    type t1(n1,n2)
+      integer,kind :: n1,n2
+      integer :: c2(iachar('ABCDEFGHIJ'(n1:n2)))
+    end type
+
+    type(t1(4,4)) :: x
+    if (char (size (x%c2, 1)) .ne. "D") then
+      print *, "Wrong!"
+    else
+      print *, "Right"
+    endif
+  end
+end
+! { dg-final { scan-tree-dump-times "Wrong" 0 "original" } }
+! { dg-final { scan-tree-dump-times "Right" 1 "original" } }