From: Paul Thomas <pault@gcc.gnu.org>
Date: Mon, 16 Mar 2026 08:20:20 +0000 (+0000)
Subject: Fortran: Regression in gfc_convert_to_structure_constructor [PR93832]
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=37950565de34d53cbdeb6ff33cc4792a2a7a0696;p=thirdparty%2Fgcc.git

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 87b37c8a5dd..705ff17439b 100644
--- 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 9251f88d6d6..2ca2c4744bb 100644
--- 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
index 00000000000..ca8b4abaa9f
--- /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