Fortran: Intrinsic functions in PDT specification exprs. [PR83746]

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

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 --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7f9168410a2eba6886e519b5ee49f9624c267baa..abde05f5dded5a3d321c307c2e7ec31a2c5a7916 100644 (file)
--- 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 (file)
index 0000000..ed60b91
--- /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  <berke.durak@gmail.com>
+!
+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