https://gcc.gnu.org/g:406b5150d65ac8e028f1dec0f92816bfc4f5323e

commit 406b5150d65ac8e028f1dec0f92816bfc4f5323e
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Wed Apr 30 14:38:54 2025 +0200

    Correction régression class_array_23

Diff:
---
 gcc/fortran/trans-array.cc      | 2 +-
 gcc/fortran/trans-array.h       | 2 +-
 gcc/fortran/trans-descriptor.cc | 8 +++++++-
 gcc/fortran/trans-descriptor.h  | 4 ++--
 gcc/fortran/trans-stmt.cc       | 3 ++-
 5 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6d306a522953..79ca3f4f74c8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5652,7 +5652,7 @@ bool
 gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
                    tree errlen, tree label_finish, tree expr3_elem_size,
                    gfc_expr *expr3, tree e3_arr_desc, bool e3_has_nodescriptor,
-                   gfc_omp_namelist *omp_alloc, bool explicit_ts)
+                   gfc_omp_namelist *omp_alloc, gfc_typespec * explicit_ts)
 {
   tree tmp;
   tree pointer;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 5b2c6ecffdb4..c5f92b3f3cca 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, gfc_expr *, tree, bool,
-                        gfc_omp_namelist *, bool);
+                        gfc_omp_namelist *, gfc_typespec *);
 
 /* 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-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 22a6fb6942e2..03a6d71bbabf 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -3186,7 +3186,7 @@ gfc_descr_init_count (tree descriptor, int rank, int 
corank, gfc_expr ** lower,
                      stmtblock_t * descriptor_block, tree * overflow,
                      tree expr3_elem_size, gfc_expr *expr3, tree expr3_desc,
                      bool e3_has_nodescriptor, gfc_expr *expr,
-                     tree element_size, bool explicit_ts,
+                     tree element_size, gfc_typespec * explicit_ts,
                      tree *empty_array_cond)
 {
   tree type;
@@ -3237,6 +3237,12 @@ gfc_descr_init_count (tree descriptor, int rank, int 
corank, gfc_expr ** lower,
       tree dtype_value = gfc_get_dtype_rank_type (rank, type);
       gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
     }
+  else if (explicit_ts)
+    {
+      type = gfc_typenode_for_spec (explicit_ts);
+      tree dtype_value = gfc_get_dtype_rank_type (rank, type);
+      gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
+    }
   else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
     {
       tree dtype_value = gfc_conv_descriptor_dtype_get (expr3_desc);
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 092a2b8abddc..3244359c176e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -95,8 +95,8 @@ void gfc_set_descriptor (stmtblock_t *, tree, tree, gfc_expr 
*, int, int,
 
 tree gfc_descr_init_count (tree, int, int, gfc_expr **, gfc_expr **,
                           stmtblock_t *, stmtblock_t *, tree *, tree,
-                          gfc_expr *, tree, bool, gfc_expr *, tree, bool,
-                          tree *);
+                          gfc_expr *, tree, bool, gfc_expr *, tree,
+                          gfc_typespec *, tree *);
 void
 gfc_copy_descriptor_info (stmtblock_t *, tree, tree, int, gfc_ss *);
 void
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index fdcc92555c9c..50167ce083b0 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6929,7 +6929,8 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist 
*omp_allocate)
                               label_finish, tmp, e3rhs ? e3rhs : code->expr3,
                               e3_is == E3_DESC ? expr3 : NULL_TREE,
                               e3_has_nodescriptor, omp_alloc_item,
-                              code->ext.alloc.ts.type != BT_UNKNOWN))
+                              code->ext.alloc.ts.type != BT_UNKNOWN
+                              ? &code->ext.alloc.ts : nullptr))
        {
          /* A scalar or derived type.  First compute the size to
             allocate.

Reply via email to