https://gcc.gnu.org/g:6b6a2d461bfd3c81cc35c9989b225845681357cb
commit r16-3590-g6b6a2d461bfd3c81cc35c9989b225845681357cb Author: Paul Thomas <[email protected]> Date: Fri Sep 5 07:22:01 2025 +0100 Fortran: Check PDT parameters are of integer type [PR84432, PR114815] 2025-09-04 Paul Thomas <[email protected]> gcc/fortran PR fortran/84432 PR fortran/114815 * expr.cc (gfc_check_assign_symbol): Check that components in a PDT with a default initializer have type and length parameters that reduce to constant integer expressions. * trans-expr.cc (gfc_trans_assignment_1): Parameterized components cannot have default initializers so they must be allocated after initialization. gcc/testsuite/ PR fortran/84432 PR fortran/114815 * gfortran.dg/pdt_26.f03: Update with default no initializer. * gfortran.dg/pdt_27.f03: Change to test non-conforming initializers. Diff: --- gcc/fortran/expr.cc | 46 ++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-expr.cc | 20 ++++++++++++++-- gcc/testsuite/gfortran.dg/pdt_26.f03 | 4 ++-- gcc/testsuite/gfortran.dg/pdt_27.f03 | 22 +++++++---------- 4 files changed, 74 insertions(+), 18 deletions(-) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 97f931a3792d..3dbf8cb287aa 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -4769,6 +4769,52 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) memset (&lvalue, '\0', sizeof (gfc_expr)); + if (sym && sym->attr.pdt_template && comp && comp->initializer) + { + int i, flag; + gfc_expr *param_expr; + flag = 0; + + if (comp->as && comp->as->type == AS_EXPLICIT + && !(comp->ts.type == BT_DERIVED + && comp->ts.u.derived->attr.pdt_template)) + { + /* Are the bounds of the array parameterized? */ + for (i = 0; i < comp->as->rank; i++) + { + param_expr = gfc_copy_expr (comp->as->lower[i]); + if (gfc_simplify_expr (param_expr, 1) + && param_expr->expr_type != EXPR_CONSTANT) + flag++; + gfc_free_expr (param_expr); + param_expr = gfc_copy_expr (comp->as->upper[i]); + if (gfc_simplify_expr (param_expr, 1) + && param_expr->expr_type != EXPR_CONSTANT) + flag++; + gfc_free_expr (param_expr); + } + } + + /* Is the character length parameterized? */ + if (comp->ts.type == BT_CHARACTER && comp->ts.u.cl->length) + { + param_expr = gfc_copy_expr (comp->ts.u.cl->length); + if (gfc_simplify_expr (param_expr, 1) + && param_expr->expr_type != EXPR_CONSTANT) + flag++; + gfc_free_expr (param_expr); + } + + if (flag) + { + gfc_error ("The component %qs at %L of derived type %qs has " + "paramterized type or array length parameters, which is " + "not compatible with a default initializer", + comp->name, &comp->initializer->where, sym->name); + return false; + } + } + lvalue.expr_type = EXPR_VARIABLE; lvalue.ts = sym->ts; if (sym->as) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 97431d9f19ef..a9ea29f760fe 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -13381,6 +13381,22 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, gfc_cleanup_loop (&loop); } + /* Since parameterized components cannot have default initializers, + the default PDT constructor leaves them unallocated. Do the + allocation now. */ + if (init_flag && expr1->ts.type == BT_DERIVED + && expr1->ts.u.derived->attr.pdt_type + && !expr1->symtree->n.sym->attr.allocatable + && !expr1->symtree->n.sym->attr.dummy) + { + gfc_symbol *sym = expr1->symtree->n.sym; + tmp = gfc_allocate_pdt_comp (sym->ts.u.derived, + sym->backend_decl, + sym->as ? sym->as->rank : 0, + sym->param_list); + gfc_add_expr_to_block (&block, tmp); + } + return gfc_finish_block (&block); } @@ -13444,7 +13460,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, { tmp = gfc_trans_zero_assign (expr1); if (tmp) - return tmp; + return tmp; } /* Special case copying one array to another. */ @@ -13455,7 +13471,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, { tmp = gfc_trans_array_copy (expr1, expr2); if (tmp) - return tmp; + return tmp; } /* Special case initializing an array from a constant array constructor. */ diff --git a/gcc/testsuite/gfortran.dg/pdt_26.f03 b/gcc/testsuite/gfortran.dg/pdt_26.f03 index b7e3bb600b40..86a585ad262c 100644 --- a/gcc/testsuite/gfortran.dg/pdt_26.f03 +++ b/gcc/testsuite/gfortran.dg/pdt_26.f03 @@ -13,7 +13,7 @@ module pdt_m implicit none type :: vec(k) integer, len :: k=3 - integer :: foo(k)=[1,2,3] + integer :: foo(k) end type vec contains elemental function addvv(a,b) result(c) @@ -43,4 +43,4 @@ program test_pdt if (any (c(1)%foo .ne. [13,15,17])) STOP 2 end program test_pdt ! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } } -! { dg-final { scan-tree-dump-times "__builtin_malloc" 9 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 8 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pdt_27.f03 b/gcc/testsuite/gfortran.dg/pdt_27.f03 index 525b9999f3d2..de5f517ec05d 100644 --- a/gcc/testsuite/gfortran.dg/pdt_27.f03 +++ b/gcc/testsuite/gfortran.dg/pdt_27.f03 @@ -1,22 +1,16 @@ -! { dg-do run } +! { dg-do compile } ! -! Test the fix for PR83611, in which the assignment caused a -! double free error and the initialization of 'foo' was not done. +! This originally tested the fix for PR83611, in which the assignment caused a +! double free error and the initialization of 'foo' was not done. However, the +! initialization is not conforming (see PR84432 & PR114815) and so this test +! is now compile only and verifies the error detection. The program part has +! been deleted. ! module pdt_m implicit none type :: vec(k) integer, len :: k=3 - integer :: foo(k)=[1,2,3] + integer :: foo(k)=[1,2,3] ! { dg-error "not compatible with a default initializer" } + character(len = k) :: chr = "ab" ! { dg-error "not compatible with a default initializer" } end type vec end module pdt_m - -program test_pdt - use pdt_m - implicit none - type(vec) :: u,v - if (any (u%foo .ne. [1,2,3])) STOP 1 - u%foo = [7,8,9] - v = u - if (any (v%foo .ne. [7,8,9])) STOP 2 -end program test_pdt
