Fortran: Check PDT parameters are of integer type [PR84432, PR114815]

2025-09-04  Paul Thomas  <pault@gcc.gnu.org>

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 --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 97f931a3792dd0a821cf83066d55f0e33cb23847..3dbf8cb287aa5d2efa6d35d0567399083ad01776 100644 (file)
--- 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 97431d9f19efffe092cae9e308946af5468ebcf1..a9ea29f760fe16343dc5518c34bdd9af19b0f5a6 100644 (file)
--- 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 b7e3bb600b404d79fdf2d24b5df12312aa1842bf..86a585ad262c69c0c1e882663811fd76d42a8f74 100644 (file)
--- 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 525b9999f3d293421012417c028ffddf0c4921ad..de5f517ec05d324158610a2810156feb81a13a0b 100644 (file)
--- 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