It helps to attach the patch!

Paul

On Sun, 13 Sept 2026 at 14:48, Paul Richard Thomas
<[email protected]> wrote:
>
> Hello All,
>
> The attached patch speaks for itself and psses regression testing on
> FC44/x86_64.
>
> OK for mainline and later for 16-branch?
>
> Cheers
>
> Paul
From ce620aabff10acdd11a1d44e52a47333806813c6 Mon Sep 17 00:00:00 2001
From: Paul Thomas <[email protected]>
Date: Sun, 13 Sep 2026 12:32:22 +0100
Subject: [PATCH] Fortran: Parameterized derived type component initialization
 [PR104776]

2026-09-13  Paul Thomas  <[email protected]>

gcc/fortran
	PR fortran/104776
	* decl.cc (gfc_get_pdt_instance): Simplify the initializers of
	KIND components in PDT templates since they must be integer
	constants. Catch any remaining component initializers for
	parameter substitution, if necessary, and simplification.

gcc/testsuite
	PR fortran/104776
	* gfortran.dg/pdt_94.f03: New test.
---
 gcc/fortran/decl.cc                  | 17 ++++++++++
 gcc/testsuite/gfortran.dg/pdt_94.f03 | 49 ++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pdt_94.f03

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 4871737458e..3eb660a93d4 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4503,6 +4503,11 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	      c2->param_list->next = NULL;
 	    }
 
+	  /* Initializer expressions in PDT templates, such as character_kinds(1),
+	     can end up being mutilated when use associated. Simplify now.  */
+	  if (c1->initializer && c1->initializer->expr_type != EXPR_CONSTANT)
+	    gfc_simplify_expr (c1->initializer, 1);
+
 	  if (!c2->initializer && c1->initializer)
 	    c2->initializer = gfc_copy_expr (c1->initializer);
 
@@ -4655,6 +4660,18 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	    }
 	  gfc_simplify_expr (c2->initializer, 1);
 	}
+
+      /* Pick up any remaining initializers that could be simplified.  */
+      if (c1->initializer)
+	{
+	  if (!c2->initializer)
+	    c2->initializer = gfc_copy_expr (c1->initializer);
+	  if (gfc_derived_parameter_expr (c2->initializer))
+	    gfc_insert_parameter_exprs (c2->initializer, type_param_spec_list);
+	  c2->initializer->ts = c2->ts;
+	  if (!!gfc_is_constant_expr (c2->initializer))
+	    gfc_simplify_expr (c2->initializer, 1);
+	}
     }
 
   if (alloc_seen)
diff --git a/gcc/testsuite/gfortran.dg/pdt_94.f03 b/gcc/testsuite/gfortran.dg/pdt_94.f03
new file mode 100644
index 00000000000..970fbb614ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_94.f03
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! Test the fix for PR104776.
+!
+! Contributed by Amir Shahmoradi  <[email protected]>
+!
+module pdt_mod
+
+    use iso_fortran_env, only: character_kinds
+
+    integer, parameter :: def_kind = selected_char_kind('ascii')
+    integer, parameter :: unicode_kind = selected_char_kind('ISO_10646')
+    character(kind=unicode_kind,len=*), parameter :: str = 'abcde'
+
+    type                    :: BG_type(kind_p)
+! This is still failing.
+        integer     , kind  :: kind_p = character_kinds(1)
+!        integer     , kind  :: kind_p = def_kind
+        character(5 , kind_p) :: str = achar(97,kind_p)//achar(98,kind_p)// &
+                                       achar(99,kind_p)//achar(100,kind_p)//achar(101,kind_p)
+    end type
+
+! These declarations worked as expected
+!    type (BG_type) :: a_m = BG_type (def_kind)("abcde")
+!    type (BG_type(selected_char_kind('ISO_10646'))) :: b_m = BG_type (selected_char_kind('ISO_10646'))(str)
+! Now so do these
+    type (BG_type) :: a_m
+    type (BG_type(unicode_kind)) :: b_m
+
+contains
+    subroutine print_mod_vars ()
+       if (a_m%str /= 'abcde') stop 1
+       if (b_m%str /= str) stop 2
+    end
+end module
+
+  use pdt_mod
+  type (BG_type) :: a  ! Caused an ICE
+  type (BG_type(unicode_kind)) :: b
+  a_m = BG_type (def_kind)("abcde")
+  b_m = BG_type (unicode_kind)(str)
+  if (a%str%kind /= def_kind) stop 3
+  if (b%str%kind /= unicode_kind) stop 4
+  if (a%str /= 'abcde') stop 5
+  if (b%str /= str) stop 6
+  if (a_m%str /= 'abcde') stop 7
+  if (b_m%str /= str) stop 8
+  call print_mod_vars ()
+end
-- 
2.55.0

Reply via email to