Fortran: Regression in gfc_convert_to_structure_constructor [PR93832]

2026-03-16  Paul Thomas  <pault@gcc.gnu.org>
	    Steve Kargl  <kargls@comcast.net>

gcc/fortran
	PR fortran/93832
	* array.cc (resolve_array_bound): Emit error and return false
	if bound expression is derived type or class.
	* primary.cc (gfc_convert_to_structure_constructor): Do not
	dereference NULL in character component test. Define 'shorter'
	and use it help cure one of several whitespace issues.

gcc/testsuite/
	PR fortran/93832
	* gfortran.dg/pr93832.f90: New test.

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 87b37c8a5ddb50b1ae691e4615ca80a81d1b1ff2..705ff17439bc57998066468e8b2980134e190be6 100644 (file)
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -471,6 +471,13 @@ resolve_array_bound (gfc_expr *e, int check_constant)
   if (e == NULL)
     return true;
 
+  if (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
+    {
+      gfc_error ("Derived type or class expression for array bound at %L",
+                &e->where);
+      return false;
+    }
+
   if (!gfc_resolve_expr (e)
       || !gfc_specification_expr (e))
     return false;

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 9251f88d6d6a3caa606fd2d46672ddda803c9d67..2ca2c4744bbc04def9016c3498545861aa5ec584 100644 (file)
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -3604,6 +3604,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
          && this_comp->ts.u.cl && this_comp->ts.u.cl->length
          && this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
          && this_comp->ts.u.cl->length->ts.type == BT_INTEGER
+         && actual->expr
          && actual->expr->ts.type == BT_CHARACTER
          && actual->expr->expr_type == EXPR_CONSTANT)
        {
@@ -3668,27 +3669,27 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
          goto cleanup;
        }
 
-          /* If not explicitly a parent constructor, gather up the components
-             and build one.  */
-          if (comp && comp == sym->components
-                && sym->attr.extension
-               && comp_tail->val
-                && (!gfc_bt_struct (comp_tail->val->ts.type)
-                      ||
-                    comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
-            {
-              bool m;
+         /* If not explicitly a parent constructor, gather up the components
+            and build one.  */
+         if (comp && comp == sym->components
+             && sym->attr.extension
+             && comp_tail->val
+             && (!gfc_bt_struct (comp_tail->val->ts.type)
+                 || comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
+           {
+             bool m;
              gfc_actual_arglist *arg_null = NULL;
 
              actual->expr = comp_tail->val;
              comp_tail->val = NULL;
+#define shorter gfc_convert_to_structure_constructor
+             m = shorter (NULL, comp->ts.u.derived, &comp_tail->val,
+                          comp->ts.u.derived->attr.zero_comp ? &arg_null :
+                                                               &actual, true);
+#undef shorter
 
-              m = gfc_convert_to_structure_constructor (NULL,
-                                       comp->ts.u.derived, &comp_tail->val,
-                                       comp->ts.u.derived->attr.zero_comp
-                                         ? &arg_null : &actual, true);
-              if (!m)
-                goto cleanup;
+             if (!m)
+               goto cleanup;
 
              if (comp->ts.u.derived->attr.zero_comp)
                {

diff --git a/gcc/testsuite/gfortran.dg/pr93832.f90 b/gcc/testsuite/gfortran.dg/pr93832.f90
new file mode 100644 (file)
index 0000000..ca8b4ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93832.f90
@@ -0,0 +1,37 @@
+module m
+contains
+   subroutine comment0
+      type t
+         character :: a
+         integer :: b
+         integer :: c(t(1))            ! { dg-error "No initializer for component .b." }
+      end type
+      type(t) :: z = t('a', 2, [3])    ! { dg-error "Bad array spec of component .c." }
+   end
+
+   subroutine comment3a
+      type t
+         character :: a
+         integer :: b
+         integer :: c(t(1, "rubbish")) ! { dg-error "No initializer for component .c." }
+      end type
+      type(t) :: z = t('a', 2, [3])    ! { dg-error "Bad array spec of component .c." }
+   end
+
+   subroutine comment3b
+      type t
+         character :: a
+         integer :: b
+         integer :: c(t(1, "rubbish", [7])) ! { dg-error "Derived type or class expression" }
+      end type
+      type(t) :: z = t('a', 2, [3])    ! { dg-error "Bad array spec of component .c." }
+   end
+
+   subroutine comment9
+      type t
+         character :: a
+         integer :: b(t(1))            ! { dg-error "No initializer for component .b." }
+      end type
+      type(t) :: x = t('a', 2)
+   end
+end module