Fortran: Fix testsuite regressions after r15-5897 [PR116261/PR117901]

2024-12-09  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/116261
	* trans-array.cc (gfc_array_init_size): New arg 'explicit_ts',
	to suppress the use of the expr3 element size in the descriptor
	dtype.
	(gfc_array_allocate): New arg 'explicit_ts', used in call to
	gfc_array_init_size.
	* trans-array.h : Modify prototype for gfc_array_allocate for new
	bool argument.
	* trans-stmt.cc (gfc_trans_allocate): Set new argument if the
	typespec is explicit.

gcc/testsuite/
	PR fortran/117901
	* gfortran.dg/class_transformational_1.f90: Temporary fix for
	ICE with some compile options by setting dummy arg of
	'unlimited rebar' to be allocatable.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6ff2c238038dd64a7f70a6afc551f7efae912464..9a8477650f4aa8fffa973ef558d31ec3f8549c0d 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6104,7 +6104,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
                     stmtblock_t * descriptor_block, tree * overflow,
                     tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
                     tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
-                    tree *element_size)
+                    tree *element_size, bool explicit_ts)
 {
   tree type;
   tree tmp;
@@ -6164,7 +6164,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
       tmp = gfc_conv_descriptor_dtype (descriptor);
       gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
     }
-  else if (expr->ts.type == BT_CLASS
+  else if (expr->ts.type == BT_CLASS && !explicit_ts
           && expr3 && expr3->ts.type != BT_CLASS
           && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
     {
@@ -6469,7 +6469,8 @@ bool
 gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
                    tree errlen, tree label_finish, tree expr3_elem_size,
                    tree *nelems, gfc_expr *expr3, tree e3_arr_desc,
-                   bool e3_has_nodescriptor, gfc_omp_namelist *omp_alloc)
+                   bool e3_has_nodescriptor, gfc_omp_namelist *omp_alloc,
+                   bool explicit_ts)
 {
   tree tmp;
   tree pointer;
@@ -6601,7 +6602,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
                              &offset, lower, upper,
                              &se->pre, &set_descriptor_block, &overflow,
                              expr3_elem_size, nelems, expr3, e3_arr_desc,
-                             e3_has_nodescriptor, expr, &element_size);
+                             e3_has_nodescriptor, expr, &element_size,
+                             explicit_ts);
 
   if (dimension)
     {

diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index ab27f15cab225f24bb7d41eb4c3a35e2cbf4622d..becc8ca4a495bb9e446649dd7351f0c587b8d0f6 100644 (file)
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -22,7 +22,7 @@ along with GCC; see the file COPYING3.  If not see
    se, which should contain an expression for the array descriptor.  */
 bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree,
                         tree, tree *, gfc_expr *, tree, bool,
-                        gfc_omp_namelist *);
+                        gfc_omp_namelist *, bool);
 
 /* Allow the bounds of a loop to be set from a callee's array spec.  */
 void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index b8fba1d91fef8f5b3ced69f693928b91b0087984..80a9502a8a413e859136a609192bd7dfbe2ff4e5 100644 (file)
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6992,7 +6992,8 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
                               label_finish, tmp, &nelems,
                               e3rhs ? e3rhs : code->expr3,
                               e3_is == E3_DESC ? expr3 : NULL_TREE,
-                              e3_has_nodescriptor, omp_alloc_item))
+                              e3_has_nodescriptor, omp_alloc_item,
+                              code->ext.alloc.ts.type != BT_UNKNOWN))
        {
          /* A scalar or derived type.  First compute the size to
             allocate.

diff --git a/gcc/testsuite/gfortran.dg/class_transformational_1.f90 b/gcc/testsuite/gfortran.dg/class_transformational_1.f90
index 77ec24a43c01a8c26ffb8787d30ebcd04c706cda..3e64f5d91e5897f96a05b3f59224d83f22892761 100644 (file)
--- a/gcc/testsuite/gfortran.dg/class_transformational_1.f90
+++ b/gcc/testsuite/gfortran.dg/class_transformational_1.f90
@@ -169,7 +169,7 @@ contains
   end
 
   subroutine unlimited_rebar (arg)
-    class(*) :: arg(:)
+    class(*), allocatable :: arg(:)              ! Not having this allocatable => pr117901
     call class_bar (arg)
   end