Hi All, PDT components with default initializers must have type parameter and length expressions that reduce to compile time integer constants. The chunk in expr.cc verifies that this is the case for array bounds and character lengths.
This error checking results in pdt_26.f03 segfaulting because, without a default initializer, the parameterized components are not allocated and it segfaults in runtime. The first chunk in trans-expr.cc fixes this. It has been checked for runtime memory leaks with valgrind. The whole point of pdt_27.f03 was to fix a problem with initialized, parameterized components(!), so it has been taken over to exercise the error checking. Regtests on FC42/x86_64 - OK for mainline? Regards Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 97f931a3792..43093d0f048 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 97431d9f19e..a9ea29f760f 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 b7e3bb600b4..86a585ad262 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 525b9999f3d..de5f517ec05 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
