https://gcc.gnu.org/g:1f8600897b8c3578152e95ae05c3034c5a05eb34
commit r16-3989-g1f8600897b8c3578152e95ae05c3034c5a05eb34 Author: Paul Thomas <[email protected]> Date: Fri Sep 19 17:48:45 2025 +0100 Fortran: Intrinsic functions in PDT specification exprs. [PR83746] 2025-09-19 Paul Thomas <[email protected]> gcc/fortran PR fortran/83746 * trans-array.cc (structure_alloc_comps): Add the pre and post blocks to 'fnblock' for all the evaluations of parameterized expressions in PDT component allocatation. gcc/testsuite/ PR fortran/83746 * gfortran.dg/pdt_48.f03: New test. Diff: --- gcc/fortran/trans-array.cc | 10 ++++++++ gcc/testsuite/gfortran.dg/pdt_48.f03 | 49 ++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 7f9168410a2e..abde05f5dded 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -10903,7 +10903,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, if (c_expr) { gfc_conv_expr_type (&tse, c_expr, TREE_TYPE (comp)); + gfc_add_block_to_block (&fnblock, &tse.pre); gfc_add_modify (&fnblock, comp, tse.expr); + gfc_add_block_to_block (&fnblock, &tse.post); } } else if (c->initializer && !c->attr.pdt_string && !c->attr.pdt_array @@ -10914,7 +10916,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, gfc_expr *c_expr; c_expr = c->initializer; gfc_conv_expr_type (&tse, c_expr, TREE_TYPE (comp)); + gfc_add_block_to_block (&fnblock, &tse.pre); gfc_add_modify (&fnblock, comp, tse.expr); + gfc_add_block_to_block (&fnblock, &tse.post); } if (c->attr.pdt_string) @@ -10934,7 +10938,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, strlen = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (strlen), decl, strlen, NULL_TREE); + gfc_add_block_to_block (&fnblock, &tse.pre); gfc_add_modify (&fnblock, strlen, tse.expr); + gfc_add_block_to_block (&fnblock, &tse.post); c->ts.u.cl->backend_decl = strlen; } gfc_free_expr (e); @@ -10981,17 +10987,21 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, gfc_conv_expr_type (&tse, e, gfc_array_index_type); gfc_free_expr (e); lower = tse.expr; + gfc_add_block_to_block (&fnblock, &tse.pre); gfc_conv_descriptor_lbound_set (&fnblock, comp, gfc_rank_cst[i], lower); + gfc_add_block_to_block (&fnblock, &tse.post); e = gfc_copy_expr (c->as->upper[i]); gfc_insert_parameter_exprs (e, pdt_param_list); gfc_conv_expr_type (&tse, e, gfc_array_index_type); gfc_free_expr (e); upper = tse.expr; + gfc_add_block_to_block (&fnblock, &tse.pre); gfc_conv_descriptor_ubound_set (&fnblock, comp, gfc_rank_cst[i], upper); + gfc_add_block_to_block (&fnblock, &tse.post); gfc_conv_descriptor_stride_set (&fnblock, comp, gfc_rank_cst[i], size); diff --git a/gcc/testsuite/gfortran.dg/pdt_48.f03 b/gcc/testsuite/gfortran.dg/pdt_48.f03 new file mode 100644 index 000000000000..ed60b91c8c90 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_48.f03 @@ -0,0 +1,49 @@ +! { dg-do run } +! +! Test the fix for P83746, which failed as in the comment below. +! +! Contributed by Berke Durak <[email protected]> +! +module pdt_m + implicit none + type :: vec(k) + integer, len :: k + integer :: foo(k) + end type vec +contains + elemental function diy_max(a,b) result(c) + integer, intent(in) :: a,b + integer :: c + c=max(a,b) + end function diy_max + + function add(a,b) result(c) + type(vec(k=*)), intent(in) :: a,b + type(vec(k=max(a%k,b%k))) :: c ! Fails + !type(vec(k=diy_max(a%k,b%k))) :: c ! Worked with diy_max + !type(vec(k=a%k+b%k)) :: c ! Worked with + + + c%foo(1:a%k)=a%foo + c%foo(1:b%k)=c%foo(1:b%k)+b%foo + + if (c%k /= 5) stop 1 + end function add +end module pdt_m + +program test_pdt + use pdt_m + implicit none + type(vec(k=2)) :: u + type(vec(k=5)) :: v,w + + if (w%k /= 5) stop 2 + if (size(w%foo) /= 5) stop 3 + + u%foo=[1,2] + v%foo=[10,20,30,40,50] + w=add(u,v) + + if (w%k /= 5) stop 4 + if (size(w%foo) /= 5) stop 5 + if (any (w%foo /= [11,22,30,40,50])) stop 6 +end program test_pdt
