https://gcc.gnu.org/g:4983e9745edae3807243693e8865835b45f08c95
commit r16-5045-g4983e9745edae3807243693e8865835b45f08c95 Author: Paul Thomas <[email protected]> Date: Wed Nov 5 12:17:10 2025 +0000 Fortran: Add non-PDT type extension to PDTs [PR122566] 2025-11-05 Paul Thomas <[email protected]> gcc/fortran PR fortran/122566 * decl.cc (gfc_get_pdt_instance): Add non-PDT type exstention. gcc/testsuite/ PR fortran/122566 * gfortran.dg/pdt_68.f03: New test. Diff: --- gcc/fortran/decl.cc | 44 ++++++++++++++++++++---------------- gcc/testsuite/gfortran.dg/pdt_68.f03 | 34 ++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+), 19 deletions(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 5b222cd0ce51..96ee6bf7b686 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -4191,30 +4191,36 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, to obtain the instance of the extended type. */ if (gfc_current_state () != COMP_DERIVED && c1 == pdt->components - && (c1->ts.type == BT_DERIVED || c1->ts.type == BT_CLASS) - && c1->ts.u.derived && c1->ts.u.derived->attr.pdt_template + && c1->ts.type == BT_DERIVED + && c1->ts.u.derived && gfc_get_derived_super_type (*sym) == c2->ts.u.derived) { - gfc_formal_arglist *f; + if (c1->ts.u.derived->attr.pdt_template) + { + gfc_formal_arglist *f; - old_param_spec_list = type_param_spec_list; + old_param_spec_list = type_param_spec_list; - /* Obtain a spec list appropriate to the extended type..*/ - actual_param = gfc_copy_actual_arglist (type_param_spec_list); - type_param_spec_list = actual_param; - for (f = c1->ts.u.derived->formal; f && f->next; f = f->next) - actual_param = actual_param->next; - if (actual_param) - { - gfc_free_actual_arglist (actual_param->next); - actual_param->next = NULL; - } + /* Obtain a spec list appropriate to the extended type..*/ + actual_param = gfc_copy_actual_arglist (type_param_spec_list); + type_param_spec_list = actual_param; + for (f = c1->ts.u.derived->formal; f && f->next; f = f->next) + actual_param = actual_param->next; + if (actual_param) + { + gfc_free_actual_arglist (actual_param->next); + actual_param->next = NULL; + } - /* Now obtain the PDT instance for the extended type. */ - c2->param_list = type_param_spec_list; - m = gfc_get_pdt_instance (type_param_spec_list, &c2->ts.u.derived, - &c2->param_list); - type_param_spec_list = old_param_spec_list; + /* Now obtain the PDT instance for the extended type. */ + c2->param_list = type_param_spec_list; + m = gfc_get_pdt_instance (type_param_spec_list, + &c2->ts.u.derived, + &c2->param_list); + type_param_spec_list = old_param_spec_list; + } + else + c2->ts = c1->ts; c2->ts.u.derived->refs++; gfc_set_sym_referenced (c2->ts.u.derived); diff --git a/gcc/testsuite/gfortran.dg/pdt_68.f03 b/gcc/testsuite/gfortran.dg/pdt_68.f03 new file mode 100644 index 000000000000..b3493b16f2e1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_68.f03 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Check the fix for PR122566. +! +! Contributed by Damian Rouson <[email protected]> +! +module double_precision_file_m + implicit none + + type file_t + integer :: i + end type + + type, extends(file_t) :: double_precision_file_t + end type + + type, extends(double_precision_file_t) :: training_configuration_t(m) + integer, kind :: m = kind(1.) + end type + +contains + pure module function training_configuration() + type(training_configuration_t) training_configuration + training_configuration%file_t = file_t(42) ! Needed parent type to be introduced explicitly + end function +end module + + use double_precision_file_m + type(training_configuration_t) :: x + x = training_configuration () + if (x%i /= 42) stop 1 +end +! { dg-final { scan-tree-dump-times "double_precision_file_t.file_t" 2 "original" } }
