https://gcc.gnu.org/g:1da1aa07b7b7b529770015c279e9faad3292c696
commit r17-5065-g1da1aa07b7b7b529770015c279e9faad3292c696 Author: Jerry DeLisle <[email protected]> Date: Wed Jun 10 08:36:59 2026 -0700 fortran: [PR125721] Fix ICE for a class pointer component in a structure constructor In a structure constructor, associate a scalar or array CLASS pointer component with a non-class target: set _data, _vptr and, for an unlimited polymorphic component, _len. Assisted-by: Claude Opus 5.5 PR fortran/125721 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_trans_subcomponent_assign): Handle a CLASS pointer component with a non-class target. gcc/testsuite/ChangeLog: * gfortran.dg/structure_constructor_20.f90: New test. * gfortran.dg/structure_constructor_21.f90: New test. Diff: --- gcc/fortran/trans-expr.cc | 33 ++++++++++++ .../gfortran.dg/structure_constructor_20.f90 | 55 +++++++++++++++++++ .../gfortran.dg/structure_constructor_21.f90 | 61 ++++++++++++++++++++++ 3 files changed, 149 insertions(+) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 2d04fd79061c..8ebaba045adf 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -10466,6 +10466,39 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, false); gfc_add_expr_to_block (&block, tmp); } + else if (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.class_pointer + && expr->ts.type != BT_CLASS) + { + /* Associate a CLASS pointer component with a non-class target. */ + gfc_init_se (&se, NULL); + if (CLASS_DATA (cm)->attr.dimension) + { + se.direct_byref = 1; + se.expr = gfc_class_data_get (dest); + gfc_conv_expr_descriptor (&se, expr); + gfc_add_block_to_block (&block, &se.pre); + } + else + { + gfc_conv_expr_reference (&se, expr); + gfc_add_block_to_block (&block, &se.pre); + tmp = gfc_class_data_get (dest); + gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), se.expr)); + } + vtab = gfc_get_symbol_decl (gfc_find_vtab (&expr->ts)); + vtab = gfc_build_addr_expr (NULL_TREE, vtab); + tmp = gfc_class_vptr_get (dest); + gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), vtab)); + if (UNLIMITED_POLY (cm)) + { + tmp = gfc_class_len_get (dest); + gfc_add_modify (&block, tmp, + expr->ts.type == BT_CHARACTER + ? fold_convert (TREE_TYPE (tmp), se.string_length) + : build_zero_cst (TREE_TYPE (tmp))); + } + gfc_add_block_to_block (&block, &se.post); + } else if ((cm->attr.dimension || cm->attr.codimension) && !cm->attr.proc_pointer) { diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_20.f90 b/gcc/testsuite/gfortran.dg/structure_constructor_20.f90 new file mode 100644 index 000000000000..fc6b2f7aa5b3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/structure_constructor_20.f90 @@ -0,0 +1,55 @@ +! { dg-do run } +! +! PR 125721 +! +! A structure constructor associating a class pointer component (unlimited +! polymorphic or typed) with a target used to ICE in +! gfc_trans_subcomponent_assign (fold_convert_loc), because the pointer +! attribute lives on CLASS_DATA and the code fell through to the derived-type +! branch. Check that it compiles and performs genuine pointer association. + +program p + type t + integer :: i = 0 + end type t + type, extends(t) :: t2 + integer :: j = 0 + end type t2 + type cu + class(*), pointer :: u + end type cu + type ct + class(t), pointer :: p + end type ct + + type(t2), target :: tar + type(cu) :: a + type(ct) :: b + character(5), target :: str = "hello" + + ! Unlimited polymorphic pointer component. + tar%i = 5 + a = cu (tar) + select type (q => a%u) + type is (t2) + if (q%i /= 5) stop 1 + class default + stop 2 + end select + + ! Typed (parent) class pointer component -> genuine association, not a copy. + b = ct (tar) + if (loc (b%p) /= loc (tar)) stop 3 + b%p%i = 9 + if (tar%i /= 9) stop 4 + + ! Unlimited polymorphic pointer component with a character target. + a = cu (str) + select type (q => a%u) + type is (character(*)) + if (len (q) /= 5) stop 5 + if (q /= "hello") stop 6 + class default + stop 7 + end select +end program p diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_21.f90 b/gcc/testsuite/gfortran.dg/structure_constructor_21.f90 new file mode 100644 index 000000000000..f7e9682b5193 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/structure_constructor_21.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! +! PR 125721 +! +! A structure constructor with a CLASS array POINTER component associated with +! a target array crashed in gfc_conv_scalarized_array_ref: the pointer +! attribute lives on CLASS_DATA (cm), so no array branch in +! gfc_trans_subcomponent_assign fired and the value reached the scalar/derived +! branch, which converted an array without a scalarizer (se->ss == NULL). +! +! This is the array analog of the scalar class-pointer-component fix. + +program main + implicit none + + type ty + integer(kind=8) :: i = 1 + integer(kind=8) :: ii = 2 + end type + type, extends(ty) :: ty1 + integer(kind=8) :: j = 3 + integer(kind=8) :: jj = 4 + end type + + type conArr + integer :: ty_int + class(ty), pointer :: ty_class(:,:) + end type + + type conStr + class(*), pointer :: u(:) + end type + + type(conArr) :: obj + type(conStr) :: cs + character(5), target :: ca(3) = ["aaaaa", "bbbbb", "ccccc"] + type(ty1), target :: tar(3,3) + + tar%i = 5 + obj = conArr(7, tar) + + if (obj%ty_int /= 7) stop 1 + if (.not. associated (obj%ty_class)) stop 2 + if (any (shape (obj%ty_class) /= [3,3])) stop 3 + ! Dynamic type is ty1 (8 int8 = 32 bytes per element); 9 elements = 288. + if (sizeof (obj%ty_class) /= 288) stop 4 + if (obj%ty_class(2,2)%i /= 5) stop 5 + + obj%ty_class(2,2)%i = 8 + if (tar(2,2)%i /= 8) stop 6 ! pointer really aliases the target + + ! Unlimited polymorphic array pointer component with a character target. + cs = conStr(ca) + select type (q => cs%u) + type is (character(*)) + if (len (q) /= 5) stop 7 + if (q(2) /= "bbbbb") stop 8 + class default + stop 9 + end select +end program main
