https://gcc.gnu.org/g:ad94070689b3fadafca14c188c650aad6b8600e7
commit r15-6021-gad94070689b3fadafca14c188c650aad6b8600e7
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Mon Dec 9 07:32:22 2024 +0000
Fortran: Fix testsuite regressions after r15-5897 [PR116261/PR117901]
2024-12-09 Paul Thomas <pa...@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:
---
gcc/fortran/trans-array.cc | 10 ++++++----
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-stmt.cc | 3 ++-
gcc/testsuite/gfortran.dg/class_transformational_1.f90 | 2 +-
4 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6ff2c238038d..9a8477650f4a 100644
--- 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 ab27f15cab22..becc8ca4a495 100644
--- 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 b8fba1d91fef..80a9502a8a41 100644
--- 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 77ec24a43c01..3e64f5d91e58 100644
--- 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
