[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régression forall_13

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:39701cd22bf18c4172edb14e6ae502705b4da46c

commit 39701cd22bf18c4172edb14e6ae502705b4da46c
Author: Mikael Morin 
Date:   Mon Feb 17 18:49:30 2025 +0100

Correction régression forall_13

Diff:
---
 gcc/fortran/trans-array.cc | 86 ++
 gcc/fortran/trans-array.h  |  3 +-
 gcc/fortran/trans-expr.cc  |  5 ++-
 gcc/fortran/trans-intrinsic.cc |  8 ++--
 gcc/fortran/trans-stmt.cc  |  2 +-
 gcc/fortran/trans.h|  1 +
 6 files changed, 65 insertions(+), 40 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9fe54c76e0d8..600f28b37962 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1908,17 +1908,20 @@ set_bounds_update_offset (stmtblock_t *block, tree 
desc, int dim,
 return;
 
   /* Update offset.  */
-  tree tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound_diff, stride);
-  tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type, *offset, tmp);
-  *offset = gfc_evaluate_now (tmp, block);
+  if (!integer_zerop (lbound_diff))
+{
+  tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lbound_diff, stride);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+gfc_array_index_type, *offset, tmp);
+  *offset = gfc_evaluate_now (tmp, block);
+}
 
   if (!next_stride)
 return;
 
   /* Set stride for next dimension.  */
-  tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+  tree tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
   *next_stride = fold_build2_loc (input_location, MULT_EXPR,
  gfc_array_index_type, stride, tmp);
 }
@@ -3652,9 +3655,11 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, 
tree *eltype,
 static void
 set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
  tree elemsize, tree data_ptr,
+ tree lbound[GFC_MAX_DIMENSIONS],
  tree ubound[GFC_MAX_DIMENSIONS],
  tree stride[GFC_MAX_DIMENSIONS], int rank,
- bool callee_allocated, bool rank_changer)
+ bool callee_allocated, bool rank_changer,
+ bool shift_bounds)
 {
   int n;
 
@@ -3680,13 +3685,15 @@ set_temporary_descriptor (stmtblock_t *block, tree 
desc, tree class_src,
   gfc_conv_descriptor_rank_set (block, desc, rank);
 }
 
+  tree offset = gfc_index_zero_node;
   if (!callee_allocated)
 {
   for (n = 0; n < rank; n++)
{
  /* Store the stride and bound components in the descriptor.  */
- set_descriptor_dimension (block, desc, n, gfc_index_zero_node, 
ubound[n],
-   stride[n], nullptr, nullptr);
+ tree this_lbound = shift_bounds ? gfc_index_zero_node : lbound[n];
+ set_descriptor_dimension (block, desc, n, this_lbound, ubound[n],
+   stride[n], &offset, nullptr);
}
 }
 
@@ -3696,7 +3703,7 @@ set_temporary_descriptor (stmtblock_t *block, tree desc, 
tree class_src,
 
   /* The offset is zero because we create temporaries with a zero
  lower bound.  */
-  gfc_conv_descriptor_offset_set (block, desc, gfc_index_zero_node);
+  gfc_conv_descriptor_offset_set (block, desc, offset);
 }
 
 
@@ -3721,7 +3728,8 @@ set_temporary_descriptor (stmtblock_t *block, tree desc, 
tree class_src,
 tree
 gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * 
ss,
 tree eltype, tree initial, bool dynamic,
-bool dealloc, bool callee_alloc, locus * where)
+bool dealloc, bool callee_alloc, locus * where,
+bool shift_bounds)
 {
   gfc_loopinfo *loop;
   gfc_ss *s;
@@ -3808,19 +3816,22 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
{
  dim = s->dim[n];
 
- /* Callee allocated arrays may not have a known bound yet.  */
- if (loop->to[n])
-   loop->to[n] = gfc_evaluate_now (
-   fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-loop->to[n], loop->from[n]),
-   pre);
- loop->from[n] = gfc_index_zero_node;
-
- /* We have just changed the loop bounds, we must clear the
-corresponding specloop, so that delta calculation is not skipped
-later in gfc_set_delta.  */
- loop->specloop[n] = NULL;
+ if (shift_bounds)
+   {
+ /* Callee allocated arrays may not have a known bound yet.  */
+ if (loop->to[n])
+   loop

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Suppression mise à jour offset forall

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:167a65fb71613ad1476ed5cec1b520ca6e7402bb

commit 167a65fb71613ad1476ed5cec1b520ca6e7402bb
Author: Mikael Morin 
Date:   Mon Feb 17 17:28:01 2025 +0100

Suppression mise à jour offset forall

Diff:
---
 gcc/fortran/trans-stmt.cc | 7 ---
 1 file changed, 7 deletions(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f48019309c23..71e911f8c9ee 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -4016,13 +4016,6 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t 
*pre, stmtblock_t *post)
   gfc_add_block_to_block (pre, &tse.pre);
   gfc_add_block_to_block (post, &tse.post);
   tse.expr = build_fold_indirect_ref_loc (input_location, tse.expr);
-
-  if (c->expr1->ref->u.ar.type != AR_SECTION)
-   {
- /* Use the variable offset for the temporary.  */
- tmp = gfc_conv_array_offset (old_sym->backend_decl);
- gfc_conv_descriptor_offset_set (pre, tse.expr, tmp);
-   }
 }
   else
 {

[gcc r15-7592] c++: add fixed test [PR102455]

[Marek Polacek via Gcc-cvs]

https://gcc.gnu.org/g:1787119229abca0c78f9c902eeb7c88efed37ce0

commit r15-7592-g1787119229abca0c78f9c902eeb7c88efed37ce0
Author: Marek Polacek 
Date:   Mon Feb 17 12:36:05 2025 -0500

c++: add fixed test [PR102455]

Fixed by r13-4564 but the tests are very different.

PR c++/102455

gcc/testsuite/ChangeLog:

* g++.dg/ext/vector43.C: New test.

Diff:
---
 gcc/testsuite/g++.dg/ext/vector43.C | 7 +++
 1 file changed, 7 insertions(+)

diff --git a/gcc/testsuite/g++.dg/ext/vector43.C 
b/gcc/testsuite/g++.dg/ext/vector43.C
new file mode 100644
index ..6efbe0ff1975
--- /dev/null
+++ b/gcc/testsuite/g++.dg/ext/vector43.C
@@ -0,0 +1,7 @@
+// PR c++/102455
+// { dg-do compile { target c++14 } }
+
+typedef int v4si;
+typedef float v4sf __attribute__ ((vector_size(4)));
+constexpr v4sf foo (v4si a) { return (v4sf)a;}
+template  constexpr v4sf b = foo (v4si {});

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Utilisation setter trans_associate_var

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:20997a022cde7e61785176025d4699f71590fa96

commit 20997a022cde7e61785176025d4699f71590fa96
Author: Mikael Morin 
Date:   Mon Feb 17 17:15:10 2025 +0100

Utilisation setter trans_associate_var

Diff:
---
 gcc/fortran/trans-stmt.cc | 7 ---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f1c62ae01cb9..f48019309c23 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2292,9 +2292,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
{
  tmp = sym->backend_decl;
  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
-   tmp = gfc_conv_descriptor_data_get (tmp);
- gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
-   null_pointer_node));
+   gfc_conv_descriptor_data_set (&se.pre, tmp, null_pointer_node);
+ else
+   gfc_add_modify (&se.pre, tmp,
+   fold_convert (TREE_TYPE (tmp), null_pointer_node));
}
 
   lhs = gfc_lval_expr_from_sym (sym);

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Sauvegarde modifs

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:c65f8ae7da9c82a5505a680e203229f936f7dd6e

commit c65f8ae7da9c82a5505a680e203229f936f7dd6e
Author: Mikael Morin 
Date:   Sat Dec 7 22:22:10 2024 +0100

Sauvegarde modifs

Annulation suppression else

Correction assertions

Initialisation vptr

Non initialisation elem_len pour les conteneurs de classe

Mise à jour class_allocatable_14

Diff:
---
 gcc/fortran/trans-array.cc  | 52 ++
 gcc/fortran/trans-array.h   |  2 +
 gcc/fortran/trans-decl.cc   | 58 +
 gcc/testsuite/gfortran.dg/class_allocate_14.f90 |  2 +-
 4 files changed, 66 insertions(+), 48 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2621c3db710c..a844342e5645 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -734,6 +734,58 @@ gfc_build_null_descriptor (tree type, gfc_typespec &ts,
 }
 
 
+tree
+gfc_build_default_class_descriptor (tree type, gfc_typespec &ts)
+{
+  vec *v = nullptr;
+
+  tree fields = TYPE_FIELDS (type);
+
+#define CLASS_DATA_FIELD 0
+#define CLASS_VPTR_FIELD 1
+
+  tree data_field = gfc_advance_chain (fields, CLASS_DATA_FIELD);
+  tree data_type = TREE_TYPE (data_field);
+
+  gcc_assert (ts.type == BT_CLASS);
+  tree data_value;
+  if (ts.u.derived->components->attr.dimension
+  || (ts.u.derived->components->attr.codimension
+ && flag_coarray != GFC_FCOARRAY_LIB))
+{
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (data_type));
+  data_value = gfc_build_null_descriptor (data_type,
+ ts,
+ 
ts.u.derived->components->as->rank,
+ ts.u.derived->components->attr);
+}
+  else
+{
+  gcc_assert (POINTER_TYPE_P (data_type));
+  data_value = fold_convert (data_type, null_pointer_node);
+}
+  CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
+
+  tree vptr_field = gfc_advance_chain (fields, CLASS_VPTR_FIELD);
+
+  tree vptr_value;
+  if (ts.u.derived->attr.unlimited_polymorphic)
+vptr_value = fold_convert (TREE_TYPE (vptr_field), null_pointer_node);
+  else
+{
+  gfc_symbol *vsym = gfc_find_derived_vtab (ts.u.derived);
+  tree vsym_decl = gfc_get_symbol_decl (vsym);
+  vptr_value = gfc_build_addr_expr (nullptr, vsym_decl);
+}
+  CONSTRUCTOR_APPEND_ELT (v, vptr_field, vptr_value);
+
+#undef CLASS_DATA_FIELD
+#undef CLASS_VPTR_FIELD
+  
+  return build_constructor (type, v);
+}
+
+
 void
 gfc_clear_descriptor (gfc_expr *var_ref, gfc_se &var)
 {
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1bb3294b0749..63a77d562a7b 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -140,6 +140,8 @@ void gfc_set_delta (gfc_loopinfo *);
 void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
 /* Build a null array descriptor constructor.  */
 tree gfc_build_null_descriptor (tree);
+tree gfc_build_default_class_descriptor (tree, gfc_typespec &);
+void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym, tree 
descriptor);
 
 /* Get a single array element.  */
 void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 0acf0e9adb78..ef15862b8d2d 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4811,16 +4811,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
   else if (proc_sym == proc_sym->result && IS_CLASS_ARRAY (proc_sym))
 {
   /* Nullify explicit return class arrays on entry.  */
-  tree type;
   tmp = get_proc_result (proc_sym);
-   if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
- {
-   gfc_start_block (&init);
-   tmp = gfc_class_data_get (tmp);
-   type = TREE_TYPE (gfc_conv_descriptor_data_get (tmp));
-   gfc_conv_descriptor_data_set (&init, tmp, build_int_cst (type, 0));
-   gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
- }
+  if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
+   {
+ gfc_start_block (&init);
+ tmp = gfc_class_data_get (tmp);
+ gfc_clear_descriptor (&init, proc_sym, tmp);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+   }
 }
 
 
@@ -4962,48 +4960,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
}
}
 
-  if (sym->attr.pointer && sym->attr.dimension
- && sym->attr.save == SAVE_NONE
- && !sym->attr.use_assoc
- && !sym->attr.host_assoc
- && !sym->attr.dummy
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)))
-   {
- gfc_init_block (&tmpblock);
- gfc_conv_descriptor_span_set (&tmpblock, sym->backend_decl,
-   

[gcc r15-7589] tree-optimization/118895 - ICE during PRE

[Richard Biener via Gcc-cvs]

https://gcc.gnu.org/g:dfd0ced98fcf62c4d24979b74c1d52334ff62bfc

commit r15-7589-gdfd0ced98fcf62c4d24979b74c1d52334ff62bfc
Author: Richard Biener 
Date:   Mon Feb 17 11:40:01 2025 +0100

tree-optimization/118895 - ICE during PRE

When we simplify a NARY during PHI translation we have to make sure
to not inject not available operands into it given that might violate
the valueization hook constraints and we'd pick up invalid
context-sensitive data in further simplification or as in this case
later ICE when we try to insert the expression.

PR tree-optimization/118895
* tree-ssa-sccvn.cc (vn_nary_build_or_lookup_1): Only allow
CSE if we can verify the result is available.

* gcc.dg/pr118895.c: New testcase.

Diff:
---
 gcc/testsuite/gcc.dg/pr118895.c | 13 +
 gcc/tree-ssa-sccvn.cc   | 13 -
 2 files changed, 21 insertions(+), 5 deletions(-)

diff --git a/gcc/testsuite/gcc.dg/pr118895.c b/gcc/testsuite/gcc.dg/pr118895.c
new file mode 100644
index ..ca61d2cc1b19
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr118895.c
@@ -0,0 +1,13 @@
+/* { dg-do compile } */
+/* { dg-options "-O2" } */
+
+unsigned long a;
+void fn1()
+{
+  unsigned long e = a;
+  int c = e;
+  int d = c < 100 ? c : 0;
+  if (d + (int)e & 608)
+while (e & 608)
+  e <<= 1;
+}
diff --git a/gcc/tree-ssa-sccvn.cc b/gcc/tree-ssa-sccvn.cc
index 8bb45780a981..146840664e2e 100644
--- a/gcc/tree-ssa-sccvn.cc
+++ b/gcc/tree-ssa-sccvn.cc
@@ -366,6 +366,10 @@ static vn_ssa_aux_t last_pushed_avail;
correct.  */
 static vn_tables_t valid_info;
 
+/* Global RPO state for access from hooks.  */
+static class eliminate_dom_walker *rpo_avail;
+basic_block vn_context_bb;
+
 
 /* Valueization hook for simplify_replace_tree.  Valueize NAME if it is
an SSA name, otherwise just return it.  */
@@ -2501,7 +2505,10 @@ vn_nary_build_or_lookup_1 (gimple_match_op *res_op, bool 
insert,
   bool res = false;
   if (i == res_op->num_ops)
 {
-  mprts_hook = vn_lookup_simplify_result;
+  /* Do not leak not available operands into the simplified expression
+when called from PRE context.  */
+  if (rpo_avail)
+   mprts_hook = vn_lookup_simplify_result;
   res = res_op->resimplify (NULL, vn_valueize);
   mprts_hook = NULL;
 }
@@ -2684,10 +2691,6 @@ public:
   vn_avail *m_avail_freelist;
 };
 
-/* Global RPO state for access from hooks.  */
-static eliminate_dom_walker *rpo_avail;
-basic_block vn_context_bb;
-
 /* Return true if BASE1 and BASE2 can be adjusted so they have the
same address and adjust *OFFSET1 and *OFFSET2 accordingly.
Otherwise return false.  */

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Suppression set span dans trans_associate_var

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:a797f21268bb1434e1d554e577714c7380248406

commit a797f21268bb1434e1d554e577714c7380248406
Author: Mikael Morin 
Date:   Mon Feb 17 16:16:47 2025 +0100

Suppression set span dans trans_associate_var

Diff:
---
 gcc/fortran/trans-stmt.cc | 10 --
 1 file changed, 10 deletions(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 6bc9f3910292..f1c62ae01cb9 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2012,16 +2012,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
  gfc_conv_shift_descriptor (&se.pre, desc, e->rank);
}
 
-  /* If this is a subreference array pointer associate name use the
-associate variable element size for the value of 'span'.  */
-  if (sym->attr.subref_array_pointer && !se.direct_byref)
-   {
- gcc_assert (e->expr_type == EXPR_VARIABLE);
- tmp = gfc_get_array_span (se.expr, e);
-
- gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
-   }
-
   if (e->expr_type == EXPR_FUNCTION
  && sym->ts.type == BT_DERIVED
  && sym->ts.u.derived

[gcc r15-7588] AVR: ad target/118764 - Mention CVT availability in device-specs comment.

[Georg-Johann Lay via Gcc-cvs]

https://gcc.gnu.org/g:230678c19cb5e2f8a4855b9790794042fc6ad068

commit r15-7588-g230678c19cb5e2f8a4855b9790794042fc6ad068
Author: Georg-Johann Lay 
Date:   Mon Feb 17 14:31:25 2025 +0100

AVR: ad target/118764 - Mention CVT availability in device-specs comment.

gcc/
PR target/118764
* config/avr/gen-avr-mmcu-specs.cc (print_mcu)
[has CVT]: Mention CVT in header comment of generated specs file.

Diff:
---
 gcc/config/avr/gen-avr-mmcu-specs.cc | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/gcc/config/avr/gen-avr-mmcu-specs.cc 
b/gcc/config/avr/gen-avr-mmcu-specs.cc
index fa085efaae4b..05f2d0e1d4ac 100644
--- a/gcc/config/avr/gen-avr-mmcu-specs.cc
+++ b/gcc/config/avr/gen-avr-mmcu-specs.cc
@@ -74,7 +74,7 @@ static const char help_copy_paste[] =
   "# for a new device spec file, make sure you are copying from a specs file\n"
   "# for a device from the same or compatible:\n"
   "# compiler version, compiler vendor, core architecture, SP width,\n"
-  "# short-calls and FLMAP.\n"
+  "# short-calls, features like CVT and FLMAP.\n"
   "# Otherwise, errors and wrong or sub-optimal code may likely occur.\n"
   "# See <" WIKI_URL ">\n"
   "# and <" SPECFILE_USAGE_URL "> for a description\n"
@@ -260,8 +260,9 @@ print_mcu (const avr_mcu_t *mcu, const McuInfo &mi)
   if (mi.is_arch)
 fprintf (f, "core architecture %s\n", mi.arch->name);
   else
-fprintf (f, "device %s (core %s, %d-bit SP%s%s)\n", mi.mcu_Name,
+fprintf (f, "device %s (core %s, %d-bit SP%s%s%s)\n", mi.mcu_Name,
 mi.arch->name, sp8 ? 8 : 16, rcall ? ", short-calls" : "",
+mi.have_cvt ? ", CVT" : "",
 mi.have_flmap ? ", FLMAP" : "");
   fprintf (f, "%s\n", header);

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction bootstrap suppression variables inutilisées

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:1596f8f5380a6e045adfe3da5accefcebb6bc268

commit 1596f8f5380a6e045adfe3da5accefcebb6bc268
Author: Mikael Morin 
Date:   Mon Feb 17 15:48:12 2025 +0100

Correction bootstrap suppression variables inutilisées

Diff:
---
 gcc/fortran/trans-stmt.cc | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 077630ee0026..6bc9f3910292 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1736,9 +1736,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
   bool class_target;
   bool unlimited;
   tree desc;
-  tree offset;
-  tree dim;
-  int n;
   tree charlen;
   bool need_len_assign;
   bool whole_array = true;

[gcc/mikael/heads/refactor_descriptor_v01] (761 commits) Suppression modif offset trans_associate_var

[Mikael Morin via Gcc-cvs]

The branch 'mikael/heads/refactor_descriptor_v01' was updated to point to:

 d0cb386bd235... Suppression modif offset trans_associate_var

It previously pointed to:

 3ba31387b9ad... Correction régression class_assign_4.f90

Diff:

!!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST):
---

  3ba3138... Correction régression class_assign_4.f90
  760ecd9... Correction régressions inline_sum_*
  4cc360e... Correction class_result_10.f90
  2342ea2... Correction régression class_to_type_2.f90
  3365380... Correction ICE class_to_type_1
  b0e5045... Sauvegarde modif
  c8dd6ca... Essai suppression code inutile
  8b73671... Renommage gfc_array_init_count -> gfc_descr_init_count
  f002d57... Mise à jour commentaires.
  c761a6e... Suppression argument nelems gfc_array_allocate
  5b2a88f... Séparation get_array_memory_size
  537d117... Mise à jour offset & span dans gfc_array_init_size
  c141dd1... Factorisation descriptor_element_size
  a7d3095... Déplacement fonction
  9a83288... Factorisation shift_descriptor
  ddb31d5... Factorisation set_descriptor_dimension
  e6c9f7a... Factorisation set temporary descriptor
  a6b20dd... Correction erreurs non-lvalue lhs pr113363.f90
  35c975b... Ajout surcharge gfc_conv_descriptor_type_set
  a6c9917... Correction non_lvalue PR97046.f90
  749c143... Interdiction non-lvalue as lhs
  62bf6ea... Mises à jour dumps
  ab0d39c... match: Unwrap non-lvalue as unary or binary operand
  6c67765... match: Simplify double not and double negate to a non_lvalu
  bed2485... Introduction getters et setters descriptor compil' OK
  ded0b81... Factorisation initialisation dimension descripteur
  bf057de... Factorisation set_descriptor_dimension
  c55b04c... Factorisation gfc_conv_shift_descriptor
  d2722a0... Renseignement token par gfc_set_descriptor_from_scalar.
  d57bd41... Séparation motifs dump assumed_rank_12.f90
  7973411... réduction différences dump assumed_rank_12.f90
  3e14437... Sauvegarde factorisation set_descriptor_from_scalar
  c980269... Déplacement gfc_set_gfc_from_cfi
  f634a20... Déplacement gfc_copy_sequence_descriptor
  9652121... Déplacement méthode set_descriptor_from_scalar
  123a492... Update dump match count
  468055f... Factorisation set_descriptor_from_scalar dans gfc_conv_scal
  c3d8cf0... Factorisation set_descriptor_from_scalar conv_derived_to_cl
  60fb6b7... Factorisation set_descriptor_from_scalar dans conv_class_to
  1392f13... Factorisation initialisation depuis cfi
  84be5a4... utilisation booléen allocatable
  57a9d25... Factorisation initialisation gfc depuis cfi
  7d9a5b7... Refactoring gfc_conv_descriptor_sm_get.
  55a2a10... Introduction gfc_conv_descriptor_extent_get
  c2ce739... Factorisation shift descriptor
  41e3834... Factorisation initialisation subarray_descriptor
  c3a50c1... Factorisation set descriptor with shape
  b5834ef... Factorisation set_contiguous_array
  ccb2dcc... Factorisation set_contiguous_array
  bd3573d... Essai suppression unlimited_polymorphic
  a6d12d1... Refactor conv_shift_descriptor
  7818e31... Factorisation shift descriptor
  7421792... Factorisation shift descriptor
  d607595... Factorisation gfc_conv_expr_descriptor
  82413c9... Factorisation copie gfc_conv_expr_descriptor
  ed6fee2... Extraction fonction fcncall_realloc_result
  7ed0026... Factorisation gfc_conv_remap_descriptor
  6d1a550... Introduction gfc_copy_sequence_descriptor
  b68e4d2... Utilisation de la méthode de nullification pour nullifier 
  ecdc8da... Appel méthode shift descriptor dans gfc_trans_pointer_assi
  063c001... Déplacement shift descriptor vers gfc_conv_array_parameter
  db8ddde... Utilisation gfc_clear_descriptor dans gfc_conv_derived_to_c
  e3de444... Sauvegarde modifs
  3c45ca6... Creation méthode initialisation descripteur


Summary of changes (added commits):
---

  d0cb386... Suppression modif offset trans_associate_var
  96f1081... Correction régression class_assign_4.f90
  2fa2259... Correction régressions inline_sum_*
  4bd0378... Correction class_result_10.f90
  77b5e02... Correction régression class_to_type_2.f90
  5c1e019... Correction ICE class_to_type_1
  7a8cc81... Sauvegarde modif
  80ddc85... Essai suppression code inutile
  0374a20... Renommage gfc_array_init_count -> gfc_descr_init_count
  4cdbf21... Mise à jour commentaires.
  4be447d... Suppression argument nelems gfc_array_allocate
  e21cc2e... Séparation get_array_memory_size
  d8eaa4c... Mise à jour offset & span dans gfc_array_init_size
  0af42b5... Factorisation descriptor_element_size
  f505307... Déplacement fonction
  2d7569c... Factorisation shift_descriptor
  4128faf... Factorisation set_descriptor_dimension
  b85b29d... Factorisation set temporary descriptor
  22b0d8a... Correction erreurs non-lvalue lhs pr113363.f90
  ef6f265... Ajout surcharge gfc_conv_descriptor_type_set
  576440a... Correction non_lvalue PR97046.f90
  ec8b274... Interdiction non-lvalu

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Utilisation gfc_clear_descriptor dans gfc_conv_derived_to_class

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:841c25bbe361f9b2a19bc42ba4a771f570a34007

commit 841c25bbe361f9b2a19bc42ba4a771f570a34007
Author: Mikael Morin 
Date:   Wed Dec 11 16:03:10 2024 +0100

Utilisation gfc_clear_descriptor dans gfc_conv_derived_to_class

essai suppression

Suppression fonction inutilisée

Sauvegarde compilation OK

Correction régression

Sauvegarde correction null_actual_6

Commentage fonction inutilisée

Correction bornes descripteur null

Diff:
---
 gcc/fortran/trans-array.cc | 339 +++--
 gcc/fortran/trans-array.h  |   4 +-
 gcc/fortran/trans-expr.cc  |  87 ++--
 3 files changed, 373 insertions(+), 57 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a844342e5645..e09a9e85dfbf 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -592,10 +592,10 @@ get_size_info (gfc_typespec &ts)
if (POINTER_TYPE_P (type))
  type = TREE_TYPE (type);
gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
-   tree elt_type = TREE_TYPE (type);
+   tree char_type = TREE_TYPE (type);
tree len = ts.u.cl->backend_decl;
return fold_build2_loc (input_location, MULT_EXPR, size_type_node,
-   size_in_bytes (elt_type),
+   size_in_bytes (char_type),
fold_convert (size_type_node, len));
   }
 
@@ -613,8 +613,61 @@ get_size_info (gfc_typespec &ts)
 }
 
 
+class init_info
+{
+public:
+  virtual bool initialize_data () const { return false; }
+  virtual tree get_data_value () const { return NULL_TREE; }
+  virtual gfc_typespec *get_type () const { return nullptr; }
+};
+
+
+class default_init : public init_info
+{
+private:
+  const symbol_attribute &attr; 
+
+public:
+  default_init (const symbol_attribute &arg_attr) : attr(arg_attr) { }
+  virtual bool initialize_data () const { return !attr.pointer; }
+  virtual tree get_data_value () const {
+if (!initialize_data ())
+  return NULL_TREE;
+
+return null_pointer_node;
+  }
+};
+
+class nullification : public init_info
+{
+private:
+  gfc_typespec &ts;
+
+public:
+  nullification(gfc_typespec &arg_ts) : ts(arg_ts) { }
+  virtual bool initialize_data () const { return true; }
+  virtual tree get_data_value () const { return null_pointer_node; }
+  virtual gfc_typespec *get_type () const { return &ts; }
+};
+
+class scalar_value : public init_info
+{
+private:
+  gfc_typespec &ts;
+  tree value;
+
+public:
+  scalar_value(gfc_typespec &arg_ts, tree arg_value)
+: ts(arg_ts), value(arg_value) { }
+  virtual bool initialize_data () const { return true; }
+  virtual tree get_data_value () const { return value; }
+  virtual gfc_typespec *get_type () const { return &ts; }
+};
+
+
 static tree
-build_dtype (gfc_typespec &ts, int rank, const symbol_attribute &)
+build_dtype (gfc_typespec &ts, int rank, const symbol_attribute &,
+const init_info &init)
 {
   vec *v = nullptr;
 
@@ -622,11 +675,17 @@ build_dtype (gfc_typespec &ts, int rank, const 
symbol_attribute &)
 
   tree fields = TYPE_FIELDS (type);
 
-  if (ts.type != BT_CLASS)
+  gfc_typespec *type_info = init.get_type ();
+  if (type_info == nullptr)
+type_info = &ts;
+
+  if (!(type_info->type == BT_CLASS
+   || (type_info->type == BT_CHARACTER
+   && type_info->deferred)))
 {
   tree elem_len_field = gfc_advance_chain (fields, GFC_DTYPE_ELEM_LEN);
   tree elem_len_val = fold_convert (TREE_TYPE (elem_len_field),
-   get_size_info (ts));
+   get_size_info (*type_info));
   CONSTRUCTOR_APPEND_ELT (v, elem_len_field, elem_len_val);
 }
 
@@ -641,11 +700,11 @@ build_dtype (gfc_typespec &ts, int rank, const 
symbol_attribute &)
   CONSTRUCTOR_APPEND_ELT (v, rank_field, rank_val);
 }
 
-  if (ts.type != BT_CLASS)
+  if (type_info->type != BT_CLASS)
 {
   tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
   tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
- get_type_info (ts));
+ get_type_info (*type_info));
   CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
 }
 
@@ -656,8 +715,8 @@ build_dtype (gfc_typespec &ts, int rank, const 
symbol_attribute &)
 /* Build a null array descriptor constructor.  */
 
 vec *
-get_default_descriptor_init (tree type, gfc_typespec &ts, int rank,
-const symbol_attribute &attr)
+get_descriptor_init (tree type, gfc_typespec &ts, int rank,
+const symbol_attribute &attr, const init_info &init)
 {
   vec *v = nullptr;
 
@@ -666,15 +725,15 @@ get_default_descriptor_init (tree type, gfc_typespec &ts, 
int rank,
   tree fields = TYPE_FIELDS (type);
 
   /* Don't init pointers by default.  */
-  if 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Creation méthode initialisation descripteur

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:7f5761bd7335de4a2edcc91a0688a05957540cf6

commit 7f5761bd7335de4a2edcc91a0688a05957540cf6
Author: Mikael Morin 
Date:   Thu Dec 5 20:30:08 2024 +0100

Creation méthode initialisation descripteur

Utilisation méthode initialisation descripteur gfc_trans_deferred_array

Correction variable inutilisée

Correction segmentation fault

Correction regression allocatable attribute

Ajout conversion elem_len

conversion type longueur chaine

Initialisation descripteur champ par champ

Silence uninitialized warning.

Diff:
---
 gcc/fortran/expr.cc|  25 +++-
 gcc/fortran/gfortran.h |   1 +
 gcc/fortran/primary.cc |  84 +++-
 gcc/fortran/trans-array.cc | 286 +
 gcc/fortran/trans-intrinsic.cc |   2 +-
 5 files changed, 333 insertions(+), 65 deletions(-)

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e4ab3ba5bfa3..95c544eff01e 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5419,27 +5419,38 @@ gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
   gfc_ref *ref;
 
   if (expr->rank == 0)
-return NULL;
+return nullptr;
 
   /* Follow any component references.  */
   if (expr->expr_type == EXPR_VARIABLE
   || expr->expr_type == EXPR_CONSTANT)
 {
-  if (expr->symtree)
-   as = expr->symtree->n.sym->as;
+  gfc_symbol *sym = expr->symtree ? expr->symtree->n.sym : nullptr;
+  if (sym
+ && sym->ts.type == BT_CLASS)
+   as = CLASS_DATA (sym)->as;
+  else if (sym)
+   as = sym->as;
   else
-   as = NULL;
+   as = nullptr;
 
   for (ref = expr->ref; ref; ref = ref->next)
{
  switch (ref->type)
{
case REF_COMPONENT:
- as = ref->u.c.component->as;
+ {
+   gfc_component *comp = ref->u.c.component;
+   if (comp->ts.type == BT_CLASS)
+ as = CLASS_DATA (comp)->as;
+   else
+ as = comp->as;
+ }
  continue;
 
case REF_SUBSTRING:
case REF_INQUIRY:
+ as = nullptr;
  continue;
 
case REF_ARRAY:
@@ -5449,7 +5460,7 @@ gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
  case AR_ELEMENT:
  case AR_SECTION:
  case AR_UNKNOWN:
-   as = NULL;
+   as = nullptr;
continue;
 
  case AR_FULL:
@@ -5461,7 +5472,7 @@ gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
}
 }
   else
-as = NULL;
+as = nullptr;
 
   return as;
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fe127646152..5cadbf104e9d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4065,6 +4065,7 @@ const char *gfc_dt_lower_string (const char *);
 const char *gfc_dt_upper_string (const char *);
 
 /* primary.cc */
+symbol_attribute gfc_symbol_attr (gfc_symbol *);
 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
 symbol_attribute gfc_expr_attr (gfc_expr *);
 symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 8a38720422ec..c934841f4795 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2867,42 +2867,14 @@ check_substring:
 }
 
 
-/* Given an expression that is a variable, figure out what the
-   ultimate variable's type and attribute is, traversing the reference
-   structures if necessary.
-
-   This subroutine is trickier than it looks.  We start at the base
-   symbol and store the attribute.  Component references load a
-   completely new attribute.
-
-   A couple of rules come into play.  Subobjects of targets are always
-   targets themselves.  If we see a component that goes through a
-   pointer, then the expression must also be a target, since the
-   pointer is associated with something (if it isn't core will soon be
-   dumped).  If we see a full part or section of an array, the
-   expression is also an array.
-
-   We can have at most one full array reference.  */
-
 symbol_attribute
-gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
+gfc_symbol_attr (gfc_symbol *sym)
 {
-  int dimension, codimension, pointer, allocatable, target, optional;
+  int dimension, codimension, pointer, allocatable, target;
   symbol_attribute attr;
-  gfc_ref *ref;
-  gfc_symbol *sym;
-  gfc_component *comp;
-  bool has_inquiry_part;
-
-  if (expr->expr_type != EXPR_VARIABLE
-  && expr->expr_type != EXPR_FUNCTION
-  && !(expr->expr_type == EXPR_NULL && expr->ts.type != BT_UNKNOWN))
-gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable");
 
-  sym = expr->symtree->n.sym;
   attr = sym->attr;
 
-  optional = attr.optional;
   if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
 {
 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement shift descriptor vers gfc_conv_array_parameter

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:72de429c935ce380dd6a8d361823de697282a9da

commit 72de429c935ce380dd6a8d361823de697282a9da
Author: Mikael Morin 
Date:   Tue Dec 17 17:27:24 2024 +0100

Déplacement shift descriptor vers gfc_conv_array_parameter

Suppression variables inutilisées

Diff:
---
 gcc/fortran/trans-array.cc | 49 ++
 gcc/fortran/trans-array.h  |  2 +-
 gcc/fortran/trans-expr.cc  | 20 +--
 3 files changed, 43 insertions(+), 28 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e09a9e85dfbf..892fe7804284 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1151,6 +1151,43 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, 
tree desc,
 }
 
 
+static void
+conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+{
+  /* Apply a shift of the lbound when supplied.  */
+  for (int dim = 0; dim < rank; ++dim)
+gfc_conv_shift_descriptor_lbound (block, desc, dim,
+ gfc_index_one_node);
+}
+
+
+static bool
+keep_descriptor_lower_bound (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  /* Detect any array references with vector subscripts.  */
+  for (ref = e->ref; ref; ref = ref->next)
+if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
+   && ref->u.ar.type != AR_FULL)
+  {
+   int dim;
+   for (dim = 0; dim < ref->u.ar.dimen; dim++)
+ if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+   break;
+   if (dim < ref->u.ar.dimen)
+ break;
+  }
+
+  /* Array references with vector subscripts and non-variable
+ expressions need be converted to a one-based descriptor.  */
+  if (ref || e->expr_type != EXPR_VARIABLE)
+return false;
+
+  return true;
+}
+
+
 /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info).  */
 
 void
@@ -9454,7 +9491,7 @@ is_pointer (gfc_expr *e)
 void
 gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
  const gfc_symbol *fsym, const char *proc_name,
- tree *size, tree *lbshift, tree *packed)
+ tree *size, bool maybe_shift, tree *packed)
 {
   tree ptr;
   tree desc;
@@ -9691,13 +9728,9 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
  stmtblock_t block;
 
  gfc_init_block (&block);
- if (lbshift && *lbshift)
-   {
- /* Apply a shift of the lbound when supplied.  */
- for (int dim = 0; dim < expr->rank; ++dim)
-   gfc_conv_shift_descriptor_lbound (&block, se->expr, dim,
- *lbshift);
-   }
+ if (maybe_shift && !keep_descriptor_lower_bound (expr))
+   conv_shift_descriptor (&block, se->expr, expr->rank);
+
  tmp = gfc_class_data_get (ctree);
  if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
  && CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 78646275b4ec..17e3d08fdba0 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -158,7 +158,7 @@ tree gfc_get_array_span (tree, gfc_expr *);
 void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
 /* Convert an array for passing as an actual function parameter.  */
 void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool, const gfc_symbol *,
-  const char *, tree *, tree * = nullptr,
+  const char *, tree *, bool = false,
   tree * = nullptr);
 
 /* These work with both descriptors and descriptorless arrays.  */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 612a0b2dec00..622c388b3d18 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -991,8 +991,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
  stmtblock_t block;
  gfc_init_block (&block);
  gfc_ref *ref;
- int dim;
- tree lbshift = NULL_TREE;
 
  /* Array refs with sections indicate, that a for a formal argument
 expecting contiguous repacking needs to be done.  */
@@ -1005,25 +1003,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
  && (ref || e->rank != fsym->ts.u.derived->components->as->rank))
fsym->attr.contiguous = 1;
 
- /* Detect any array references with vector subscripts.  */
- for (ref = e->ref; ref; ref = ref->next)
-   if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
-   && ref->u.ar.type != AR_FULL)
- {
-   for (dim = 0; dim < ref->u.ar.dimen; dim++)
- if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
-   break;
-   if (dim < ref->u.ar.dimen)
- break;
- }
-

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Appel méthode shift descriptor dans gfc_trans_pointer_assignment

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:c8bb63c693de2d3b37305750a07f65b9ed52765e

commit c8bb63c693de2d3b37305750a07f65b9ed52765e
Author: Mikael Morin 
Date:   Tue Dec 17 22:37:18 2024 +0100

Appel méthode shift descriptor dans gfc_trans_pointer_assignment

Diff:
---
 gcc/fortran/trans-array.cc | 129 +++--
 gcc/fortran/trans-array.h  |   1 +
 gcc/fortran/trans-expr.cc  |  28 +-
 3 files changed, 129 insertions(+), 29 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 892fe7804284..ade9ca97a934 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1151,13 +1151,136 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, 
tree desc,
 }
 
 
+class lb_info
+{
+public:
+  virtual gfc_expr *lower_bound (int dim) const = 0;
+};
+
+
+class unset_lb : public lb_info
+{
+public:
+  virtual gfc_expr *lower_bound (int) const { return nullptr; }
+};
+
+
+class defined_lb : public lb_info
+{
+  int rank;
+  gfc_expr * const * lower_bounds;
+
+public:
+  defined_lb (int arg_rank, gfc_expr * const 
arg_lower_bounds[GFC_MAX_DIMENSIONS])
+: rank(arg_rank), lower_bounds(arg_lower_bounds) { }
+  virtual gfc_expr *lower_bound (int dim) const { return lower_bounds[dim]; }
+};
+
+
 static void
-conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+  const lb_info &info)
 {
   /* Apply a shift of the lbound when supplied.  */
   for (int dim = 0; dim < rank; ++dim)
-gfc_conv_shift_descriptor_lbound (block, desc, dim,
- gfc_index_one_node);
+{
+  gfc_expr *lb_expr = info.lower_bound(dim);
+
+  tree lower_bound;
+  if (lb_expr == nullptr)
+   lower_bound = gfc_index_one_node;
+  else
+   {
+ gfc_se lb_se;
+
+ gfc_init_se (&lb_se, nullptr);
+ gfc_conv_expr (&lb_se, lb_expr);
+
+ gfc_add_block_to_block (block, &lb_se.pre);
+ tree lb_var = gfc_create_var (TREE_TYPE (lb_se.expr), "lower_bound");
+ gfc_add_modify (block, lb_var, lb_se.expr);
+ gfc_add_block_to_block (block, &lb_se.post);
+
+ lower_bound = lb_var;
+   }
+
+  gfc_conv_shift_descriptor_lbound (block, desc, dim, lower_bound);
+}
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+{
+  conv_shift_descriptor (block, desc, rank, unset_lb ());
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+  gfc_expr * const lower_bounds[GFC_MAX_DIMENSIONS])
+{
+  conv_shift_descriptor (block, desc, rank, defined_lb (rank, lower_bounds));
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc,
+  const gfc_array_spec &as)
+{
+  conv_shift_descriptor (block, desc, as.rank, as.lower);
+}
+
+
+static void
+set_type (array_type &type, array_type value)
+{
+  gcc_assert (type == AS_UNKNOWN || type == value);
+  type = value;
+}
+
+
+static void
+array_ref_to_array_spec (const gfc_array_ref &ref, gfc_array_spec &spec)
+{
+  spec.rank = ref.dimen;
+  spec.corank = ref.codimen;
+
+  spec.type = AS_UNKNOWN;
+  spec.cotype = AS_ASSUMED_SIZE;
+
+  for (int dim = 0; dim < spec.rank + spec.corank; dim++)
+switch (ref.dimen_type[dim])
+  {
+  case DIMEN_ELEMENT:
+   spec.upper[dim] = ref.start[dim];
+   set_type (spec.type, AS_EXPLICIT);
+   break;
+
+  case DIMEN_RANGE:
+   spec.lower[dim] = ref.start[dim];
+   spec.upper[dim] = ref.end[dim];
+   if (spec.upper[dim] == nullptr)
+ set_type (spec.type, AS_DEFERRED);
+   else
+ set_type (spec.type, AS_EXPLICIT);
+   break;
+
+  default:
+   break;
+  }
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
+  const gfc_array_ref &ar)
+{
+  gfc_array_spec as;
+
+  array_ref_to_array_spec (ar, as);
+
+  conv_shift_descriptor (block, desc, as);
 }
 
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 17e3d08fdba0..3b05a2eb197a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -214,6 +214,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
 
 /* Shift lower bound of descriptor, updating ubound and offset.  */
 void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
 
 /* Add pre-loop scalarization code for intrinsic functions which require
special handling.  */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 622c388b3d18..8d563f84c7c5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11356,32 +11356,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, 
gfc_expr * expr2)
}
}
  else
-   {
- /* Bounds remapping.  Just shift the lower bounds.  */
-
- 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Utilisation de la méthode de nullification pour nullifier un pointeur

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:3d700e0aee30e10395e47532577cc186763a6264

commit 3d700e0aee30e10395e47532577cc186763a6264
Author: Mikael Morin 
Date:   Wed Dec 18 19:04:41 2024 +0100

Utilisation de la méthode de nullification pour nullifier un pointeur

Correction régression modifiable_p

Correction dump

Ajout assertion

Correction assertion même type

Diff:
---
 gcc/fortran/trans-array.cc  | 96 ++---
 gcc/fortran/trans-array.h   |  1 +
 gcc/fortran/trans-expr.cc   | 35 -
 gcc/testsuite/gfortran.dg/class_allocate_14.f90 |  2 +-
 4 files changed, 106 insertions(+), 28 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ade9ca97a934..d2004d3f8dab 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -545,9 +545,9 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree 
desc,
 
 
 static int
-get_type_info (const gfc_typespec &ts)
+get_type_info (const bt &type)
 {
-  switch (ts.type)
+  switch (type)
 {
 case BT_INTEGER:
 case BT_LOGICAL:
@@ -558,7 +558,7 @@ get_type_info (const gfc_typespec &ts)
 case BT_CLASS:
 case BT_VOID:
 case BT_UNSIGNED:
-  return ts.type;
+  return type;
 
 case BT_PROCEDURE:
 case BT_ASSUMED:
@@ -613,11 +613,34 @@ get_size_info (gfc_typespec &ts)
 }
 
 
-class init_info
+class modify_info
 {
 public:
+  virtual bool is_initialization () const { return false; }
   virtual bool initialize_data () const { return false; }
   virtual tree get_data_value () const { return NULL_TREE; }
+};
+
+class nullification : public modify_info
+{
+  virtual bool initialize_data () const { return true; }
+  virtual tree get_data_value () const { return null_pointer_node; }
+  /*
+private:
+  gfc_typespec &ts;
+
+public:
+  null_init(gfc_typespec &arg_ts) : ts(arg_ts) { }
+  virtual bool initialize_data () const { return true; }
+  virtual tree get_data_value () const { return null_pointer_node; }
+  virtual gfc_typespec *get_type () const { return &ts; }
+  */
+};
+
+class init_info : public modify_info
+{
+public:
+  virtual bool is_initialization () const { return true; }
   virtual gfc_typespec *get_type () const { return nullptr; }
 };
 
@@ -638,13 +661,13 @@ public:
   }
 };
 
-class nullification : public init_info
+class null_init : public init_info
 {
 private:
   gfc_typespec &ts;
 
 public:
-  nullification(gfc_typespec &arg_ts) : ts(arg_ts) { }
+  null_init(gfc_typespec &arg_ts) : ts(arg_ts) { }
   virtual bool initialize_data () const { return true; }
   virtual tree get_data_value () const { return null_pointer_node; }
   virtual gfc_typespec *get_type () const { return &ts; }
@@ -700,13 +723,12 @@ build_dtype (gfc_typespec &ts, int rank, const 
symbol_attribute &,
   CONSTRUCTOR_APPEND_ELT (v, rank_field, rank_val);
 }
 
-  if (type_info->type != BT_CLASS)
-{
-  tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
-  tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
- get_type_info (*type_info));
-  CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
-}
+  tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
+  tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
+ get_type_info (type_info->type == BT_CLASS
+? BT_DERIVED
+: type_info->type));
+  CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
 
   return build_constructor (type, v);
 }
@@ -715,8 +737,8 @@ build_dtype (gfc_typespec &ts, int rank, const 
symbol_attribute &,
 /* Build a null array descriptor constructor.  */
 
 vec *
-get_descriptor_init (tree type, gfc_typespec &ts, int rank,
-const symbol_attribute &attr, const init_info &init)
+get_descriptor_init (tree type, gfc_typespec *ts, int rank,
+const symbol_attribute *attr, const modify_info &init)
 {
   vec *v = nullptr;
 
@@ -732,11 +754,15 @@ get_descriptor_init (tree type, gfc_typespec &ts, int 
rank,
   CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
 }
 
-  tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
-  tree dtype_value = build_dtype (ts, rank, attr, init);
-  CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
+  if (init.is_initialization ())
+{
+  tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
+  tree dtype_value = build_dtype (*ts, rank, *attr,
+ static_cast (init));
+  CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
+}
 
-  if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
+  if (flag_coarray == GFC_FCOARRAY_LIB && attr->codimension)
 {
   /* Declare the variable static so its array descriptor stays present

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_expr_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:329a786f5aefab94a28a1c23e422fc699de79f21

commit 329a786f5aefab94a28a1c23e422fc699de79f21
Author: Mikael Morin 
Date:   Thu Jan 16 14:00:20 2025 +0100

Factorisation gfc_conv_expr_descriptor

Diff:
---
 gcc/fortran/trans-array.cc | 358 +++--
 1 file changed, 186 insertions(+), 172 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c8e39b952a7f..937472ac36e8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1542,6 +1542,25 @@ keep_descriptor_lower_bound (gfc_expr *e)
 }
 
 
+static void
+copy_descriptor (stmtblock_t *block, tree dest, tree src,
+gfc_expr *src_expr, bool subref)
+{
+  /* Copy the descriptor for pointer assignments.  */
+  gfc_add_modify (block, dest, src);
+
+  /* Add any offsets from subreferences.  */
+  gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+  /* and set the span field.  */
+  tree tmp;
+  if (src_expr->ts.type == BT_CHARACTER)
+tmp = gfc_conv_descriptor_span_get (src);
+  else
+tmp = gfc_get_array_span (src, src_expr);
+  gfc_conv_descriptor_span_set (block, dest, tmp);
+}
+
 /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info).  */
 
 void
@@ -8991,24 +9010,175 @@ is_explicit_coarray (gfc_expr *expr)
 
 
 static void
-copy_descriptor (stmtblock_t *block, tree dest, tree src,
-gfc_expr *src_expr, bool subref)
+set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
+   int rank, int corank, gfc_ss *ss, gfc_array_info *info,
+   tree lowers[GFC_MAX_DIMENSIONS],
+   tree uppers[GFC_MAX_DIMENSIONS],
+   bool unlimited_polymorphic, bool data_needed, bool subref)
 {
-  /* Copy the descriptor for pointer assignments.  */
-  gfc_add_modify (block, dest, src);
+  int ndim = info->ref ? info->ref->u.ar.dimen : rank;
 
-  /* Add any offsets from subreferences.  */
-  gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
-
-  /* and set the span field.  */
-  tree tmp;
-  if (src_expr->ts.type == BT_CHARACTER)
+  /* Set the span field.  */
+  tree tmp = NULL_TREE;
+  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
 tmp = gfc_conv_descriptor_span_get (src);
   else
 tmp = gfc_get_array_span (src, src_expr);
-  gfc_conv_descriptor_span_set (block, dest, tmp);
+  if (tmp)
+gfc_conv_descriptor_span_set (block, dest, tmp);
+
+  /* The following can be somewhat confusing.  We have two
+ descriptors, a new one and the original array.
+ {dest, parmtype, dim} refer to the new one.
+ {src, type, n, loop} refer to the original, which maybe
+ a descriptorless array.
+ The bounds of the scalarization are the bounds of the section.
+ We don't have to worry about numeric overflows when calculating
+ the offsets because all elements are within the array data.  */
+
+  /* Set the dtype.  */
+  tmp = gfc_conv_descriptor_dtype (dest);
+  tree dtype;
+  if (unlimited_polymorphic)
+dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
+  else if (src_expr->ts.type == BT_ASSUMED)
+{
+  tree tmp2 = src;
+  if (DECL_LANG_SPECIFIC (tmp2) && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
+   tmp2 = GFC_DECL_SAVED_DESCRIPTOR (tmp2);
+  if (POINTER_TYPE_P (TREE_TYPE (tmp2)))
+   tmp2 = build_fold_indirect_ref_loc (input_location, tmp2);
+  dtype = gfc_conv_descriptor_dtype (tmp2);
+}
+  else
+dtype = gfc_get_dtype (TREE_TYPE (dest));
+  gfc_add_modify (block, tmp, dtype);
+
+  /* The 1st element in the section.  */
+  tree base = gfc_index_zero_node;
+  if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
+base = gfc_index_one_node;
+
+  /* The offset from the 1st element in the section.  */
+  tree offset = gfc_index_zero_node;
+
+  for (int n = 0; n < ndim; n++)
+{
+  tree stride = gfc_conv_array_stride (src, n);
+
+  /* Work out the 1st element in the section.  */
+  tree start;
+  if (info->ref
+ && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+   {
+ gcc_assert (info->subscript[n]
+ && info->subscript[n]->info->type == GFC_SS_SCALAR);
+ start = info->subscript[n]->info->data.scalar.value;
+   }
+  else
+   {
+ /* Evaluate and remember the start of the section.  */
+ start = info->start[n];
+ stride = gfc_evaluate_now (stride, block);
+   }
+
+  tmp = gfc_conv_array_lbound (src, n);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
+start, tmp);
+  tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
+tmp, stride);
+  base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+   base, tmp);
+
+  if (info->ref
+ && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+   {
+ 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Refactor conv_shift_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:ac1169158100aaffa6eca198e70bf8ce99e9cb7b

commit ac1169158100aaffa6eca198e70bf8ce99e9cb7b
Author: Mikael Morin 
Date:   Thu Jan 16 15:28:38 2025 +0100

Refactor conv_shift_descriptor

Correction régressions

Correction régression gfc_conv_expr_descriptor

Diff:
---
 gcc/fortran/trans-array.cc | 31 +--
 gcc/fortran/trans-array.h  |  1 -
 2 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0274efe5256b..1fb378ae8c0e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1165,16 +1165,15 @@ gfc_build_null_descriptor (tree type)
 /* Modify a descriptor such that the lbound of a given dimension is the value
specified.  This also updates ubound and offset accordingly.  */
 
-void
-gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
- int dim, tree new_lbound)
+static void
+conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, int dim,
+ tree new_lbound, tree offset)
 {
-  tree offs, ubound, lbound, stride;
+  tree ubound, lbound, stride;
   tree diff, offs_diff;
 
   new_lbound = fold_convert (gfc_array_index_type, new_lbound);
 
-  offs = gfc_conv_descriptor_offset_get (desc);
   lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
   ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
   stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
@@ -1190,9 +1189,9 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, 
tree desc,
   gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
   offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
   diff, stride);
-  offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- offs, offs_diff);
-  gfc_conv_descriptor_offset_set (block, desc, offs);
+  tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ offset, offs_diff);
+  gfc_add_modify (block, offset, tmp);
 
   /* Finally set lbound to value we want.  */
   gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
@@ -1229,6 +1228,10 @@ static void
 conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
   const lb_info &info)
 {
+  tree tmp = gfc_conv_descriptor_offset_get (desc);
+  tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
+  gfc_add_modify (block, offset_var, tmp);
+
   /* Apply a shift of the lbound when supplied.  */
   for (int dim = 0; dim < rank; ++dim)
 {
@@ -1252,8 +1255,10 @@ conv_shift_descriptor (stmtblock_t *block, tree desc, 
int rank,
  lower_bound = lb_var;
}
 
-  gfc_conv_shift_descriptor_lbound (block, desc, dim, lower_bound);
+  conv_shift_descriptor_lbound (block, desc, dim, lower_bound, offset_var);
 }
+
+  gfc_conv_descriptor_offset_set (block, desc, offset_var);
 }
 
 
@@ -9225,7 +9230,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   bool subref_array_target = false;
   bool deferred_array_component = false;
   bool substr = false;
-  bool unlimited_polymorphic = false;
   gfc_expr *arg, *ss_expr;
 
   if (se->want_coarray || expr->rank == 0)
@@ -9251,7 +9255,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 }
 
   if (!se->direct_byref)
-unlimited_polymorphic = UNLIMITED_POLY (expr);
+se->unlimited_polymorphic = UNLIMITED_POLY (expr);
 
   /* Special case things we know we can pass easily.  */
   switch (expr->expr_type)
@@ -9655,9 +9659,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
  gfc_get_array_span (desc, expr)));
}
 
-
-  set_descriptor (&se->pre, parm, desc, expr, loop.dimen, codim,
- ss, info, loop.from, loop.to, unlimited_polymorphic,
+  set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
+ ss, info, loop.from, loop.to, se->unlimited_polymorphic,
  !se->data_not_needed, subref_array_target);
 
   desc = parm;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 378afb9617a3..3f39845c898f 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -214,7 +214,6 @@ tree gfc_get_cfi_dim_sm (tree, tree);
 
 
 /* Shift lower bound of descriptor, updating ubound and offset.  */
-void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, int);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation copie gfc_conv_expr_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:009cd156c6c0771df62f4f2fcf557e3289563c2d

commit 009cd156c6c0771df62f4f2fcf557e3289563c2d
Author: Mikael Morin 
Date:   Wed Jan 15 17:51:21 2025 +0100

Factorisation copie gfc_conv_expr_descriptor

Diff:
---
 gcc/fortran/trans-array.cc | 37 ++---
 1 file changed, 22 insertions(+), 15 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4d2fa5b52f09..c8e39b952a7f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8989,6 +8989,26 @@ is_explicit_coarray (gfc_expr *expr)
   return cas && cas->cotype == AS_EXPLICIT;
 }
 
+
+static void
+copy_descriptor (stmtblock_t *block, tree dest, tree src,
+gfc_expr *src_expr, bool subref)
+{
+  /* Copy the descriptor for pointer assignments.  */
+  gfc_add_modify (block, dest, src);
+
+  /* Add any offsets from subreferences.  */
+  gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+  /* and set the span field.  */
+  tree tmp;
+  if (src_expr->ts.type == BT_CHARACTER)
+tmp = gfc_conv_descriptor_span_get (src);
+  else
+tmp = gfc_get_array_span (src, src_expr);
+  gfc_conv_descriptor_span_set (block, dest, tmp);
+}
+
 /* Convert an array for passing as an actual argument.  Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed.  For whole arrays the descriptor is passed.  For array sections
@@ -9123,21 +9143,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   if (full && !transposed_dims (ss))
{
  if (se->direct_byref && !se->byref_noassign)
-   {
- /* Copy the descriptor for pointer assignments.  */
- gfc_add_modify (&se->pre, se->expr, desc);
-
- /* Add any offsets from subreferences.  */
- gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,
- subref_array_target, expr);
-
- /* and set the span field.  */
- if (ss_info->expr->ts.type == BT_CHARACTER)
-   tmp = gfc_conv_descriptor_span_get (desc);
- else
-   tmp = gfc_get_array_span (desc, expr);
- gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
-   }
+   copy_descriptor (&se->pre, se->expr, desc, expr,
+subref_array_target);
  else if (se->want_pointer)
{
  /* We pass full arrays directly.  This means that pointers and

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Introduction gfc_copy_sequence_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:9a4e837e3e345626fdc602ecad31dada5ec46ce0

commit 9a4e837e3e345626fdc602ecad31dada5ec46ce0
Author: Mikael Morin 
Date:   Tue Dec 31 15:27:35 2024 +0100

Introduction gfc_copy_sequence_descriptor

Correction régression sizeof_6

Diff:
---
 gcc/fortran/trans-array.cc | 39 ++-
 gcc/fortran/trans-expr.cc  | 44 
 gcc/fortran/trans.h|  1 +
 3 files changed, 59 insertions(+), 25 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d2004d3f8dab..c8624fffb81e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9902,32 +9902,21 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
  if (maybe_shift && !keep_descriptor_lower_bound (expr))
conv_shift_descriptor (&block, se->expr, expr->rank);
 
+ bool assumed_rank_fsym;
+ if (fsym
+ && ((fsym->ts.type == BT_CLASS
+  && CLASS_DATA (fsym)->as
+  && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
+ || (fsym->ts.type != BT_CLASS
+ && fsym->as
+ && fsym->as->type == AS_ASSUMED_RANK)))
+   assumed_rank_fsym = true;
+ else
+   assumed_rank_fsym = false;
+
  tmp = gfc_class_data_get (ctree);
- if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
- && CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
-   {
- tree arr = gfc_create_var (TREE_TYPE (tmp), "parm");
- gfc_conv_descriptor_data_set (&block, arr,
-   gfc_conv_descriptor_data_get (
- se->expr));
- gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
- gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (
-   &block, arr, gfc_index_zero_node,
-   gfc_conv_descriptor_size (se->expr, expr->rank));
- gfc_conv_descriptor_stride_set (
-   &block, arr, gfc_index_zero_node,
-   gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
- gfc_conv_descriptor_dtype (se->expr));
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
- gfc_conv_descriptor_span_set (&block, arr,
-   gfc_conv_descriptor_span_get (arr));
- gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
- se->expr = arr;
-   }
- gfc_class_array_data_assign (&block, tmp, se->expr, true);
+ gfc_copy_sequence_descriptor (block, tmp, se->expr,
+   assumed_rank_fsym);
 
  /* Handle optional.  */
  if (fsym && fsym->attr.optional && sym && sym->attr.optional)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4a6223e64bb3..e7a9182e8e7b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -846,6 +846,50 @@ descriptor_rank (tree descriptor)
 }
 
 
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+ bool assumed_rank_lhs)
+{
+  int lhs_rank = descriptor_rank (lhs_desc);
+  int rhs_rank = descriptor_rank (rhs_desc);
+  tree desc;
+
+  if (assumed_rank_lhs || lhs_rank == rhs_rank)
+desc = rhs_desc;
+  else
+{
+  tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+  gfc_conv_descriptor_data_set (&block, arr,
+   gfc_conv_descriptor_data_get (rhs_desc));
+  gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+  tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+  gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+  gfc_conv_descriptor_stride_set (
+   &block, arr, gfc_index_zero_node,
+   gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+  for (int i = 1; i < lhs_rank; i++)
+   {
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+   }
+  gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (rhs_desc));
+  gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_cha

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_remap_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:15f2f679c800ec01575ca82b59a46d4e975895b1

commit 15f2f679c800ec01575ca82b59a46d4e975895b1
Author: Mikael Morin 
Date:   Sat Jan 4 21:36:13 2025 +0100

Factorisation gfc_conv_remap_descriptor

Correction régression pointer_remapping_5

Diff:
---
 gcc/fortran/trans-array.cc | 119 +++
 gcc/fortran/trans-expr.cc  | 124 +++--
 gcc/fortran/trans.h|   2 +
 3 files changed, 129 insertions(+), 116 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c8624fffb81e..6741f5fea71e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1332,6 +1332,125 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree 
desc,
 }
 
 
+void
+gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
+  int src_rank, const gfc_array_spec &as)
+{
+  int dest_rank = gfc_descriptor_rank (dest);
+
+  /* Set dtype.  */
+  tree dtype = gfc_conv_descriptor_dtype (dest);
+  tree tmp = gfc_get_dtype (TREE_TYPE (src));
+  gfc_add_modify (block, dtype, tmp);
+
+  /* Copy data pointer.  */
+  tree data = gfc_conv_descriptor_data_get (src);
+  gfc_conv_descriptor_data_set (block, dest, data);
+
+  /* Copy the span.  */
+  tree span;
+  if (VAR_P (src)
+  && GFC_DECL_PTR_ARRAY_P (src))
+span = gfc_conv_descriptor_span_get (src);
+  else
+{
+  tmp = TREE_TYPE (src);
+  tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
+  span = fold_convert (gfc_array_index_type, tmp);
+}
+  gfc_conv_descriptor_span_set (block, dest, span);
+
+  /* Copy offset but adjust it such that it would correspond
+ to a lbound of zero.  */
+  if (src_rank == -1)
+gfc_conv_descriptor_offset_set (block, dest,
+   gfc_index_zero_node);
+  else
+{
+  tree offs = gfc_conv_descriptor_offset_get (src);
+  for (int dim = 0; dim < src_rank; ++dim)
+   {
+ tree stride = gfc_conv_descriptor_stride_get (src,
+   gfc_rank_cst[dim]);
+ tree lbound = gfc_conv_descriptor_lbound_get (src,
+   gfc_rank_cst[dim]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+gfc_array_index_type, stride,
+lbound);
+ offs = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, offs, tmp);
+   }
+  gfc_conv_descriptor_offset_set (block, dest, offs);
+}
+  /* Set the bounds as declared for the LHS and calculate strides as
+ well as another offset update accordingly.  */
+  tree stride = gfc_conv_descriptor_stride_get (src,
+  gfc_rank_cst[0]);
+  for (int dim = 0; dim < dest_rank; ++dim)
+{
+  gfc_se lower_se;
+  gfc_se upper_se;
+
+  gcc_assert (as.lower[dim] && as.upper[dim]);
+
+  /* Convert declared bounds.  */
+  gfc_init_se (&lower_se, NULL);
+  gfc_init_se (&upper_se, NULL);
+  gfc_conv_expr (&lower_se, as.lower[dim]);
+  gfc_conv_expr (&upper_se, as.upper[dim]);
+
+  gfc_add_block_to_block (block, &lower_se.pre);
+  gfc_add_block_to_block (block, &upper_se.pre);
+
+  tree lbound = fold_convert (gfc_array_index_type, lower_se.expr);
+  tree ubound = fold_convert (gfc_array_index_type, upper_se.expr);
+
+  lbound = gfc_evaluate_now (lbound, block);
+  ubound = gfc_evaluate_now (ubound, block);
+
+  gfc_add_block_to_block (block, &lower_se.post);
+  gfc_add_block_to_block (block, &upper_se.post);
+
+  /* Set bounds in descriptor.  */
+  gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[dim], lbound);
+  gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[dim], ubound);
+
+  /* Set stride.  */
+  stride = gfc_evaluate_now (stride, block);
+  gfc_conv_descriptor_stride_set (block, dest,
+ gfc_rank_cst[dim], stride);
+
+  /* Update offset.  */
+  tree offs = gfc_conv_descriptor_offset_get (dest);
+  tmp = fold_build2_loc (input_location, MULT_EXPR,
+gfc_array_index_type, lbound, stride);
+  offs = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offs, tmp);
+  offs = gfc_evaluate_now (offs, block);
+  gfc_conv_descriptor_offset_set (block, dest, offs);
+
+  /* Update stride.  */
+  tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+  stride = fold_build2_loc (input_location, MULT_EXPR,
+   gfc_array_index_type, stride, tmp);
+}
+}
+
+
+void
+gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
+  int src_rank, const gfc_array_ref &ar)
+{
+  g

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Extraction fonction fcncall_realloc_result

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:af9fdd6032cbcdba003734359802d6d1c65a101d

commit af9fdd6032cbcdba003734359802d6d1c65a101d
Author: Mikael Morin 
Date:   Thu Jan 9 21:38:39 2025 +0100

Extraction fonction fcncall_realloc_result

Correction variable inutilisée

Correction régression coarray dummy_3

Correction régression dummy_3

Diff:
---
 gcc/fortran/trans-array.cc | 64 ++
 gcc/fortran/trans-array.h  |  1 +
 gcc/fortran/trans-expr.cc  | 52 +++--
 3 files changed, 80 insertions(+), 37 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6741f5fea71e..4d2fa5b52f09 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1451,6 +1451,70 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree 
dest, tree src,
 }
 
 
+class conditional_lb
+{
+  tree cond;
+public:
+  conditional_lb (tree arg_cond)
+: cond (arg_cond) { }
+
+  tree lower_bound (tree src, int n) const {
+tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[n]);
+lbound = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, cond,
+ gfc_index_one_node, lbound);
+return lbound;
+  }
+};
+
+
+static void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+  int rank, const conditional_lb &lb)
+{
+  tree tmp = gfc_conv_descriptor_data_get (src);
+  gfc_conv_descriptor_data_set (block, dest, tmp);
+
+  tree offset = gfc_index_zero_node;
+  for (int n = 0 ; n < rank; n++)
+{
+  tree lbound;
+
+  lbound = lb.lower_bound (dest, n);
+  lbound = gfc_evaluate_now (lbound, block);
+
+  tmp = gfc_conv_descriptor_ubound_get (src, gfc_rank_cst[n]);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp, lbound);
+  gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[n], lbound);
+  gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[n], tmp);
+
+  /* Set stride and accumulate the offset.  */
+  tmp = gfc_conv_descriptor_stride_get (src, gfc_rank_cst[n]);
+  gfc_conv_descriptor_stride_set (block, dest,
+ gfc_rank_cst[n], tmp);
+  tmp = fold_build2_loc (input_location, MULT_EXPR,
+gfc_array_index_type, lbound, tmp);
+  offset = fold_build2_loc (input_location, MINUS_EXPR,
+   gfc_array_index_type, offset, tmp);
+  offset = gfc_evaluate_now (offset, block);
+}
+
+  gfc_conv_descriptor_offset_set (block, dest, offset);
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+  int rank, tree zero_cond)
+{
+  gfc_conv_shift_descriptor (block, dest, src, rank,
+conditional_lb (zero_cond));
+}
+
+
 static bool
 keep_descriptor_lower_bound (gfc_expr *e)
 {
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 8df55c2c00a5..571322ae11ff 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -216,6 +216,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
 /* Shift lower bound of descriptor, updating ubound and offset.  */
 void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
 
 /* Add pre-loop scalarization code for intrinsic functions which require
special handling.  */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6f1d6d84ec57..f46671bff8d7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -832,6 +832,9 @@ gfc_get_vptr_from_expr (tree expr)
 int
 gfc_descriptor_rank (tree descriptor)
 {
+  if (TREE_TYPE (descriptor) != NULL_TREE)
+return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
   tree dim = gfc_get_descriptor_dimension (descriptor);
   tree dim_type = TREE_TYPE (dim);
   gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
@@ -916,8 +919,17 @@ gfc_class_array_data_assign (stmtblock_t *block, tree 
lhs_desc, tree rhs_desc,
 type = TREE_TYPE (tmp);
   else
 {
-  gcc_assert (TREE_TYPE (tmp) == TREE_TYPE (tmp2));
-  type = TREE_TYPE (tmp);
+  int corank = GFC_TYPE_ARRAY_CORANK (TREE_TYPE (lhs_desc));
+  int corank2 = GFC_TYPE_ARRAY_CORANK (TREE_TYPE (rhs_desc));
+  if (corank > 0 && corank2 == 0)
+   type = TREE_TYPE (tmp2);
+  else if (corank2 > 0 && corank == 0)
+   type = TREE_TYPE (tmp);
+  else
+   {
+ gcc_assert (TREE_TYPE (tmp) == TREE_TYPE (tmp2));
+ type = TREE_TYPE (tmp);
+   }
 }
 
   tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
@@ -11771,7 +11783,6 @@ fcncall_realloc_result (g

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:918498073cf3eb30f84afae0d68855d163908906

commit 918498073cf3eb30f84afae0d68855d163908906
Author: Mikael Morin 
Date:   Thu Jan 16 14:51:42 2025 +0100

Factorisation shift descriptor

Diff:
---
 gcc/fortran/trans-expr.cc | 7 +--
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f46671bff8d7..0f027d2d650f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1219,7 +1219,6 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
   tree ctree;
   tree var;
   tree tmp;
-  int dim;
   bool unlimited_poly;
 
   unlimited_poly = class_ts.type == BT_CLASS
@@ -1287,11 +1286,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
  /* Array references with vector subscripts and non-variable 
expressions
 need be converted to a one-based descriptor.  */
  if (e->expr_type != EXPR_VARIABLE)
-   {
- for (dim = 0; dim < e->rank; ++dim)
-   gfc_conv_shift_descriptor_lbound (&parmse->pre, parmse->expr,
- dim, gfc_index_one_node);
-   }
+   gfc_conv_shift_descriptor (&parmse->pre, parmse->expr, e->rank);
 
  if (class_ts.u.derived->components->as->rank != e->rank)
{

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Suppression modif offset trans_associate_var

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:d0cb386bd235e86f8ca3946cd3145429399300ca

commit d0cb386bd235e86f8ca3946cd3145429399300ca
Author: Mikael Morin 
Date:   Mon Feb 17 14:43:06 2025 +0100

Suppression modif offset trans_associate_var

Diff:
---
 gcc/fortran/trans-stmt.cc | 15 ---
 1 file changed, 15 deletions(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 4406bc6e4ce2..077630ee0026 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2134,21 +2134,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
 
  desc = gfc_class_data_get (se.expr);
 
- /* Set the offset.  */
- offset = gfc_index_zero_node;
- for (n = 0; n < e->rank; n++)
-   {
- dim = gfc_rank_cst[n];
- tmp = fold_build2_loc (input_location, MULT_EXPR,
-gfc_array_index_type,
-gfc_conv_descriptor_stride_get (desc, dim),
-gfc_conv_descriptor_lbound_get (desc, 
dim));
- offset = fold_build2_loc (input_location, MINUS_EXPR,
-   gfc_array_index_type,
-   offset, tmp);
-   }
- gfc_conv_descriptor_offset_set (&se.pre, desc, offset);
-
  if (need_len_assign)
{
  if (e->symtree

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Essai suppression code inutile

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:80ddc856be6f06809228bc393a8be6492b00552f

commit 80ddc856be6f06809228bc393a8be6492b00552f
Author: Mikael Morin 
Date:   Fri Feb 14 13:50:51 2025 +0100

Essai suppression code inutile

Diff:
---
 gcc/fortran/trans-expr.cc | 10 --
 1 file changed, 10 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ef8d69cb9162..d13b7d9e61d4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5473,16 +5473,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, 
int g77,
   /* Translate the expression.  */
   gfc_conv_expr (&rse, expr);
 
-  /* Reset the offset for the function call since the loop
- is zero based on the data pointer.  Note that the temp
- comes first in the loop chain since it is added second.  */
-  if (gfc_is_class_array_function (expr))
-{
-  tmp = loop.ss->loop_chain->info->data.array.descriptor;
-  gfc_conv_descriptor_offset_set (&loop.pre, tmp,
- gfc_index_zero_node);
-}
-
   gfc_conv_tmp_array_ref (&lse);
 
   if (intent != INTENT_OUT)

[gcc r15-7590] c++: add fixed test [PR96364]

[Marek Polacek via Gcc-cvs]

https://gcc.gnu.org/g:5954c5a7c23fbdf3afc011d703c9fce15db04cbd

commit r15-7590-g5954c5a7c23fbdf3afc011d703c9fce15db04cbd
Author: Marek Polacek 
Date:   Mon Feb 17 12:12:55 2025 -0500

c++: add fixed test [PR96364]

We were rejecting this, but the test compiles correctly since r14-6346.

PR c++/96364

gcc/testsuite/ChangeLog:

* g++.dg/cpp0x/gen-attrs-88.C: New test.

Diff:
---
 gcc/testsuite/g++.dg/cpp0x/gen-attrs-88.C | 14 ++
 1 file changed, 14 insertions(+)

diff --git a/gcc/testsuite/g++.dg/cpp0x/gen-attrs-88.C 
b/gcc/testsuite/g++.dg/cpp0x/gen-attrs-88.C
new file mode 100644
index ..f90b7a4661dc
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/gen-attrs-88.C
@@ -0,0 +1,14 @@
+// PR c++/96364
+// { dg-do compile { target c++14 } }
+
+auto a[[]] [[]]();
+auto a() {}
+
+void v[[]] [[]]();
+void v() {}
+
+void g()
+{
+  v();
+  return a();
+}

[gcc r15-7591] c++: extended temps and statement-exprs [PR118763]

[Jason Merrill via Gcc-cvs]

https://gcc.gnu.org/g:720c8f685210af9fc9c31810e224751102f1481e

commit r15-7591-g720c8f685210af9fc9c31810e224751102f1481e
Author: Jason Merrill 
Date:   Sun Feb 16 11:00:36 2025 +0100

c++: extended temps and statement-exprs [PR118763]

My last patch for 118856 broke the test for 118763 (which my testing didn't
catch, for some reason), because it effectively reverted Jakub's recent fix
(r15-7415) for that bug.  It seems we need a new flag to indicate internal
temporaries.

In that patch Jakub wondered if other uses of CLEANUP_EH_ONLY would have the
same issue with jumps out of a statement-expr, and indeed it seems that
maybe_push_temp_cleanup and now set_up_extended_ref_temp have the same
problem.  Since maybe_push_temp_cleanup already uses a flag, we can easily
stop setting CLEANUP_EH_ONLY there as well.  Since set_up_extended_ref_temp
doesn't, working around this issue there will be more involved.

PR c++/118856
PR c++/118763

gcc/cp/ChangeLog:

* cp-tree.h (TARGET_EXPR_INTERNAL_P): New.
* call.cc (extend_temps_r): Check it instead of CLEANUP_EH_ONLY.
* tree.cc (get_internal_target_expr): Set it instead.
* typeck2.cc (maybe_push_temp_cleanup): Don't set CLEANUP_EH_ONLY.

gcc/testsuite/ChangeLog:

* g++.dg/ext/stmtexpr29.C: New test.

Diff:
---
 gcc/cp/cp-tree.h  |  6 ++
 gcc/cp/call.cc|  9 ++---
 gcc/cp/tree.cc|  4 +---
 gcc/cp/typeck2.cc |  1 -
 gcc/testsuite/g++.dg/ext/stmtexpr29.C | 27 +++
 5 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index 84bcbf29fa02..8866d5e2c2b9 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -514,6 +514,7 @@ extern GTY(()) tree cp_global_trees[CPTI_MAX];
   OVL_LOOKUP_P (in OVERLOAD)
   LOOKUP_FOUND_P (in RECORD_TYPE, UNION_TYPE, ENUMERAL_TYPE, 
NAMESPACE_DECL)
   FNDECL_MANIFESTLY_CONST_EVALUATED (in FUNCTION_DECL)
+  TARGET_EXPR_INTERNAL_P (in TARGET_EXPR)
5: IDENTIFIER_VIRTUAL_P (in IDENTIFIER_NODE)
   FUNCTION_RVALUE_QUALIFIED (in FUNCTION_TYPE, METHOD_TYPE)
   CALL_EXPR_REVERSE_ARGS (in CALL_EXPR, AGGR_INIT_EXPR)
@@ -5608,6 +5609,11 @@ decl_template_parm_check (const_tree t, const char *f, 
int l, const char *fn)
 #define TARGET_EXPR_ELIDING_P(NODE) \
   TREE_LANG_FLAG_3 (TARGET_EXPR_CHECK (NODE))
 
+/* True if this TARGET_EXPR is for holding an implementation detail like a
+   cleanup flag or loop index, and should be ignored by extend_all_temps.  */
+#define TARGET_EXPR_INTERNAL_P(NODE) \
+  TREE_LANG_FLAG_4 (TARGET_EXPR_CHECK (NODE))
+
 /* True if NODE is a TARGET_EXPR that just expresses a copy of its INITIAL; if
the initializer has void type, it's doing something more complicated.  */
 #define SIMPLE_TARGET_EXPR_P(NODE) \
diff --git a/gcc/cp/call.cc b/gcc/cp/call.cc
index 03130f80f861..be9b0cf62f10 100644
--- a/gcc/cp/call.cc
+++ b/gcc/cp/call.cc
@@ -14922,10 +14922,13 @@ extend_temps_r (tree *tp, int *walk_subtrees, void 
*data)
   if (TREE_CODE (*p) == TARGET_EXPR
   /* An eliding TARGET_EXPR isn't a temporary at all.  */
   && !TARGET_EXPR_ELIDING_P (*p)
-  /* A TARGET_EXPR with CLEANUP_EH_ONLY is an artificial variable used
-during initialization, and need not be extended.  */
-  && !CLEANUP_EH_ONLY (*p))
+  /* A TARGET_EXPR with TARGET_EXPR_INTERNAL_P is an artificial variable
+used during initialization that need not be extended.  */
+  && !TARGET_EXPR_INTERNAL_P (*p))
 {
+  /* A CLEANUP_EH_ONLY expr should also have TARGET_EXPR_INTERNAL_P.  */
+  gcc_checking_assert (!CLEANUP_EH_ONLY (*p));
+
   tree subinit = NULL_TREE;
   tree slot = TARGET_EXPR_SLOT (*p);
   *p = set_up_extended_ref_temp (d->decl, *p, d->cleanups, &subinit,
diff --git a/gcc/cp/tree.cc b/gcc/cp/tree.cc
index 611930b3c286..5628a576f01b 100644
--- a/gcc/cp/tree.cc
+++ b/gcc/cp/tree.cc
@@ -984,9 +984,7 @@ get_internal_target_expr (tree init)
   init = convert_bitfield_to_declared_type (init);
   tree t = build_target_expr_with_type (init, TREE_TYPE (init),
tf_warning_or_error);
-  /* No internal variable should have a cleanup on the normal path, and
- extend_temps_r checks this flag to decide whether to extend.  */
-  CLEANUP_EH_ONLY (t) = true;
+  TARGET_EXPR_INTERNAL_P (t) = true;
   return t;
 }
 
diff --git a/gcc/cp/typeck2.cc b/gcc/cp/typeck2.cc
index 2555e9c1b645..1adc05aa86dc 100644
--- a/gcc/cp/typeck2.cc
+++ b/gcc/cp/typeck2.cc
@@ -459,7 +459,6 @@ maybe_push_temp_cleanup (tree sub, vec **flags)
 {
   tree tx = get_internal_target_expr (boolean_true_node);
   tree flag = TARGET_EXPR_SLOT (tx);
-  CLEANUP_EH_ONLY (tx) = true;
   TARGET_EXPR_CLEANUP (tx) = build3 (C

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:4935261e0ce6485135fbe03e27e1312db6ad5e95

commit 4935261e0ce6485135fbe03e27e1312db6ad5e95
Author: Mikael Morin 
Date:   Tue Jan 21 22:27:02 2025 +0100

Factorisation shift descriptor

Diff:
---
 gcc/fortran/trans-array.cc | 117 -
 gcc/fortran/trans-array.h  |   1 +
 gcc/fortran/trans-expr.cc  |  82 ++-
 3 files changed, 100 insertions(+), 100 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8054f49977ff..045c89451fb1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1198,16 +1198,52 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree 
desc, int dim,
 }
 
 
-class lb_info
+class lb_info_base
 {
 public:
+  virtual tree lower_bound (stmtblock_t *block, int dim) const = 0;
+};
+
+
+class lb_info : public lb_info_base
+{
+public:
+  using lb_info_base::lower_bound;
   virtual gfc_expr *lower_bound (int dim) const = 0;
+  virtual tree lower_bound (stmtblock_t *block, int dim) const;
 };
 
 
+tree
+lb_info::lower_bound (stmtblock_t *block, int dim) const
+{
+  gfc_expr *lb_expr = lower_bound(dim);
+
+  if (lb_expr == nullptr)
+return gfc_index_one_node;
+  else
+{
+  gfc_se lb_se;
+
+  gfc_init_se (&lb_se, nullptr);
+  gfc_conv_expr (&lb_se, lb_expr);
+
+  gfc_add_block_to_block (block, &lb_se.pre);
+  tree lb_var = gfc_create_var (gfc_array_index_type, "lower_bound");
+  gfc_add_modify (block, lb_var,
+ fold_convert (gfc_array_index_type, lb_se.expr));
+  gfc_add_block_to_block (block, &lb_se.post);
+
+  return lb_var;
+}
+}
+
+
+
 class unset_lb : public lb_info
 {
 public:
+  using lb_info::lower_bound;
   virtual gfc_expr *lower_bound (int) const { return nullptr; }
 };
 
@@ -1218,6 +1254,7 @@ class defined_lb : public lb_info
   gfc_expr * const * lower_bounds;
 
 public:
+  using lb_info::lower_bound;
   defined_lb (int arg_rank, gfc_expr * const 
arg_lower_bounds[GFC_MAX_DIMENSIONS])
 : rank(arg_rank), lower_bounds(arg_lower_bounds) { }
   virtual gfc_expr *lower_bound (int dim) const { return lower_bounds[dim]; }
@@ -1226,7 +1263,7 @@ public:
 
 static void
 conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
-  const lb_info &info)
+  const lb_info_base &info)
 {
   tree tmp = gfc_conv_descriptor_offset_get (desc);
   tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
@@ -1235,26 +1272,7 @@ conv_shift_descriptor (stmtblock_t *block, tree desc, 
int rank,
   /* Apply a shift of the lbound when supplied.  */
   for (int dim = 0; dim < rank; ++dim)
 {
-  gfc_expr *lb_expr = info.lower_bound(dim);
-
-  tree lower_bound;
-  if (lb_expr == nullptr)
-   lower_bound = gfc_index_one_node;
-  else
-   {
- gfc_se lb_se;
-
- gfc_init_se (&lb_se, nullptr);
- gfc_conv_expr (&lb_se, lb_expr);
-
- gfc_add_block_to_block (block, &lb_se.pre);
- tree lb_var = gfc_create_var (TREE_TYPE (lb_se.expr), "lower_bound");
- gfc_add_modify (block, lb_var, lb_se.expr);
- gfc_add_block_to_block (block, &lb_se.post);
-
- lower_bound = lb_var;
-   }
-
+  tree lower_bound = info.lower_bound (block, dim);
   conv_shift_descriptor_lbound (block, desc, dim, lower_bound, offset_var);
 }
 
@@ -1337,6 +1355,61 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
 }
 
 
+class dataref_lb : public lb_info_base
+{
+  gfc_array_spec *as;
+  gfc_expr *conv_arg;
+  tree desc;
+
+public:
+  dataref_lb (gfc_array_spec *arg_as, gfc_expr *arg_conv_arg, tree arg_desc)
+: as(arg_as), conv_arg (arg_conv_arg), desc (arg_desc)
+  {}
+  virtual tree lower_bound (stmtblock_t *block, int dim) const;
+};
+
+
+tree
+dataref_lb::lower_bound (stmtblock_t *block, int dim) const
+{
+  tree lbound;
+  if (as && as->lower[dim])
+{
+  gfc_se lbse;
+  gfc_init_se (&lbse, NULL);
+  gfc_conv_expr (&lbse, as->lower[dim]);
+  gfc_add_block_to_block (block, &lbse.pre);
+  lbound = gfc_evaluate_now (lbse.expr, block);
+}
+  else if (as && conv_arg)
+{
+  tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+  lbound = gfc_conv_descriptor_lbound_get (tmp, gfc_rank_cst[dim]);
+}
+  else if (as)
+lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
+  else
+lbound = gfc_index_one_node;
+
+  return fold_convert (gfc_array_index_type, lbound);
+}
+
+
+void
+gfc_conv_shift_descriptor_subarray (stmtblock_t *block, tree desc,
+   gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+  /* Obtain the array spec of full array references.  */
+  gfc_array_spec *as;
+  if (conv_arg)
+as = gfc_get_full_arrayspec_from_expr (conv_arg);
+  else
+as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+  conv_shift_descriptor (block, desc, value_expr->rank, dataref_lb (as, 
conv

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Introduction gfc_conv_descriptor_extent_get

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:03f52cab523b7b26aed4b3f878ce8c5c90feaccf

commit 03f52cab523b7b26aed4b3f878ce8c5c90feaccf
Author: Mikael Morin 
Date:   Wed Jan 22 19:02:13 2025 +0100

Introduction gfc_conv_descriptor_extent_get

Diff:
---
 gcc/fortran/trans-array.cc | 84 ++
 gcc/fortran/trans-array.h  |  1 +
 gcc/fortran/trans-expr.cc  |  6 +---
 3 files changed, 50 insertions(+), 41 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 045c89451fb1..92931cd7d8e9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -544,6 +544,51 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree 
desc,
 }
 
 
+/* Calculate the size of a given array dimension from the bounds.  This
+   is simply (ubound - lbound + 1) if this expression is positive
+   or 0 if it is negative (pick either one if it is zero).  Optionally
+   (if or_expr is present) OR the (expression != 0) condition to it.  */
+
+static tree
+conv_array_extent_dim (tree lbound, tree ubound, bool maybe_negative, tree* 
or_expr)
+{
+  tree res;
+  tree cond;
+
+  /* Calculate (ubound - lbound + 1).  */
+  res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ubound, lbound);
+  res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
+gfc_index_one_node);
+
+  /* Check whether the size for this dimension is negative.  */
+  if (maybe_negative)
+{
+  cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
+ gfc_index_zero_node);
+  res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, 
cond,
+gfc_index_zero_node, res);
+}
+
+  /* Build OR expression.  */
+  if (maybe_negative && or_expr)
+*or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+   logical_type_node, *or_expr, cond);
+
+  return res;
+}
+
+
+tree
+gfc_conv_descriptor_extent_get (tree desc, tree dim)
+{
+  tree ubound = gfc_conv_descriptor_ubound_get (desc, dim);
+  tree lbound = gfc_conv_descriptor_lbound_get (desc, dim);
+
+  return conv_array_extent_dim (lbound, ubound, false, NULL);
+}
+
+
 static int
 get_type_info (const bt &type)
 {
@@ -7111,30 +7156,9 @@ gfc_set_delta (gfc_loopinfo *loop)
 tree
 gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
 {
-  tree res;
-  tree cond;
-
-  /* Calculate (ubound - lbound + 1).  */
-  res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-ubound, lbound);
-  res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
-gfc_index_one_node);
-
-  /* Check whether the size for this dimension is negative.  */
-  cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
- gfc_index_zero_node);
-  res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
-gfc_index_zero_node, res);
-
-  /* Build OR expression.  */
-  if (or_expr)
-*or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
-   logical_type_node, *or_expr, cond);
-
-  return res;
+  return conv_array_extent_dim (lbound, ubound, true, or_expr);
 }
 
-
 /* For an array descriptor, get the total number of elements.  This is just
the product of the extents along from_dim to to_dim.  */
 
@@ -7148,14 +7172,7 @@ gfc_conv_descriptor_size_1 (tree desc, int from_dim, int 
to_dim)
 
   for (dim = from_dim; dim < to_dim; ++dim)
 {
-  tree lbound;
-  tree ubound;
-  tree extent;
-
-  lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
-  ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
-
-  extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+  tree extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[dim]);
   res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 res, extent);
 }
@@ -10549,12 +10566,7 @@ gfc_full_array_size (stmtblock_t *block, tree decl, 
int rank)
   tree nelems;
   tree tmp;
   idx = gfc_rank_cst[rank - 1];
-  nelems = gfc_conv_descriptor_ubound_get (decl, idx);
-  tmp = gfc_conv_descriptor_lbound_get (decl, idx);
-  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-nelems, tmp);
-  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-tmp, gfc_index_one_node);
+  tmp = gfc_conv_descriptor_extent_get (decl, idx);
   tmp = gfc_evaluate_now (tmp, block);
 
   nelems = gfc_conv_descriptor_stride_get (decl, idx);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index f9988a5fd109..1d694989b4c3 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -194,6 +194,7 @@ tree gfc_get_descriptor_

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:071c00a36f24b6f93f1fffc2dcab88a2dc5f3954

commit 071c00a36f24b6f93f1fffc2dcab88a2dc5f3954
Author: Mikael Morin 
Date:   Thu Jan 16 14:35:14 2025 +0100

Factorisation shift descriptor

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 937472ac36e8..0274efe5256b 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1257,8 +1257,8 @@ conv_shift_descriptor (stmtblock_t *block, tree desc, int 
rank,
 }
 
 
-static void
-conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+void
+gfc_conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
 {
   conv_shift_descriptor (block, desc, rank, unset_lb ());
 }
@@ -10104,7 +10104,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
 
  gfc_init_block (&block);
  if (maybe_shift && !keep_descriptor_lower_bound (expr))
-   conv_shift_descriptor (&block, se->expr, expr->rank);
+   gfc_conv_shift_descriptor (&block, se->expr, expr->rank);
 
  bool assumed_rank_fsym;
  if (fsym
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 571322ae11ff..378afb9617a3 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -216,6 +216,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
 /* Shift lower bound of descriptor, updating ubound and offset.  */
 void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, int);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
 
 /* Add pre-loop scalarization code for intrinsic functions which require
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index e7da8fea3b24..01fb8d91007f 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2007,16 +2007,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
   if ((!sym->assoc->variable && !cst_array_ctor)
  || !whole_array)
{
- int dim;
-
  if (whole_array)
gfc_add_modify (&se.pre, desc, se.expr);
 
  /* The generated descriptor has lower bound zero (as array
 temporary), shift bounds so we get lower bounds of 1.  */
- for (dim = 0; dim < e->rank; ++dim)
-   gfc_conv_shift_descriptor_lbound (&se.pre, desc,
- dim, gfc_index_one_node);
+ gfc_conv_shift_descriptor (&se.pre, desc, e->rank);
}
 
   /* If this is a subreference array pointer associate name use the

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_contiguous_array

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:6fa9a2db099871c059ce4efb5698d3b7d501c0aa

commit 6fa9a2db099871c059ce4efb5698d3b7d501c0aa
Author: Mikael Morin 
Date:   Fri Jan 17 17:25:59 2025 +0100

Factorisation set_contiguous_array

Diff:
---
 gcc/fortran/trans-array.cc | 57 +++---
 1 file changed, 29 insertions(+), 28 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0541fb11af57..9b8e9524d0d6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10691,6 +10691,23 @@ gfc_caf_is_dealloc_only (int caf_mode)
 }
 
 
+static void
+set_contiguous_array (stmtblock_t *block, tree desc, tree size, tree data_ptr)
+{
+  gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
+ gfc_get_dtype_rank_type (1, TREE_TYPE (desc)));
+  gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_index_zero_node,
+ gfc_index_one_node);
+  gfc_conv_descriptor_stride_set (block, desc,
+ gfc_index_zero_node,
+ gfc_index_one_node);
+  gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_index_zero_node, size);
+  gfc_conv_descriptor_data_set (block, desc, data_ptr);
+}
+
+
 /* Recursively traverse an object of derived type, generating code to
deallocate, nullify or copy allocatable components.  This is the work horse
function for the functions named in this enum.  */
@@ -10951,32 +10968,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  ubound = build_int_cst (gfc_array_index_type, 1);
}
 
- /* Treat strings like arrays.  Or the other way around, do not
-  * generate an additional array layer for scalar components.  */
- if (attr->dimension || c->ts.type == BT_CHARACTER)
-   {
- cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
-&ubound, 1,
-GFC_ARRAY_ALLOCATABLE, false);
-
- cdesc = gfc_create_var (cdesc, "cdesc");
- DECL_ARTIFICIAL (cdesc) = 1;
-
- gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc),
- gfc_get_dtype_rank_type (1, tmp));
- gfc_conv_descriptor_lbound_set (&tmpblock, cdesc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_stride_set (&tmpblock, cdesc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&tmpblock, cdesc,
- gfc_index_zero_node, ubound);
-   }
- else
-   /* Prevent warning.  */
-   cdesc = NULL_TREE;
-
  if (attr->dimension)
{
  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
@@ -10999,13 +10990,23 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  gfc_add_block_to_block (&tmpblock, &se.pre);
}
 
+ /* Treat strings like arrays.  Or the other way around, do not
+  * generate an additional array layer for scalar components.  */
  if (attr->dimension || c->ts.type == BT_CHARACTER)
-   gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
+   {
+ cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
+&ubound, 1,
+GFC_ARRAY_ALLOCATABLE, false);
+
+ cdesc = gfc_create_var (cdesc, "cdesc");
+ DECL_ARTIFICIAL (cdesc) = 1;
+
+ set_contiguous_array (&tmpblock, cdesc, ubound, comp);
+   }
  else
cdesc = comp;
 
  tree fndecl;
-
  fndecl = build_call_expr_loc (input_location,
gfor_fndecl_co_broadcast, 5,
gfc_build_addr_expr 
(pvoid_type_node,cdesc),

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_contiguous_array

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:a30fa06a6133d7551ccc3747e74a65130ba00a3c

commit a30fa06a6133d7551ccc3747e74a65130ba00a3c
Author: Mikael Morin 
Date:   Fri Jan 17 17:48:42 2025 +0100

Factorisation set_contiguous_array

Diff:
---
 gcc/fortran/trans-array.cc | 13 +
 1 file changed, 1 insertion(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9b8e9524d0d6..1822eef911a2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11154,21 +11154,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  cdesc = gfc_create_var (cdesc, "cdesc");
  DECL_ARTIFICIAL (cdesc) = 1;
 
- gfc_add_modify (&dealloc_block, gfc_conv_descriptor_dtype (cdesc),
- gfc_get_dtype_rank_type (1, tmp));
- gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_stride_set (&dealloc_block, cdesc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&dealloc_block, cdesc,
- gfc_index_zero_node, ubound);
-
  if (attr->dimension)
comp = gfc_conv_descriptor_data_get (comp);
 
- gfc_conv_descriptor_data_set (&dealloc_block, cdesc, comp);
+ set_contiguous_array (&dealloc_block, cdesc, ubound, comp);
 
  /* Now call the deallocator.  */
  vtab = gfc_find_vtab (&c->ts);

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Essai suppression unlimited_polymorphic

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:a32ccba6b116cd3b0c697c4b591c5a66b42f51b4

commit a32ccba6b116cd3b0c697c4b591c5a66b42f51b4
Author: Mikael Morin 
Date:   Thu Jan 16 20:45:34 2025 +0100

Essai suppression unlimited_polymorphic

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1fb378ae8c0e..0541fb11af57 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9019,7 +9019,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src, 
gfc_expr *src_expr,
int rank, int corank, gfc_ss *ss, gfc_array_info *info,
tree lowers[GFC_MAX_DIMENSIONS],
tree uppers[GFC_MAX_DIMENSIONS],
-   bool unlimited_polymorphic, bool data_needed, bool subref)
+   bool data_needed, bool subref)
 {
   int ndim = info->ref ? info->ref->u.ar.dimen : rank;
 
@@ -9044,9 +9044,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src, 
gfc_expr *src_expr,
   /* Set the dtype.  */
   tmp = gfc_conv_descriptor_dtype (dest);
   tree dtype;
-  if (unlimited_polymorphic)
-dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
-  else if (src_expr->ts.type == BT_ASSUMED)
+  if (src_expr->ts.type == BT_ASSUMED)
 {
   tree tmp2 = src;
   if (DECL_LANG_SPECIFIC (tmp2) && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
@@ -9056,7 +9054,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src, 
gfc_expr *src_expr,
   dtype = gfc_conv_descriptor_dtype (tmp2);
 }
   else
-dtype = gfc_get_dtype (TREE_TYPE (dest));
+dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
   gfc_add_modify (block, tmp, dtype);
 
   /* The 1st element in the section.  */
@@ -9254,9 +9252,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   expr = expr->value.function.actual->expr;
 }
 
-  if (!se->direct_byref)
-se->unlimited_polymorphic = UNLIMITED_POLY (expr);
-
   /* Special case things we know we can pass easily.  */
   switch (expr->expr_type)
 {
@@ -9660,7 +9655,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
}
 
   set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
- ss, info, loop.from, loop.to, se->unlimited_polymorphic,
+ ss, info, loop.from, loop.to,
  !se->data_not_needed, subref_array_target);
 
   desc = parm;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index b45b34355394..61c9212576fe 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -61,9 +61,6 @@ typedef struct gfc_se
  the reference to the class object here.  */
   tree class_container;
 
-  /* Whether expr is a reference to an unlimited polymorphic object.  */
-  unsigned unlimited_polymorphic:1;
-
   /* If set gfc_conv_variable will return an expression for the array
  descriptor. When set, want_pointer should also be set.
  If not set scalarizing variables will be substituted.  */

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation subarray_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:d50ae79a5f3ddec6fd157a4ab6f04980b108d318

commit d50ae79a5f3ddec6fd157a4ab6f04980b108d318
Author: Mikael Morin 
Date:   Tue Jan 21 18:44:41 2025 +0100

Factorisation initialisation subarray_descriptor

Diff:
---
 gcc/fortran/trans-expr.cc | 151 --
 1 file changed, 78 insertions(+), 73 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0f027d2d650f..460638384d74 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9590,17 +9590,90 @@ gfc_trans_subarray_assign (tree dest, gfc_component * 
cm, gfc_expr * expr)
 }
 
 
+static void
+set_subarray_descriptor (stmtblock_t *block, tree desc, tree value,
+gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+  if (value_expr->expr_type != EXPR_VARIABLE)
+gfc_conv_descriptor_data_set (block, value,
+ null_pointer_node);
+
+  /* Obtain the array spec of full array references.  */
+  gfc_array_spec *as;
+  if (conv_arg)
+as = gfc_get_full_arrayspec_from_expr (conv_arg);
+  else
+as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+  /* Shift the lbound and ubound of temporaries to being unity,
+ rather than zero, based. Always calculate the offset.  */
+  tree offset = gfc_conv_descriptor_offset_get (desc);
+  gfc_add_modify (block, offset, gfc_index_zero_node);
+  tree tmp2 = gfc_create_var (gfc_array_index_type, NULL);
+
+  for (int n = 0; n < value_expr->rank; n++)
+{
+  tree span;
+  tree lbound;
+
+  /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
+TODO It looks as if gfc_conv_expr_descriptor should return
+the correct bounds and that the following should not be
+necessary.  This would simplify gfc_conv_intrinsic_bound
+as well.  */
+  if (as && as->lower[n])
+   {
+ gfc_se lbse;
+ gfc_init_se (&lbse, NULL);
+ gfc_conv_expr (&lbse, as->lower[n]);
+ gfc_add_block_to_block (block, &lbse.pre);
+ lbound = gfc_evaluate_now (lbse.expr, block);
+   }
+  else if (as && conv_arg)
+   {
+ tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+ lbound = gfc_conv_descriptor_lbound_get (tmp,
+   gfc_rank_cst[n]);
+   }
+  else if (as)
+   lbound = gfc_conv_descriptor_lbound_get (desc,
+   gfc_rank_cst[n]);
+  else
+   lbound = gfc_index_one_node;
+
+  lbound = fold_convert (gfc_array_index_type, lbound);
+
+  /* Shift the bounds and set the offset accordingly.  */
+  tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+  span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+   tmp, gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]));
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+span, lbound);
+  gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[n], tmp);
+  gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[n], lbound);
+
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_lbound_get (desc,
+gfc_rank_cst[n]),
+gfc_conv_descriptor_stride_get (desc,
+gfc_rank_cst[n]));
+  gfc_add_modify (block, tmp2, tmp);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+offset, tmp2);
+  gfc_conv_descriptor_offset_set (block, desc, tmp);
+}
+}
+
+
 static tree
 gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 gfc_expr * expr)
 {
   gfc_se se;
   stmtblock_t block;
-  tree offset;
-  int n;
   tree tmp;
-  tree tmp2;
-  gfc_array_spec *as;
   gfc_expr *arg = NULL;
 
   gfc_start_block (&block);
@@ -9661,10 +9734,6 @@ gfc_trans_alloc_subarray_assign (tree dest, 
gfc_component * cm,
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &se.post);
 
-  if (expr->expr_type != EXPR_VARIABLE)
-gfc_conv_descriptor_data_set (&block, se.expr,
- null_pointer_node);
-
   /* We need to know if the argument of a conversion function is a
  variable, so that the correct lower bound can be used.  */
   if (expr->expr_type == EXPR_FUNCTION
@@ -9674,71 +9743,7 @@ gfc_trans_alloc_subarray_assign (tree dest, 
gfc_component * cm,
&& expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
 arg = expr->value.function.actual->expr;
 
-  /* Obtain the array spec of full array references.  */
-  if (arg)
-as = gfc_get_full_arrayspec_from_expr (arg);
-  else
-a

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Sauvegarde factorisation set_descriptor_from_scalar

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:d6a408ef70fbb69f912b8262ade081dfb55829f3

commit d6a408ef70fbb69f912b8262ade081dfb55829f3
Author: Mikael Morin 
Date:   Tue Feb 4 11:16:32 2025 +0100

Sauvegarde factorisation set_descriptor_from_scalar

Correction régression allocate_with_source_15.f03

Nettoyage correction

Correction régression allocate_with_mold_3

Correction allocate_with_source_16.f90

Correction régression assumed_rank_21.f90

Correction coarray_allocate_8.f08

Correction régression pr86470.f90

Correction régression dummy_3.f90

Diff:
---
 gcc/fortran/trans-array.cc | 204 +++--
 gcc/fortran/trans-array.h  |   2 +-
 gcc/fortran/trans-expr.cc  |  67 +--
 gcc/fortran/trans-types.cc |  47 +++
 gcc/fortran/trans-types.h  |   1 +
 gcc/fortran/trans.h|   1 +
 6 files changed, 218 insertions(+), 104 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 97f957f78cd6..534bc4e03506 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -92,6 +92,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-array.h"
 #include "trans-const.h"
 #include "dependency.h"
+#include "gimplify.h"
 
 static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
 
@@ -600,7 +601,7 @@ gfc_conv_descriptor_sm_get (tree desc, tree dim)
 }
 
 
-static int
+static bt
 get_type_info (const bt &type)
 {
   switch (type)
@@ -611,11 +612,13 @@ get_type_info (const bt &type)
 case BT_COMPLEX:
 case BT_DERIVED:
 case BT_CHARACTER:
-case BT_CLASS:
 case BT_VOID:
 case BT_UNSIGNED:
   return type;
 
+case BT_CLASS:
+  return BT_DERIVED;
+
 case BT_PROCEDURE:
 case BT_ASSUMED:
   return BT_VOID;
@@ -672,9 +675,15 @@ get_size_info (gfc_typespec &ts)
 class modify_info
 {
 public:
+  virtual bool set_dtype () const { return is_initialization (); }
+  virtual bool use_tree_type () const { return false; }
   virtual bool is_initialization () const { return false; }
   virtual bool initialize_data () const { return false; }
+  virtual bool set_span () const { return false; }
+  virtual bool set_token () const { return true; }
   virtual tree get_data_value () const { return NULL_TREE; }
+  virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
+  virtual tree get_length (gfc_typespec *ts) const { return get_size_info 
(*ts); }
 };
 
 class nullification : public modify_info
@@ -698,8 +707,14 @@ class init_info : public modify_info
 public:
   virtual bool is_initialization () const { return true; }
   virtual gfc_typespec *get_type () const { return nullptr; }
+  virtual bt get_type_type (const gfc_typespec &) const;
 };
 
+bt
+init_info::get_type_type (const gfc_typespec & type_info) const
+{
+  return get_type_info (type_info.type);
+}
 
 class default_init : public init_info
 {
@@ -729,23 +744,103 @@ public:
   virtual gfc_typespec *get_type () const { return &ts; }
 };
 
-class scalar_value : public init_info
+
+class scalar_value : public modify_info
 {
 private:
-  gfc_typespec &ts;
+  bool initialisation;
+  gfc_typespec *ts;
   tree value;
+  bool use_tree_type_;
+  bool clear_token;
+  tree get_elt_type () const;
 
 public:
   scalar_value(gfc_typespec &arg_ts, tree arg_value)
-: ts(arg_ts), value(arg_value) { }
+: initialisation(true), ts(&arg_ts), value(arg_value), use_tree_type_ 
(false), clear_token(true) { }
+  scalar_value(tree arg_value)
+: initialisation(true), ts(nullptr), value(arg_value), use_tree_type_ 
(true), clear_token(false) { }
+  virtual bool is_initialization () const { return initialisation; }
   virtual bool initialize_data () const { return true; }
-  virtual tree get_data_value () const { return value; }
-  virtual gfc_typespec *get_type () const { return &ts; }
+  virtual tree get_data_value () const;
+  virtual gfc_typespec *get_type () const { return ts; }
+  virtual bool set_span () const { return true; }
+  virtual bool use_tree_type () const { return use_tree_type_; }
+  virtual bool set_token () const { return clear_token; }
+  virtual bt get_type_type (const gfc_typespec &) const;
+  virtual tree get_length (gfc_typespec *ts) const;
 };
 
 
+tree
+scalar_value::get_data_value () const
+{
+  if (POINTER_TYPE_P (TREE_TYPE (value)))
+return value;
+  else
+return gfc_build_addr_expr (NULL_TREE, value);
+}
+
+tree
+scalar_value::get_elt_type () const
+{
+  tree tmp = value;
+
+  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = TREE_TYPE (tmp);
+
+  tree etype = TREE_TYPE (tmp);
+
+  /* For arrays, which are not scalar coarrays.  */
+  if (TREE_CODE (etype) == ARRAY_TYPE && !TYPE_STRING_FLAG (etype))
+etype = TREE_TYPE (etype);
+
+  return etype;
+}
+
+bt
+scalar_value::get_type_type (const gfc_typespec & type_info) const
+{
+  bt n;
+  if (use_tree_type ())
+{
+  tree etype = get_elt_type ();
+  gf

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement gfc_set_gfc_from_cfi

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:fada7b612b820e0dec91602240fbe9113b810c4a

commit fada7b612b820e0dec91602240fbe9113b810c4a
Author: Mikael Morin 
Date:   Thu Jan 30 21:27:40 2025 +0100

Déplacement gfc_set_gfc_from_cfi

Correction compil'

Diff:
---
 gcc/fortran/trans-array.cc | 258 +
 gcc/fortran/trans-array.h  |   3 +
 gcc/fortran/trans-expr.cc  | 218 --
 gcc/fortran/trans.h|   3 -
 4 files changed, 241 insertions(+), 241 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5f128c9a7064..97f957f78cd6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1466,6 +1466,26 @@ gfc_conv_shift_descriptor_subarray (stmtblock_t *block, 
tree desc,
 }
 
 
+int
+gfc_descriptor_rank (tree descriptor)
+{
+  if (TREE_TYPE (descriptor) != NULL_TREE)
+return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
+  tree dim = gfc_get_descriptor_dimension (descriptor);
+  tree dim_type = TREE_TYPE (dim);
+  gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+  tree idx_type = TYPE_DOMAIN (dim_type);
+  gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+  gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+  tree idx_max = TYPE_MAX_VALUE (idx_type);
+  if (idx_max == NULL_TREE)
+return GFC_MAX_DIMENSIONS;
+  wide_int max = wi::to_wide (idx_max);
+  return max.to_shwi () + 1;
+}
+
+
 void
 gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
   int src_rank, const gfc_array_spec &as)
@@ -1835,26 +1855,6 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree 
desc, tree scalar,
   gfc_conv_descriptor_data_set (block, desc, tmp);
 }
 
-int
-gfc_descriptor_rank (tree descriptor)
-{
-  if (TREE_TYPE (descriptor) != NULL_TREE)
-return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
-
-  tree dim = gfc_get_descriptor_dimension (descriptor);
-  tree dim_type = TREE_TYPE (dim);
-  gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
-  tree idx_type = TYPE_DOMAIN (dim_type);
-  gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
-  gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
-  tree idx_max = TYPE_MAX_VALUE (idx_type);
-  if (idx_max == NULL_TREE)
-return GFC_MAX_DIMENSIONS;
-  wide_int max = wi::to_wide (idx_max);
-  return max.to_shwi () + 1;
-}
-
-
 void
 gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
  bool assumed_rank_lhs)
@@ -1899,6 +1899,224 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree 
lhs_desc, tree rhs_desc,
 }
 
 
+void
+gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
+ stmtblock_t *conditional_block, tree gfc, tree cfi,
+ tree rank, gfc_symbol *gfc_sym,
+ bool init_static, bool contiguous_gfc, bool 
contiguous_cfi)
+{
+  tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+  gfc_conv_descriptor_data_set (unconditional_block, gfc, tmp);
+
+  if (init_static)
+{
+  /* gfc->dtype = ... (from declaration, not from cfi).  */
+  tree etype = gfc_get_element_type (TREE_TYPE (gfc));
+  gfc_add_modify (unconditional_block, gfc_conv_descriptor_dtype (gfc),
+ gfc_get_dtype_rank_type (gfc_sym->as->rank, etype));
+
+  if (gfc_sym->as->type == AS_ASSUMED_RANK)
+   gfc_add_modify (unconditional_block,
+   gfc_conv_descriptor_rank (gfc), rank);
+}
+
+  if (gfc_sym && gfc_sym->ts.type == BT_ASSUMED)
+{
+  /* For type(*), take elem_len + dtype.type from the actual argument.  */
+  gfc_add_modify (unconditional_block, gfc_conv_descriptor_elem_len (gfc),
+ gfc_get_cfi_desc_elem_len (cfi));
+  tree cond;
+  tree ctype = gfc_get_cfi_desc_type (cfi);
+  ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
+  ctype, build_int_cst (TREE_TYPE (ctype),
+CFI_type_mask));
+  tree type = gfc_conv_descriptor_type (gfc);
+
+  /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN  */
+  /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
+ build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+build_int_cst (TREE_TYPE (type), BT_VOID));
+  tree tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+  type,
+  build_int_cst (TREE_TYPE (type), 
BT_UNKNOWN));
+  tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+  /* if (CFI_type_struct) BT_DERIVED else  < tmp2 >  */
+  cond = fold_build2_loc (input_location, EQ_

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation depuis cfi

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:cd55e99f733ac19d8a912b3043a321d1f9f574fc

commit cd55e99f733ac19d8a912b3043a321d1f9f574fc
Author: Mikael Morin 
Date:   Fri Jan 24 16:01:58 2025 +0100

Factorisation initialisation depuis cfi

Correction régression contiguous-2.f90

Correction regression contiguous-2.f90

Correction régression bind-c-contiguous-1.f90

Diff:
---
 gcc/fortran/trans-decl.cc | 220 --
 gcc/fortran/trans-expr.cc | 209 ---
 gcc/fortran/trans.h   |   2 +
 3 files changed, 194 insertions(+), 237 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ef15862b8d2d..ad861247eb0f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7040,7 +7040,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   stmtblock_t block;
   gfc_init_block (&block);
   tree cfi = build_fold_indirect_ref_loc (input_location, cfi_desc);
-  tree idx, etype, tmp, tmp2, size_var = NULL_TREE, rank = NULL_TREE;
+  tree idx, tmp, tmp2, size_var = NULL_TREE, rank = NULL_TREE;
   bool do_copy_inout = false;
 
   /* When allocatable + intent out, free the cfi descriptor.  */
@@ -7232,106 +7232,10 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
goto done;
 }
 
-  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
-{
-  /* gfc->dtype = ... (from declaration, not from cfi).  */
-  etype = gfc_get_element_type (TREE_TYPE (gfc_desc));
-  gfc_add_modify (&block, gfc_conv_descriptor_dtype (gfc_desc),
- gfc_get_dtype_rank_type (sym->as->rank, etype));
-  /* gfc->data = cfi->base_addr. */
-  gfc_conv_descriptor_data_set (&block, gfc_desc,
-   gfc_get_cfi_desc_base_addr (cfi));
-}
-
-  if (sym->ts.type == BT_ASSUMED)
-{
-  /* For type(*), take elem_len + dtype.type from the actual argument.  */
-  gfc_add_modify (&block, gfc_conv_descriptor_elem_len (gfc_desc),
- gfc_get_cfi_desc_elem_len (cfi));
-  tree cond;
-  tree ctype = gfc_get_cfi_desc_type (cfi);
-  ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
-  ctype, build_int_cst (TREE_TYPE (ctype),
-CFI_type_mask));
-  tree type = gfc_conv_descriptor_type (gfc_desc);
-
-  /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN  */
-  /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
-  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
- build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_VOID));
-  tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type,
- build_int_cst (TREE_TYPE (type), BT_UNKNOWN));
-  tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
-  /* if (CFI_type_struct) BT_DERIVED else  < tmp2 >  */
-  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
- build_int_cst (TREE_TYPE (ctype),
-CFI_type_struct));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_DERIVED));
-  tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
-  /* if (CFI_type_Character) BT_CHARACTER else  < tmp2 >  */
-  /* Note: this is kind=1, CFI_type_ucs4_char is handled in the 'else if'
-before (see below, as generated bottom up).  */
-  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Character));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_CHARACTER));
-  tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
-  /* if (CFI_type_ucs4_char) BT_CHARACTER else  < tmp2 >  */
-  /* Note: gfc->elem_len = cfi->elem_len/4.  */
-  /* However, assuming that CFI_type_ucs4_char cannot be recovered, leave
-gfc->elem_len == cfi->elem_len, which helps with operations which use
-sizeof() in Fortran and cfi->elem_len in C.  */
-  tmp = gfc_get_cfi_desc_type (cfi);
-  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp),
- 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] utilisation booléen allocatable

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:44d5cde1797102dda3492304d6ef27af63ff30e8

commit 44d5cde1797102dda3492304d6ef27af63ff30e8
Author: Mikael Morin 
Date:   Thu Jan 23 21:38:24 2025 +0100

utilisation booléen allocatable

Diff:
---
 gcc/fortran/trans-expr.cc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4b107830b5e0..c2fc4e8da1bb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6097,12 +6097,12 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
 
 static void
 set_gfc_from_cfi (stmtblock_t *block, tree gfc, tree cfi, tree rank,
- gfc_symbol *c_sym)
+ bool allocatable)
 {
   tree tmp = gfc_get_cfi_desc_base_addr (cfi);
   gfc_conv_descriptor_data_set (block, gfc, tmp);
 
-  if (c_sym->attr.allocatable)
+  if (allocatable)
 {
   /* gfc->span = cfi->elem_len.  */
   tmp = fold_convert (gfc_array_index_type,
@@ -6555,7 +6555,7 @@ done:
   tmp = gfc_get_cfi_desc_base_addr (cfi);
   gfc_conv_descriptor_data_set (&block, gfc, tmp);
 
-  set_gfc_from_cfi (&block2, gfc, cfi, rank, fsym);
+  set_gfc_from_cfi (&block2, gfc, cfi, rank, fsym->attr.allocatable);
 }
 
   if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation gfc depuis cfi

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:78daf01840bf9c4f77262dec6daa80dfe29be1b5

commit 78daf01840bf9c4f77262dec6daa80dfe29be1b5
Author: Mikael Morin 
Date:   Thu Jan 23 20:46:59 2025 +0100

Factorisation initialisation gfc depuis cfi

Correction régression scalar descriptor

Diff:
---
 gcc/fortran/trans-expr.cc | 132 +-
 1 file changed, 72 insertions(+), 60 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bf0b607f2d20..4b107830b5e0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6095,6 +6095,75 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
 #endif
 
 
+static void
+set_gfc_from_cfi (stmtblock_t *block, tree gfc, tree cfi, tree rank,
+ gfc_symbol *c_sym)
+{
+  tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+  gfc_conv_descriptor_data_set (block, gfc, tmp);
+
+  if (c_sym->attr.allocatable)
+{
+  /* gfc->span = cfi->elem_len.  */
+  tmp = fold_convert (gfc_array_index_type,
+ gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
+}
+  else
+{
+  /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
+ ? cfi->dim[0].sm : cfi->elem_len).  */
+  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+  tree tmp2 = fold_convert (gfc_array_index_type,
+   gfc_get_cfi_desc_elem_len (cfi));
+  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+gfc_array_index_type, tmp, tmp2);
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+tmp, gfc_index_zero_node);
+  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+   gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
+}
+  gfc_conv_descriptor_span_set (block, gfc, tmp);
+
+  /* Calculate offset + set lbound, ubound and stride.  */
+  gfc_conv_descriptor_offset_set (block, gfc, gfc_index_zero_node);
+  /* Loop: for (i = 0; i < rank; ++i).  */
+  tree idx = gfc_create_var (TREE_TYPE (rank), "idx");
+  /* Loop body.  */
+  stmtblock_t loop_body;
+  gfc_init_block (&loop_body);
+  /* gfc->dim[i].lbound = ... */
+  tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+  gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
+
+  /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_lbound_get (gfc, idx),
+gfc_index_one_node);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+gfc_get_cfi_dim_extent (cfi, idx), tmp);
+  gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
+
+  /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+  tmp = gfc_get_cfi_dim_sm (cfi, idx);
+  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+gfc_array_index_type, tmp,
+fold_convert (gfc_array_index_type,
+  gfc_get_cfi_desc_elem_len (cfi)));
+  gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+
+  /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_stride_get (gfc, idx),
+gfc_conv_descriptor_lbound_get (gfc, idx));
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_offset_get (gfc), tmp);
+  gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
+  /* Generate loop.  */
+  gfc_simple_for_loop (block, idx, build_int_cst (TREE_TYPE (idx), 0),
+  rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
+  gfc_finish_block (&loop_body));
+}
+
 /* Provide an interface between gfortran array descriptors and the F2018:18.4
ISO_Fortran_binding array descriptors. */
 
@@ -6474,8 +6543,10 @@ done:
 goto post_call;
 
   gfc_init_block (&block2);
+
   if (e->rank == 0)
 {
+  gfc_init_block (&block2);
   tmp = gfc_get_cfi_desc_base_addr (cfi);
   gfc_add_modify (&block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
 }
@@ -6484,66 +6555,7 @@ done:
   tmp = gfc_get_cfi_desc_base_addr (cfi);
   gfc_conv_descriptor_data_set (&block, gfc, tmp);
 
-  if (fsym->attr.allocatable)
-   {
- /* gfc->span = cfi->elem_len.  */
- tmp = fold_convert (gfc_array_index_type,
- gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
-   }
-  else
-   {
- /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
- ? cfi->dim[0].sm : cfi->elem_len).  */
- tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
- tmp2 = fold_convert (gfc_array_index_type,
-  gfc_get_cfi_desc_elem_len (cfi

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar dans gfc_conv_scalar_to_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:da26b51be35f4193a5518072b36f3e1aa54f7475

commit da26b51be35f4193a5518072b36f3e1aa54f7475
Author: Mikael Morin 
Date:   Wed Jan 29 19:05:04 2025 +0100

Factorisation set_descriptor_from_scalar dans gfc_conv_scalar_to_descriptor

Correction régression pr49213.f90

Correction régression associated_assumed_rank.f90

Suppression code redondant

Diff:
---
 gcc/fortran/trans-expr.cc | 59 ---
 1 file changed, 30 insertions(+), 29 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 81ce2e841e24..e1d7eaa13439 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -174,46 +174,53 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol 
*sym, gfc_expr *expr)
 
 void
 set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
-   gfc_expr *scalar_expr, bool is_class,
+   symbol_attribute scalar_attr, bool is_class,
tree cond_optional)
 {
-  tree type = get_scalar_to_descriptor_type (scalar,
-gfc_expr_attr (scalar_expr));
+  tree type = get_scalar_to_descriptor_type (scalar, scalar_attr);
   if (POINTER_TYPE_P (type))
 type = TREE_TYPE (type);
 
-  tree dtype_val = gfc_get_dtype (type);
+  tree etype = gfc_get_element_type (type);
+  tree dtype_val;
+  if (etype == void_type_node)
+dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (scalar));
+  else
+dtype_val = gfc_get_dtype (type);
+
   tree dtype_ref = gfc_conv_descriptor_dtype (desc);
   gfc_add_modify (block, dtype_ref, dtype_val);
 
+  gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
+
   tree tmp;
   if (is_class)
+tmp = gfc_class_data_get (scalar);
+  else
+tmp = scalar;
+
+  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+  if (cond_optional)
 {
-  tmp = gfc_class_data_get (scalar);
-  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
-   tmp = gfc_build_addr_expr (NULL_TREE, tmp);
-}
-  else if (cond_optional)
-{
-  tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (scalar),
-   cond_optional, scalar,
+  tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+   cond_optional, tmp,
fold_convert (TREE_TYPE (scalar),
  null_pointer_node));
 }
-  else
-tmp = scalar;
 
   gfc_conv_descriptor_data_set (block, desc, tmp);
 }
 
 
+
 tree
 gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 {
-  tree desc, type, etype;
+  tree desc, type;
 
   type = get_scalar_to_descriptor_type (scalar, attr);
-  etype = TREE_TYPE (scalar);
   desc = gfc_create_var (type, "desc");
   DECL_ARTIFICIAL (desc) = 1;
 
@@ -224,15 +231,9 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, 
symbol_attribute attr)
   gfc_add_modify (&se->pre, tmp, scalar);
   scalar = tmp;
 }
-  if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
-scalar = gfc_build_addr_expr (NULL_TREE, scalar);
-  else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
-etype = TREE_TYPE (etype);
-  gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
- gfc_get_dtype_rank_type (0, etype));
-  gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
-  gfc_conv_descriptor_span_set (&se->pre, desc,
-   gfc_conv_descriptor_elem_len (desc));
+
+  set_descriptor_from_scalar (&se->pre, desc, scalar, attr,
+ false, NULL_TREE);
 
   /* Copy pointer address back - but only if it could have changed and
  if the actual argument is a pointer and not, e.g., NULL().  */
@@ -1082,8 +1083,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
  /* Scalar to an assumed-rank array.  */
  if (fsym->ts.u.derived->components->as)
set_descriptor_from_scalar (&parmse->pre, ctree,
-   parmse->expr, e, false,
-   cond_optional);
+   parmse->expr, gfc_expr_attr (e),
+   false, cond_optional);
   else
{
  tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
@@ -1458,8 +1459,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_typespec class_ts,
   && e->rank != class_ts.u.derived->components->as->rank)
 {
   if (e->rank == 0)
-   set_descriptor_from_scalar (&block, ctree, parmse->expr, e,
-   true, NULL_TREE);
+   set_descriptor_from_scalar (&block, ctree, parmse->expr,
+   gfc_expr_attr (e), true, NULL_TREE);
   else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Refactoring gfc_conv_descriptor_sm_get.

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:390716d4ff08553d269597a87d0b739208c1aef5

commit 390716d4ff08553d269597a87d0b739208c1aef5
Author: Mikael Morin 
Date:   Wed Jan 22 21:59:46 2025 +0100

Refactoring gfc_conv_descriptor_sm_get.

Diff:
---
 gcc/fortran/trans-array.cc | 11 +++
 gcc/fortran/trans-array.h  |  1 +
 gcc/fortran/trans-expr.cc  |  4 +---
 3 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 92931cd7d8e9..5a85afe8cde4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -589,6 +589,17 @@ gfc_conv_descriptor_extent_get (tree desc, tree dim)
 }
 
 
+tree
+gfc_conv_descriptor_sm_get (tree desc, tree dim)
+{
+  tree stride = gfc_conv_descriptor_stride_get (desc, dim);
+  tree span = gfc_conv_descriptor_span_get (desc);
+
+  return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ stride, span);
+}
+
+
 static int
 get_type_info (const bt &type)
 {
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1d694989b4c3..296a8052dd73 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -195,6 +195,7 @@ tree gfc_conv_descriptor_stride_get (tree, tree);
 tree gfc_conv_descriptor_lbound_get (tree, tree);
 tree gfc_conv_descriptor_ubound_get (tree, tree);
 tree gfc_conv_descriptor_extent_get (tree, tree);
+tree gfc_conv_descriptor_sm_get (tree, tree);
 tree gfc_conv_descriptor_token (tree);
 
 void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b251cebe7e4f..bf0b607f2d20 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6421,9 +6421,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr 
*e, gfc_symbol *fsym)
   tmp = gfc_conv_descriptor_extent_get (gfc, idx);
   gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp);
   /* d->dim[n].sm = gfc->dim[i].stride  * gfc->span); */
-  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-gfc_conv_descriptor_stride_get (gfc, idx),
-gfc_conv_descriptor_span_get (gfc));
+  tmp = gfc_conv_descriptor_sm_get (gfc, idx);
   gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
 
   /* Generate loop.  */

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar conv_derived_to_class

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:bef5a3b5d447df670a1c503ab99bfa2e5544752e

commit bef5a3b5d447df670a1c503ab99bfa2e5544752e
Author: Mikael Morin 
Date:   Wed Jan 29 18:22:29 2025 +0100

Factorisation set_descriptor_from_scalar conv_derived_to_class

Diff:
---
 gcc/fortran/trans-expr.cc | 42 +++---
 1 file changed, 23 insertions(+), 19 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6b7b516aa2a2..81ce2e841e24 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -174,7 +174,8 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol 
*sym, gfc_expr *expr)
 
 void
 set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
-   gfc_expr *scalar_expr)
+   gfc_expr *scalar_expr, bool is_class,
+   tree cond_optional)
 {
   tree type = get_scalar_to_descriptor_type (scalar,
 gfc_expr_attr (scalar_expr));
@@ -185,9 +186,22 @@ set_descriptor_from_scalar (stmtblock_t *block, tree desc, 
tree scalar,
   tree dtype_ref = gfc_conv_descriptor_dtype (desc);
   gfc_add_modify (block, dtype_ref, dtype_val);
 
-  tree tmp = gfc_class_data_get (scalar);
-  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
-tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+  tree tmp;
+  if (is_class)
+{
+  tmp = gfc_class_data_get (scalar);
+  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+   tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+}
+  else if (cond_optional)
+{
+  tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (scalar),
+   cond_optional, scalar,
+   fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+}
+  else
+tmp = scalar;
 
   gfc_conv_descriptor_data_set (block, desc, tmp);
 }
@@ -1067,20 +1081,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
 
  /* Scalar to an assumed-rank array.  */
  if (fsym->ts.u.derived->components->as)
-   {
- tree type;
- type = get_scalar_to_descriptor_type (parmse->expr,
-   gfc_expr_attr (e));
- gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
- gfc_get_dtype (type));
- if (optional)
-   parmse->expr = build3_loc (input_location, COND_EXPR,
-  TREE_TYPE (parmse->expr),
-  cond_optional, parmse->expr,
-  fold_convert (TREE_TYPE 
(parmse->expr),
-null_pointer_node));
- gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr);
-   }
+   set_descriptor_from_scalar (&parmse->pre, ctree,
+   parmse->expr, e, false,
+   cond_optional);
   else
{
  tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
@@ -1455,7 +1458,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_typespec class_ts,
   && e->rank != class_ts.u.derived->components->as->rank)
 {
   if (e->rank == 0)
-   set_descriptor_from_scalar (&block, ctree, parmse->expr, e);
+   set_descriptor_from_scalar (&block, ctree, parmse->expr, e,
+   true, NULL_TREE);
   else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement gfc_copy_sequence_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:2ff57ae27abb4c02cb32212c2d1382b1814b32ae

commit 2ff57ae27abb4c02cb32212c2d1382b1814b32ae
Author: Mikael Morin 
Date:   Thu Jan 30 21:21:39 2025 +0100

Déplacement gfc_copy_sequence_descriptor

Correction erreur compil'

Diff:
---
 gcc/fortran/trans-array.cc | 64 ++
 gcc/fortran/trans-array.h  |  1 +
 gcc/fortran/trans-expr.cc  | 64 --
 gcc/fortran/trans.h|  1 -
 4 files changed, 65 insertions(+), 65 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c59f3c5294db..5f128c9a7064 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1835,6 +1835,70 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree 
desc, tree scalar,
   gfc_conv_descriptor_data_set (block, desc, tmp);
 }
 
+int
+gfc_descriptor_rank (tree descriptor)
+{
+  if (TREE_TYPE (descriptor) != NULL_TREE)
+return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
+  tree dim = gfc_get_descriptor_dimension (descriptor);
+  tree dim_type = TREE_TYPE (dim);
+  gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+  tree idx_type = TYPE_DOMAIN (dim_type);
+  gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+  gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+  tree idx_max = TYPE_MAX_VALUE (idx_type);
+  if (idx_max == NULL_TREE)
+return GFC_MAX_DIMENSIONS;
+  wide_int max = wi::to_wide (idx_max);
+  return max.to_shwi () + 1;
+}
+
+
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+ bool assumed_rank_lhs)
+{
+  int lhs_rank = gfc_descriptor_rank (lhs_desc);
+  int rhs_rank = gfc_descriptor_rank (rhs_desc);
+  tree desc;
+
+  if (assumed_rank_lhs || lhs_rank == rhs_rank)
+desc = rhs_desc;
+  else
+{
+  tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+  gfc_conv_descriptor_data_set (&block, arr,
+   gfc_conv_descriptor_data_get (rhs_desc));
+  gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+  tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+  gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+  gfc_conv_descriptor_stride_set (
+   &block, arr, gfc_index_zero_node,
+   gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+  for (int i = 1; i < lhs_rank; i++)
+   {
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+   }
+  gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (rhs_desc));
+  gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_char_type_node, lhs_rank));
+  gfc_conv_descriptor_span_set (&block, arr,
+   gfc_conv_descriptor_span_get (arr));
+  gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
+  desc = arr;
+}
+
+  gfc_class_array_data_assign (&block, lhs_desc, desc, true);
+}
+
+
 
 /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info).  */
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 691231f66903..124020a53858 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -150,6 +150,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree, 
tree,
 tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
 symbol_attribute, bool, tree);
+void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
 
 /* Get a single array element.  */
 void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 944ae6bf74a7..c1f474d7e199 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -800,70 +800,6 @@ gfc_get_vptr_from_expr (tree expr)
 }
 
 
-int
-gfc_descriptor_rank (tree descriptor)
-{
-  if (TREE_TYPE (descriptor) != NULL_TREE)
-return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
-
-  tree dim = gfc_get_descriptor_dimension (descriptor);
-  tree dim_type = TREE_TYPE (dim);
-  gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
-  tree idx_type = TYPE_DOMAIN (dim_type);
-  gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
-  gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
-  tree idx_max = TYPE_MAX_VALUE (idx_type);
-  if (idx_max == NULL_TREE)
-return GFC_MAX_DIMENSIONS;
-  wide_int max = wi::to_wide

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement méthode set_descriptor_from_scalar

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:87e7a0c2119f1bf5a689b4223396cfedca2e45be

commit 87e7a0c2119f1bf5a689b4223396cfedca2e45be
Author: Mikael Morin 
Date:   Thu Jan 30 21:07:15 2025 +0100

Déplacement méthode set_descriptor_from_scalar

Correction erreur compil'

Diff:
---
 gcc/fortran/trans-array.cc | 63 +++
 gcc/fortran/trans-array.h  |  3 ++
 gcc/fortran/trans-expr.cc  | 83 +-
 3 files changed, 75 insertions(+), 74 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5a85afe8cde4..c59f3c5294db 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1772,6 +1772,69 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree 
desc,
   gfc_conv_descriptor_offset_set (block, desc, offset);
 }
 
+/* Convert a scalar to an array descriptor. To be used for assumed-rank
+   arrays.  */
+
+tree
+gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
+{
+  enum gfc_array_kind akind;
+
+  if (attr.pointer)
+akind = GFC_ARRAY_POINTER_CONT;
+  else if (attr.allocatable)
+akind = GFC_ARRAY_ALLOCATABLE;
+  else
+akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+
+  if (POINTER_TYPE_P (TREE_TYPE (scalar)))
+scalar = TREE_TYPE (scalar);
+  return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
+   akind, !(attr.pointer || attr.target));
+}
+
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
+   symbol_attribute scalar_attr, bool is_class,
+   tree cond_optional)
+{
+  tree type = gfc_get_scalar_to_descriptor_type (scalar, scalar_attr);
+  if (POINTER_TYPE_P (type))
+type = TREE_TYPE (type);
+
+  tree etype = gfc_get_element_type (type);
+  tree dtype_val;
+  if (etype == void_type_node)
+dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (scalar));
+  else
+dtype_val = gfc_get_dtype (type);
+
+  tree dtype_ref = gfc_conv_descriptor_dtype (desc);
+  gfc_add_modify (block, dtype_ref, dtype_val);
+
+  gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
+
+  tree tmp;
+  if (is_class)
+tmp = gfc_class_data_get (scalar);
+  else
+tmp = scalar;
+
+  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+  if (cond_optional)
+{
+  tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+   cond_optional, tmp,
+   fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+}
+
+  gfc_conv_descriptor_data_set (block, desc, tmp);
+}
+
 
 /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info).  */
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 296a8052dd73..691231f66903 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -147,6 +147,9 @@ void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol 
*, gfc_expr *, tree);
 void gfc_set_scalar_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
+tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
+symbol_attribute, bool, tree);
 
 /* Get a single array element.  */
 void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e1d7eaa13439..944ae6bf74a7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -83,34 +83,12 @@ gfc_get_character_len_in_bytes (tree type)
 }
 
 
-/* Convert a scalar to an array descriptor. To be used for assumed-rank
-   arrays.  */
-
-static tree
-get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
-{
-  enum gfc_array_kind akind;
-
-  if (attr.pointer)
-akind = GFC_ARRAY_POINTER_CONT;
-  else if (attr.allocatable)
-akind = GFC_ARRAY_ALLOCATABLE;
-  else
-akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
-
-  if (POINTER_TYPE_P (TREE_TYPE (scalar)))
-scalar = TREE_TYPE (scalar);
-  return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
-   akind, !(attr.pointer || attr.target));
-}
-
-
 tree
 gfc_conv_scalar_null_to_descriptor (gfc_se *se, gfc_symbol *sym, gfc_expr 
*expr, tree scalar)
 {
   symbol_attribute attr = sym->attr;
 
-  tree type = get_scalar_to_descriptor_type (scalar, attr);
+  tree type = gfc_get_scalar_to_descriptor_type (scalar, attr);
   tree desc = gfc_create_var (type, "desc");
   DECL_ARTIFICIAL (desc) = 1;
 
@@ -172,55 +150,12 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol 
*sym, gfc_expr *expr)
 }
 
 
-void
-set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
-

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar dans conv_class_to_class

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:56c9732f7cefcbaa07bc3b75c0e30a7c02e6105a

commit 56c9732f7cefcbaa07bc3b75c0e30a7c02e6105a
Author: Mikael Morin 
Date:   Tue Jan 28 21:03:24 2025 +0100

Factorisation set_descriptor_from_scalar dans conv_class_to_class

Correction régression associate_66

Correction régression PR100040.f90

Diff:
---
 gcc/fortran/trans-expr.cc | 34 ++
 1 file changed, 22 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e601a212d153..6b7b516aa2a2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -172,6 +172,27 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol 
*sym, gfc_expr *expr)
 }
 
 
+void
+set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
+   gfc_expr *scalar_expr)
+{
+  tree type = get_scalar_to_descriptor_type (scalar,
+gfc_expr_attr (scalar_expr));
+  if (POINTER_TYPE_P (type))
+type = TREE_TYPE (type);
+
+  tree dtype_val = gfc_get_dtype (type);
+  tree dtype_ref = gfc_conv_descriptor_dtype (desc);
+  gfc_add_modify (block, dtype_ref, dtype_val);
+
+  tree tmp = gfc_class_data_get (scalar);
+  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+  gfc_conv_descriptor_data_set (block, desc, tmp);
+}
+
+
 tree
 gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 {
@@ -1434,18 +1455,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_typespec class_ts,
   && e->rank != class_ts.u.derived->components->as->rank)
 {
   if (e->rank == 0)
-   {
- tree type = get_scalar_to_descriptor_type (parmse->expr,
-gfc_expr_attr (e));
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (ctree),
- gfc_get_dtype (type));
-
- tmp = gfc_class_data_get (parmse->expr);
- if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
-   tmp = gfc_build_addr_expr (NULL_TREE, tmp);
-
- gfc_conv_descriptor_data_set (&block, ctree, tmp);
-   }
+   set_descriptor_from_scalar (&block, ctree, parmse->expr, e);
   else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Séparation motifs dump assumed_rank_12.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:0aebc9d6478ef888288bf3e60142ba587eb30ca8

commit 0aebc9d6478ef888288bf3e60142ba587eb30ca8
Author: Mikael Morin 
Date:   Wed Feb 5 11:57:09 2025 +0100

Séparation motifs dump assumed_rank_12.f90

Diff:
---
 gcc/testsuite/gfortran.dg/assumed_rank_12.f90 | 6 +-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 
b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
index 873498f82d76..cacfb7ed52af 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
@@ -16,5 +16,9 @@ function f() result(res)
 end function f
 end
 
-! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.dtype = .*;.*desc.0.data = 
.void .. D.*;.*sub \\(&desc.0\\);.*D.*= .integer.kind=4. .. desc.0.data;" 
"original" } }
+! { dg-final { scan-tree-dump " = f \\(\\);" "original" } }
+! { dg-final { scan-tree-dump "desc.0.dtype = .*;" "original" } }
+! { dg-final { scan-tree-dump "desc.0.data = .void .. D.*;" "original" } }
+! { dg-final { scan-tree-dump "sub \\(&desc.0\\);" "original" } }
+! { dg-final { scan-tree-dump "D.*= .integer.kind=4. .. desc.0.data;" 
"original" } }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] réduction différences dump assumed_rank_12.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:c9a19c4648fd9649f7550287f3705419e1a135ec

commit c9a19c4648fd9649f7550287f3705419e1a135ec
Author: Mikael Morin 
Date:   Wed Feb 5 11:45:00 2025 +0100

réduction différences dump assumed_rank_12.f90

Diff:
---
 gcc/fortran/trans-array.cc | 126 -
 1 file changed, 124 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 534bc4e03506..dbd48d9ec688 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1085,11 +1085,131 @@ field_count (tree type)
 }
 
 
-bool
+#if 0
+static bool
 complete_init_p (tree type, vec *init_values)
 {
   return (unsigned) field_count (type) == vec_safe_length (init_values);
 }
+#endif
+
+
+static int
+cmp_wi (const void *x, const void *y)
+{
+  const offset_int *wix = (const offset_int *) x;
+  const offset_int *wiy = (const offset_int *) y;
+
+  return wi::cmpu (*wix, *wiy);
+}
+
+
+static offset_int
+get_offset_bits (tree field)
+{
+  offset_int field_offset = wi::to_offset (DECL_FIELD_OFFSET (field));
+  offset_int field_bit_offset = wi::to_offset (DECL_FIELD_BIT_OFFSET (field));
+  unsigned long offset_align = DECL_OFFSET_ALIGN (field);
+
+  return field_offset * offset_align + field_bit_offset;
+}
+
+
+static bool
+check_cleared_low_bits (const offset_int &val, int bitcount)
+{
+  if (bitcount == 0)
+return true;
+
+  offset_int mask = wi::mask  (bitcount, false);
+  if ((val & mask) != 0)
+return false;
+
+  return true;
+}
+
+
+static bool
+right_shift_if_clear (const offset_int &val, int bitcount, offset_int *result)
+{
+  if (bitcount == 0)
+{
+  *result = val;
+  return true;
+}
+
+  if (!check_cleared_low_bits (val, bitcount))
+return false;
+
+  *result = val >> bitcount;
+  return true;
+}
+
+
+static bool
+contiguous_init_p (tree type, tree value)
+{
+  gcc_assert (TREE_CODE (value) == CONSTRUCTOR);
+  auto_vec field_offsets;
+  int count = field_count (type);
+  field_offsets.reserve (count);
+
+  tree field = TYPE_FIELDS (type);
+  offset_int expected_offset = 0;
+  while (field != NULL_TREE)
+{
+  offset_int field_offset_bits = get_offset_bits (field);
+  offset_int field_offset;
+  if (!right_shift_if_clear (field_offset_bits, 3, &field_offset))
+   return false;
+
+  offset_int type_size = wi::to_offset (TYPE_SIZE_UNIT (TREE_TYPE 
(field)));
+  int align = wi::ctz (type_size);
+  if (!check_cleared_low_bits (field_offset, align))
+   return false;
+
+  if (field_offset != expected_offset)
+   return false;
+
+  expected_offset += type_size;
+  field_offsets.quick_push (field_offset);
+
+  field = DECL_CHAIN (field);
+}
+
+  auto_vec value_offsets;
+  value_offsets.reserve (count);
+
+  unsigned i;
+  tree field_init;
+  FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (value), i, field, field_init)
+{
+  if (TREE_TYPE (field) != TREE_TYPE (field_init))
+   return false;
+
+  offset_int field_offset_bits = get_offset_bits (field);
+  offset_int field_offset;
+  if (!right_shift_if_clear (field_offset_bits, 3, &field_offset))
+   return false;
+
+  value_offsets.quick_push (field_offset);
+}
+
+  value_offsets.qsort (cmp_wi);
+
+  unsigned idx = 0;
+  offset_int field_off, val_off;
+  while (field_offsets.iterate (idx, &field_off)
+&& value_offsets.iterate (idx, &val_off))
+{
+  if (val_off != field_off)
+   return false;
+
+  idx++;
+}
+
+  return true;
+}
 
 
 static bool
@@ -1161,7 +1281,9 @@ init_struct (stmtblock_t *block, tree data_ref, init_kind 
kind,
   if (TREE_STATIC (data_ref)
  || !modifiable_p (data_ref))
DECL_INITIAL (data_ref) = value;
-  else if (TREE_CODE (value) == CONSTRUCTOR)
+  else if (TREE_CODE (value) == CONSTRUCTOR
+  && !(TREE_CONSTANT (value)
+   && contiguous_init_p (type, value)))
{
  unsigned i;
  tree field, field_init;

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Update dump match count

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:d1010f212a9d9c7f721fdcb3935cb0bc342e610e

commit d1010f212a9d9c7f721fdcb3935cb0bc342e610e
Author: Mikael Morin 
Date:   Thu Jan 30 16:53:48 2025 +0100

Update dump match count

Diff:
---
 gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 
b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
index c83899de0e5b..a1f2a76ff73e 100644
--- a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
@@ -33,5 +33,5 @@ end program
 ! This lead to access to non exsitant memory in opencoarrays.
 ! In single image mode just checking for reduced number of
 ! descriptors is possible, i.e., execute always works.
-! { dg-final { scan-tree-dump-times "desc\\.\[0-9\]+" 12 "original" } }
+! { dg-final { scan-tree-dump-times "desc\\.\[0-9\]+" 10 "original" } }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] match: Simplify double not and double negate to a non_lvalue

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:8e855c467c9fd654145dc843873cf81b32341f77

commit 8e855c467c9fd654145dc843873cf81b32341f77
Author: Mikael Morin 
Date:   Thu Jul 4 12:59:34 2024 +0200

match: Simplify double not and double negate to a non_lvalue

I noticed while testing the second patch that none of the NON_LVALUE_EXPR
trees I expected were generated when simplifying unary operators, whereas
they were generated with binary operators.

Regression tested on x86_64-linux.  OK for master?

-- 8< --

gcc/ChangeLog:

* match.pd (`-(-X)`, `~(~X)`): Add a NON_LVALUE_EXPR wrapper to the
simplification of doubled unary operators NEGATE_EXPR and
BIT_NOT_EXPR.

gcc/testsuite/ChangeLog:

* gfortran.dg/non_lvalue_1.f90: New test.

Diff:
---
 gcc/match.pd   |  4 ++--
 gcc/testsuite/gfortran.dg/non_lvalue_1.f90 | 21 +
 2 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/gcc/match.pd b/gcc/match.pd
index 5c679848bdf2..51bf5b4ccb47 100644
--- a/gcc/match.pd
+++ b/gcc/match.pd
@@ -2344,7 +2344,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
 /* ~~x -> x */
 (simplify
   (bit_not (bit_not @0))
-  @0)
+  (non_lvalue @0))
 
 /* zero_one_valued_p will match when a value is known to be either
0 or 1 including constants 0 or 1.
@@ -3956,7 +3956,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
   (negate (nop_convert? (negate @1)))
   (if (!TYPE_OVERFLOW_SANITIZED (type)
&& !TYPE_OVERFLOW_SANITIZED (TREE_TYPE (@1)))
-   (view_convert @1)))
+   (non_lvalue (view_convert @1
 
  /* We can't reassociate floating-point unless -fassociative-math
 or fixed-point plus or minus because of saturation to +-Inf.  */
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_1.f90 
b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
new file mode 100644
index ..ac52b2720945
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the generation of NON_LVALUE_EXPR trees in cases where a unary 
operator expression
+! simplifies to a data reference.
+
+! A NON_LVALUE_EXPR is generated for a double negation that simplifies to a 
data reference.  */
+function f1 (f1_arg1)
+  integer, value :: f1_arg1
+  integer :: f1
+  f1 = -(-f1_arg1)
+end function
+! { dg-final { scan-tree-dump "__result_f1 = NON_LVALUE_EXPR ;" 
"original" } }
+
+! A NON_LVALUE_EXPR is generated for a double complement that simplifies to a 
data reference.  */
+function f2 (f2_arg1)
+  integer, value :: f2_arg1
+  integer :: f2
+  f2 = not(not(f2_arg1))
+end function
+! { dg-final { scan-tree-dump "__result_f2 = NON_LVALUE_EXPR ;" 
"original" } }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Introduction getters et setters descriptor compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:903240f6ccbaa616eb680251351d63829beabfb6

commit 903240f6ccbaa616eb680251351d63829beabfb6
Author: Mikael Morin 
Date:   Mon Feb 10 19:24:59 2025 +0100

Introduction getters et setters descriptor compil' OK

Correction régression realloc on assign (associate_61, ...)

Correction régression assumed_rank_7.f90

Correction ICE coarray_42.f90

Diff:
---
 gcc/fortran/trans-array.cc | 817 +
 gcc/fortran/trans-array.h  |  26 +-
 gcc/fortran/trans-decl.cc  |   8 +-
 gcc/fortran/trans-expr.cc  |  66 ++--
 gcc/fortran/trans-intrinsic.cc |  61 ++-
 gcc/fortran/trans-openmp.cc|   2 +-
 gcc/fortran/trans-stmt.cc  |   7 +-
 gcc/fortran/trans.cc   |   7 +-
 8 files changed, 671 insertions(+), 323 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5fcac2a39fdf..fbbbab9c1d92 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -242,8 +242,15 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
 #define LBOUND_SUBFIELD 1
 #define UBOUND_SUBFIELD 2
 
-static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
+
+namespace gfc_descriptor
+{
+
+namespace
+{
+
+tree
+get_field (tree desc, unsigned field_idx)
 {
   tree type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -251,111 +258,119 @@ gfc_get_descriptor_field (tree desc, unsigned field_idx)
   tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
   gcc_assert (field != NULL_TREE);
 
+  return field;
+}
+
+tree
+get_component (tree desc, unsigned field_idx)
+{
+  tree field = get_field (desc, field_idx);
+
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
  desc, field, NULL_TREE);
 }
 
-/* This provides READ-ONLY access to the data field.  The field itself
-   doesn't have the proper type.  */
+tree
+get_data (tree desc)
+{
+  return get_component (desc, DATA_FIELD);
+}
 
 tree
-gfc_conv_descriptor_data_get (tree desc)
+conv_data_get (tree desc)
 {
   tree type = TREE_TYPE (desc);
-  if (TREE_CODE (type) == REFERENCE_TYPE)
-gcc_unreachable ();
+  gcc_assert (TREE_CODE (type) != REFERENCE_TYPE);
 
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
-  return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+  tree field = get_data (desc);
+  tree t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+  return non_lvalue_loc (input_location, t);
 }
 
-/* This provides WRITE access to the data field.
-
-   TUPLES_P is true if we are generating tuples.
-
-   This function gets called through the following macros:
- gfc_conv_descriptor_data_set
- gfc_conv_descriptor_data_set.  */
-
 void
-gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+conv_data_set (stmtblock_t *block, tree desc, tree value)
 {
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+  tree field = get_data (desc);
   gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
 }
 
-
-/* This provides address access to the data field.  This should only be
-   used by array allocation, passing this on to the runtime.  */
-
 tree
-gfc_conv_descriptor_data_addr (tree desc)
+conv_data_addr (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+  tree field = get_data (desc);
   return gfc_build_addr_expr (NULL_TREE, field);
 }
 
-static tree
-gfc_conv_descriptor_offset (tree desc)
+tree
+get_offset (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
+  tree field = get_component (desc, OFFSET_FIELD);
   gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
   return field;
 }
 
 tree
-gfc_conv_descriptor_offset_get (tree desc)
+conv_offset_get (tree desc)
 {
-  return gfc_conv_descriptor_offset (desc);
+  return non_lvalue_loc (input_location, get_offset (desc));
 }
 
 void
-gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
-   tree value)
+conv_offset_set (stmtblock_t *block, tree desc, tree value)
 {
-  tree t = gfc_conv_descriptor_offset (desc);
+  tree t = get_offset (desc);
   gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
 }
 
-
 tree
-gfc_conv_descriptor_dtype (tree desc)
+get_dtype (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
+  tree field = get_component (desc, DTYPE_FIELD);
   gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
   return field;
 }
 
-static tree
-gfc_conv_descriptor_span (tree desc)
+tree
+conv_dtype_get (tree desc)
+{
+  return non_lvalue_loc (input_location, get_dtype (desc));
+}
+
+void
+conv_dtype_set (stmtblock_t *block, tree desc, tree val)
+{
+  tree t = get_dtype (desc);
+  gfc_add_modify (block, t, val);
+}
+
+tree
+get_span (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
+  tree field = get_component (desc, SPAN_FIELD);
   gcc_assert (TREE_TYPE (field) == gfc_arra

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation dimension descripteur

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:f57ab2bbf08bdc94c40d9e615dba676eb2934fab

commit f57ab2bbf08bdc94c40d9e615dba676eb2934fab
Author: Mikael Morin 
Date:   Sat Feb 8 21:37:49 2025 +0100

Factorisation initialisation dimension descripteur

Correction régression realloc_on_assign_12.f90

Diff:
---
 gcc/fortran/trans-array.cc | 87 +-
 1 file changed, 48 insertions(+), 39 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a8f99abd30c5..5fcac2a39fdf 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1472,38 +1472,56 @@ gfc_build_null_descriptor (tree type)
 }
 
 
-static tree
-set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
- tree lbound, tree ubound, tree stride, tree *offset)
+static void
+set_bounds_update_offset (stmtblock_t *block, tree desc, int dim,
+ tree lbound, tree ubound, tree stride, tree 
lbound_diff,
+ tree *offset, tree *next_stride, bool 
stride_unchanged)
 {
-  /* Set bounds in descriptor.  */
+  /* Stabilize values in case the expressions depend on the existing bounds.  
*/
   lbound = fold_convert (gfc_array_index_type, lbound);
   lbound = gfc_evaluate_now (lbound, block);
-  gfc_conv_descriptor_lbound_set (block, desc,
- gfc_rank_cst[dim], lbound);
 
   ubound = fold_convert (gfc_array_index_type, ubound);
   ubound = gfc_evaluate_now (ubound, block);
-  gfc_conv_descriptor_ubound_set (block, desc,
- gfc_rank_cst[dim], ubound);
 
-  /* Set stride.  */
   stride = fold_convert (gfc_array_index_type, stride);
   stride = gfc_evaluate_now (stride, block);
-  gfc_conv_descriptor_stride_set (block, desc,
- gfc_rank_cst[dim], stride);
+
+  lbound_diff = fold_convert (gfc_array_index_type, lbound_diff);
+  lbound_diff = gfc_evaluate_now (lbound_diff, block);
+
+  gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[dim], lbound);
+  gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[dim], ubound);
+  if (!stride_unchanged)
+gfc_conv_descriptor_stride_set (block, desc,
+   gfc_rank_cst[dim], stride);
 
   /* Update offset.  */
   tree tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound, stride);
-  *offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, *offset, tmp);
+ gfc_array_index_type, lbound_diff, stride);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+gfc_array_index_type, *offset, tmp);
+  *offset = gfc_evaluate_now (tmp, block);
+
+  if (!next_stride)
+return;
 
-  /* Return stride for next dimension.  */
+  /* Set stride for next dimension.  */
   tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-  stride = fold_build2_loc (input_location, MULT_EXPR,
-   gfc_array_index_type, stride, tmp);
-  return stride;
+  *next_stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, tmp);
+}
+
+
+static void
+set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
+ tree lbound, tree ubound, tree stride, tree *offset,
+ tree *next_stride)
+{
+  set_bounds_update_offset (block, desc, dim, lbound, ubound, stride, lbound,
+   offset, next_stride, false);
 }
 
 
@@ -1512,7 +1530,7 @@ set_descriptor_dimension (stmtblock_t *block, tree desc, 
int dim,
 
 static void
 conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree 
to_desc, int dim,
- tree new_lbound, tree offset, bool zero_based)
+ tree new_lbound, tree *offset, bool zero_based)
 {
   new_lbound = fold_convert (gfc_array_index_type, new_lbound);
   new_lbound = gfc_evaluate_now (new_lbound, block);
@@ -1536,18 +1554,9 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree 
from_desc, tree to_desc,
  updating the lbound, as they depend on the lbound expression!  */
   tree tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
   ubound, diff);
-  gfc_conv_descriptor_ubound_set (block, to_desc, gfc_rank_cst[dim], tmp1);
-  /* Set lbound to the value we want.  */
-  gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim], 
new_lbound);
 
-  tree offs_diff = fold_build2_loc (input_location, MULT_EXPR, 
gfc_array_index_type,
-   diff, stride);
-  tree tmp2 = fold_build2_loc (input_location, MINUS_EXPR, 
gfc_array_index_type,
-  offset, offs_diff);
-  gfc_add_modify (block, offset, tmp2);
-
-  if (from_desc != to_desc)
-

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Renseignement token par gfc_set_descriptor_from_scalar.

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:e590d27d869b73b80cd2b34f8330a0942dedb408

commit e590d27d869b73b80cd2b34f8330a0942dedb408
Author: Mikael Morin 
Date:   Wed Feb 5 15:12:25 2025 +0100

Renseignement token par gfc_set_descriptor_from_scalar.

Diff:
---
 gcc/fortran/trans-array.cc | 27 ---
 gcc/fortran/trans-array.h  |  2 +-
 gcc/fortran/trans-expr.cc  | 15 +++
 3 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index dbd48d9ec688..f75829b365d4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -682,6 +682,7 @@ public:
   virtual bool set_span () const { return false; }
   virtual bool set_token () const { return true; }
   virtual tree get_data_value () const { return NULL_TREE; }
+  virtual tree get_caf_token () const { return null_pointer_node; }
   virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
   virtual tree get_length (gfc_typespec *ts) const { return get_size_info 
(*ts); }
 };
@@ -751,22 +752,24 @@ private:
   bool initialisation;
   gfc_typespec *ts;
   tree value;
+  tree caf_token;
   bool use_tree_type_;
   bool clear_token;
   tree get_elt_type () const;
 
 public:
   scalar_value(gfc_typespec &arg_ts, tree arg_value)
-: initialisation(true), ts(&arg_ts), value(arg_value), use_tree_type_ 
(false), clear_token(true) { }
-  scalar_value(tree arg_value)
-: initialisation(true), ts(nullptr), value(arg_value), use_tree_type_ 
(true), clear_token(false) { }
+: initialisation(true), ts(&arg_ts), value(arg_value), caf_token 
(NULL_TREE),  use_tree_type_ (false), clear_token(true) { }
+  scalar_value(tree arg_value, tree arg_caf_token)
+: initialisation(true), ts(nullptr), value(arg_value), caf_token 
(arg_caf_token), use_tree_type_ (true), clear_token(false) { }
   virtual bool is_initialization () const { return initialisation; }
   virtual bool initialize_data () const { return true; }
   virtual tree get_data_value () const;
   virtual gfc_typespec *get_type () const { return ts; }
   virtual bool set_span () const { return true; }
   virtual bool use_tree_type () const { return use_tree_type_; }
-  virtual bool set_token () const { return clear_token; }
+  virtual bool set_token () const { return clear_token || caf_token != 
NULL_TREE; }
+  virtual tree get_caf_token () const;
   virtual bt get_type_type (const gfc_typespec &) const;
   virtual tree get_length (gfc_typespec *ts) const;
 };
@@ -838,6 +841,16 @@ scalar_value::get_length (gfc_typespec * type_info) const
   return size;
 }
 
+tree
+scalar_value::get_caf_token () const
+{
+  if (set_token ()
+  && caf_token != NULL_TREE)
+return caf_token;
+  else
+return modify_info::get_caf_token ();
+}
+
 
 static tree
 build_dtype (gfc_typespec *ts, int rank, const symbol_attribute &,
@@ -933,7 +946,7 @@ get_descriptor_init (tree type, gfc_typespec *ts, int rank,
   tree token_field = gfc_advance_chain (fields,
CAF_TOKEN_FIELD - (!dim_present));
   tree token_value = fold_convert (TREE_TYPE (token_field),
-  null_pointer_node);
+  init.get_caf_token ());
   CONSTRUCTOR_APPEND_ELT (v, token_field, token_value);
 }
 
@@ -1430,11 +1443,11 @@ gfc_set_scalar_descriptor (stmtblock_t *block, tree 
descriptor,
 
 void
 gfc_set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
-   symbol_attribute *attr)
+   symbol_attribute *attr, tree caf_token)
 {
   init_struct (block, desc,
   get_descriptor_init (TREE_TYPE (desc), nullptr, 0, attr,
-   scalar_value (scalar)));
+   scalar_value (scalar, caf_token)));
 }
 
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 97cf7f8cb41f..2dad79aa9993 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -149,7 +149,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree, 
tree,
gfc_expr *, locus *);
 tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
-symbol_attribute *);
+symbol_attribute *, tree = NULL_TREE);
 void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
 void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
   gfc_symbol *, bool, bool, bool);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6a96a528029f..c4b0d406e4bf 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -883,14 +883,20 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
   /* Now set the data field.  */
   ctree = gfc_

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction non_lvalue PR97046.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:576440a2089f58f7a64177e4dbbb64b11f3d3346

commit 576440a2089f58f7a64177e4dbbb64b11f3d3346
Author: Mikael Morin 
Date:   Wed Feb 12 10:07:40 2025 +0100

Correction non_lvalue PR97046.f90

Diff:
---
 gcc/fortran/trans-array.cc | 42 +++---
 1 file changed, 27 insertions(+), 15 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index fbbbab9c1d92..8218c1a45bd7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2556,24 +2556,31 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
   tree tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, 
cond,
   gfc_finish_block (&set_void),
   gfc_finish_block (&set_unknown));
+
   /* if (CFI_type_struct) BT_DERIVED else  < tmp2 >  */
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
  build_int_cst (TREE_TYPE (ctype),
 CFI_type_struct));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_DERIVED));
+  stmtblock_t set_derived;
+  gfc_init_block (&set_derived);
+  tree derived_value = build_int_cst (TREE_TYPE (type), BT_DERIVED);
+  gfc_conv_descriptor_type_set (&set_derived, gfc, derived_value);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
+ gfc_finish_block (&set_derived), tmp2);
+
   /* if (CFI_type_Character) BT_CHARACTER else  < tmp2 >  */
   /* Note: this is kind=1, CFI_type_ucs4_char is handled in the 'else if'
 before (see below, as generated bottom up).  */
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
  build_int_cst (TREE_TYPE (ctype),
  CFI_type_Character));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+  stmtblock_t set_character;
+  gfc_init_block (&set_character);
+  tree character_value = build_int_cst (TREE_TYPE (type), BT_CHARACTER);
+  gfc_conv_descriptor_type_set (&set_character, gfc, character_value);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
+ gfc_finish_block (&set_character), tmp2);
+
   /* if (CFI_type_ucs4_char) BT_CHARACTER else  < tmp2 >  */
   /* Note: gfc->elem_len = cfi->elem_len/4.  */
   /* However, assuming that CFI_type_ucs4_char cannot be recovered, leave
@@ -2583,18 +2590,22 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
  build_int_cst (TREE_TYPE (tmp),
 CFI_type_ucs4_char));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+  gfc_init_block (&set_character);
+  gfc_conv_descriptor_type_set (&set_character, gfc, character_value);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
+ gfc_finish_block (&set_character), tmp2);
+
   /* if (CFI_type_Complex) BT_COMPLEX + cfi->elem_len/2 else  < tmp2 >  */
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
  build_int_cst (TREE_TYPE (ctype),
  CFI_type_Complex));
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_COMPLEX));
+  stmtblock_t set_complex;
+  gfc_init_block (&set_complex);
+  tree complex_value = build_int_cst (TREE_TYPE (type), BT_COMPLEX);
+  gfc_conv_descriptor_type_set (&set_complex, gfc, complex_value);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
+ gfc_finish_block (&set_complex), tmp2);
+
   /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real)
   ctype else*/
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 
ctype,
@@ -2610,10 +2621,11 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
 CFI_type_Real));
   cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
  cond, tmp);
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] match: Unwrap non-lvalue as unary or binary operand

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:a85d41c3f52be5bf12e154c83acb6229c4dd0313

commit a85d41c3f52be5bf12e154c83acb6229c4dd0313
Author: Mikael Morin 
Date:   Thu Jul 4 15:24:36 2024 +0200

match: Unwrap non-lvalue as unary or binary operand

This avoids most of the testsuite dump pattern updates with a patch
generating more NON_LVALUE_EXPR trees that I plan to post later.

Regression tested on x86_64-linux.  OK for master?

-- 8< --

gcc/ChangeLog:

* match.pd (`op (non_lvalue X) Y`, `op X (non_lvalue Y)`,
`op (non_lvalue X)`): New simplifications, unwrap NON_LVALUE_EXPR
trees when they are used as operand of a unary or binary operator.

gcc/testsuite/ChangeLog:

* gfortran.dg/non_lvalue_2.f90: New test.

Diff:
---
 gcc/match.pd   | 12 
 gcc/testsuite/gfortran.dg/non_lvalue_2.f90 | 44 ++
 2 files changed, 56 insertions(+)

diff --git a/gcc/match.pd b/gcc/match.pd
index 51bf5b4ccb47..c4aba20bccbe 100644
--- a/gcc/match.pd
+++ b/gcc/match.pd
@@ -281,6 +281,18 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
(outer_op @0 @2)
@3))
 
+/* Remove superfluous NON_LVALUE_EXPR in unary operators.  */
+(for op (UNCOND_UNARY)
+ (simplify (op (non_lvalue @0))
+  (op @0)))
+
+/* Remove superfluous NON_LVALUE_EXPR in binary operators.  */
+(for op (UNCOND_BINARY tcc_comparison)
+ (simplify (op (non_lvalue @0) @1)
+  (op @0 @1))
+ (simplify (op @0 (non_lvalue @1))
+  (op @0 @1)))
+
 /* Simplify x - x.
This is unsafe for certain floats even in non-IEEE formats.
In IEEE, it is unsafe because it does wrong for NaNs.
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_2.f90 
b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
new file mode 100644
index ..8c3197eab1f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the removal of NON_LVALUE_EXPR if they are used in a non-lvalue context
+
+! The NON_LVALUE_EXPR is dropped if it's part (left operand) of a bigger 
expression
+function f1 (f1_arg1, f1_arg2)
+  integer, value :: f1_arg1, f1_arg2
+  integer :: f1
+  f1 = (f1_arg1 + 0) + f1_arg2
+end function
+! { dg-final { scan-tree-dump "__result_f1 = f1_arg1 \\+ f1_arg2;" "original" 
} }
+
+! The NON_LVALUE_EXPR is dropped if it's part (right operand) of a bigger 
expression
+function f2 (f2_arg1, f2_arg2)
+  integer, value :: f2_arg1, f2_arg2
+  integer :: f2
+  f2 = f2_arg1 + (f2_arg2 + 0)
+end function
+! { dg-final { scan-tree-dump "__result_f2 = f2_arg1 \\+ f2_arg2;" "original" 
} }
+
+! The NON_LVALUE_EXPR is dropped if it's part (left operand) of a binary 
logical operator
+function f3 (f3_arg1)
+  integer, value :: f3_arg1
+  logical :: f3
+  f3 = (f3_arg1 + 0) > 0
+end function
+! { dg-final { scan-tree-dump "__result_f3 = f3_arg1 > 0;" "original" } }
+
+! The NON_LVALUE_EXPR is dropped if it's part (right operand) of a binary 
logical operator
+function f4 (f4_arg1, f4_arg2)
+  integer, value :: f4_arg1, f4_arg2
+  logical :: f4
+  f4 = f4_arg1 > (f4_arg2 + 0)
+end function
+! { dg-final { scan-tree-dump "__result_f4 = f4_arg1 > f4_arg2;" "original" } }
+
+! The NON_LVALUE_EXPR is dropped if it's part of a unary operator
+function f5 (f5_arg1)
+  integer, value :: f5_arg1
+  integer :: f5
+  f5 = -(not(not(f5_arg1)))
+end function
+! { dg-final { scan-tree-dump "__result_f5 = -f5_arg1;" "original" } }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Interdiction non-lvalue as lhs

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:ec8b27491965604dd166f4d2e1438e63d08eabdf

commit ec8b27491965604dd166f4d2e1438e63d08eabdf
Author: Mikael Morin 
Date:   Tue Feb 11 21:34:11 2025 +0100

Interdiction non-lvalue as lhs

git commit correction erreur gimplify

Diff:
---
 gcc/gimplify.cc | 6 ++
 1 file changed, 6 insertions(+)

diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index cc0172cf96ef..d3618c4a9b4d 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -7097,6 +7097,12 @@ gimplify_modify_expr (tree *expr_p, gimple_seq *pre_p, 
gimple_seq *post_p,
   gcc_assert (TREE_CODE (*expr_p) == MODIFY_EXPR
  || TREE_CODE (*expr_p) == INIT_EXPR);
 
+  if (TREE_CODE (*to_p) == NON_LVALUE_EXPR)
+{
+  error ("non-lvalue used as lhs in %qD", *expr_p);
+  return GS_ERROR;
+}
+
   /* Trying to simplify a clobber using normal logic doesn't work,
  so handle it here.  */
   if (TREE_CLOBBER_P (*from_p))

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_shift_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:b7452f4c308f2bddef8cacea02c0a6b6754d6421

commit b7452f4c308f2bddef8cacea02c0a6b6754d6421
Author: Mikael Morin 
Date:   Thu Feb 6 17:16:13 2025 +0100

Factorisation gfc_conv_shift_descriptor

Correction compil'

Correction régression allocated_4.f90

Factorisation gfc_conv_shift_descriptor.

Correction régression allocated_4.f90

Modifications mineures

Correction régression bound_10.f90

Correction régression alloc_comp_constructor_1.f90

Correction régression realloc_on_assign_10

Revert "Correction régression realloc_on_assign_10"

This reverts commit 007ca869933eb74b76398200ef0237219ba01cd8.

Correction régression realloc_on_assign_11.f90

Diff:
---
 gcc/fortran/trans-array.cc | 165 ++---
 gcc/fortran/trans-expr.cc  |  15 -
 2 files changed, 94 insertions(+), 86 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index f75829b365d4..9589d1cd3050 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1476,35 +1476,43 @@ gfc_build_null_descriptor (tree type)
specified.  This also updates ubound and offset accordingly.  */
 
 static void
-conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, int dim,
- tree new_lbound, tree offset)
+conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree 
to_desc, int dim,
+ tree new_lbound, tree offset, bool zero_based)
 {
-  tree ubound, lbound, stride;
-  tree diff, offs_diff;
-
   new_lbound = fold_convert (gfc_array_index_type, new_lbound);
+  new_lbound = gfc_evaluate_now (new_lbound, block);
 
-  lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
-  ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
-  stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
+  tree lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
+  tree ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
+  tree stride = gfc_conv_descriptor_stride_get (from_desc, gfc_rank_cst[dim]);
 
-  /* Get difference (new - old) by which to shift stuff.  */
-  diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- new_lbound, lbound);
+  tree diff;
+  if (zero_based)
+diff = new_lbound;
+  else
+{
+  /* Get difference (new - old) by which to shift stuff.  */
+  diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ new_lbound, lbound);
+  diff = gfc_evaluate_now (diff, block);
+}
 
   /* Shift ubound and offset accordingly.  This has to be done before
  updating the lbound, as they depend on the lbound expression!  */
-  ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-   ubound, diff);
-  gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
-  offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-  diff, stride);
-  tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- offset, offs_diff);
-  gfc_add_modify (block, offset, tmp);
+  tree tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+  ubound, diff);
+  gfc_conv_descriptor_ubound_set (block, to_desc, gfc_rank_cst[dim], tmp1);
+  /* Set lbound to the value we want.  */
+  gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim], 
new_lbound);
 
-  /* Finally set lbound to value we want.  */
-  gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+  tree offs_diff = fold_build2_loc (input_location, MULT_EXPR, 
gfc_array_index_type,
+   diff, stride);
+  tree tmp2 = fold_build2_loc (input_location, MINUS_EXPR, 
gfc_array_index_type,
+  offset, offs_diff);
+  gfc_add_modify (block, offset, tmp2);
+
+  if (from_desc != to_desc)
+gfc_conv_descriptor_stride_set (block, to_desc, gfc_rank_cst[dim], stride);
 }
 
 
@@ -1512,6 +1520,7 @@ class lb_info_base
 {
 public:
   virtual tree lower_bound (stmtblock_t *block, int dim) const = 0;
+  virtual bool zero_based_src () const { return false; }
 };
 
 
@@ -1572,21 +1581,64 @@ public:
 
 
 static void
-conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+conv_shift_descriptor (stmtblock_t *block, tree src, tree dest, int rank,
   const lb_info_base &info)
 {
-  tree tmp = gfc_conv_descriptor_offset_get (desc);
-  tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
-  gfc_add_modify (block, offset_var, tmp);
+  if (src != dest)
+{
+  tree tmp = gfc_conv_descriptor_data_get (src);
+  gfc_conv_descriptor_data_set (block, dest, tmp);
+}
+
+  tree offset_va

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_dimension

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:f6dfd5cb157cfee5b31fd82b6e50c75e141d7742

commit f6dfd5cb157cfee5b31fd82b6e50c75e141d7742
Author: Mikael Morin 
Date:   Fri Feb 7 12:07:36 2025 +0100

Factorisation set_descriptor_dimension

Correction compil'

Diff:
---
 gcc/fortran/trans-array.cc | 82 +-
 1 file changed, 44 insertions(+), 38 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9589d1cd3050..a8f99abd30c5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1472,6 +1472,41 @@ gfc_build_null_descriptor (tree type)
 }
 
 
+static tree
+set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
+ tree lbound, tree ubound, tree stride, tree *offset)
+{
+  /* Set bounds in descriptor.  */
+  lbound = fold_convert (gfc_array_index_type, lbound);
+  lbound = gfc_evaluate_now (lbound, block);
+  gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[dim], lbound);
+
+  ubound = fold_convert (gfc_array_index_type, ubound);
+  ubound = gfc_evaluate_now (ubound, block);
+  gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[dim], ubound);
+
+  /* Set stride.  */
+  stride = fold_convert (gfc_array_index_type, stride);
+  stride = gfc_evaluate_now (stride, block);
+  gfc_conv_descriptor_stride_set (block, desc,
+ gfc_rank_cst[dim], stride);
+
+  /* Update offset.  */
+  tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lbound, stride);
+  *offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, *offset, tmp);
+
+  /* Return stride for next dimension.  */
+  tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+  stride = fold_build2_loc (input_location, MULT_EXPR,
+   gfc_array_index_type, stride, tmp);
+  return stride;
+}
+
+
 /* Modify a descriptor such that the lbound of a given dimension is the value
specified.  This also updates ubound and offset accordingly.  */
 
@@ -1822,9 +1857,9 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, 
tree src,
 
   /* Copy offset but adjust it such that it would correspond
  to a lbound of zero.  */
+  tree offset;
   if (src_rank == -1)
-gfc_conv_descriptor_offset_set (block, dest,
-   gfc_index_zero_node);
+offset = gfc_index_zero_node;
   else
 {
   tree offs = gfc_conv_descriptor_offset_get (src);
@@ -1840,7 +1875,7 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, 
tree src,
  offs = fold_build2_loc (input_location, PLUS_EXPR,
  gfc_array_index_type, offs, tmp);
}
-  gfc_conv_descriptor_offset_set (block, dest, offs);
+  offset = offs;
 }
   /* Set the bounds as declared for the LHS and calculate strides as
  well as another offset update accordingly.  */
@@ -1856,46 +1891,17 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree 
dest, tree src,
   /* Convert declared bounds.  */
   gfc_init_se (&lower_se, NULL);
   gfc_init_se (&upper_se, NULL);
-  gfc_conv_expr (&lower_se, as.lower[dim]);
-  gfc_conv_expr (&upper_se, as.upper[dim]);
+  gfc_conv_expr_val (&lower_se, as.lower[dim]);
+  gfc_conv_expr_val (&upper_se, as.upper[dim]);
 
   gfc_add_block_to_block (block, &lower_se.pre);
   gfc_add_block_to_block (block, &upper_se.pre);
 
-  tree lbound = fold_convert (gfc_array_index_type, lower_se.expr);
-  tree ubound = fold_convert (gfc_array_index_type, upper_se.expr);
-
-  lbound = gfc_evaluate_now (lbound, block);
-  ubound = gfc_evaluate_now (ubound, block);
-
-  gfc_add_block_to_block (block, &lower_se.post);
-  gfc_add_block_to_block (block, &upper_se.post);
-
-  /* Set bounds in descriptor.  */
-  gfc_conv_descriptor_lbound_set (block, dest,
- gfc_rank_cst[dim], lbound);
-  gfc_conv_descriptor_ubound_set (block, dest,
- gfc_rank_cst[dim], ubound);
-
-  /* Set stride.  */
-  stride = gfc_evaluate_now (stride, block);
-  gfc_conv_descriptor_stride_set (block, dest,
- gfc_rank_cst[dim], stride);
-
-  /* Update offset.  */
-  tree offs = gfc_conv_descriptor_offset_get (dest);
-  tmp = fold_build2_loc (input_location, MULT_EXPR,
-gfc_array_index_type, lbound, stride);
-  offs = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, offs, tmp);
-  offs = gfc_evaluate_now (offs, block);
-  gfc_conv_descriptor_offset_set (block, dest, offs);
-
-  /* Update stride.  */
-  tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-  stride = fold_build2_loc (input_location, MULT_EX

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Ajout surcharge gfc_conv_descriptor_type_set

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:ef6f2651af67c9d3090780534a958dc312b412e5

commit ef6f2651af67c9d3090780534a958dc312b412e5
Author: Mikael Morin 
Date:   Wed Feb 12 10:22:42 2025 +0100

Ajout surcharge gfc_conv_descriptor_type_set

Diff:
---
 gcc/fortran/trans-array.cc | 41 +
 1 file changed, 29 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8218c1a45bd7..8a7a72d4ecac 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -261,6 +261,15 @@ get_field (tree desc, unsigned field_idx)
   return field;
 }
 
+tree
+get_dtype_subfield (tree desc, unsigned subfield)
+{
+  tree dtype = get_field (desc, DTYPE_FIELD);
+  tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), subfield);
+  gcc_assert (field != NULL_TREE);
+  return field;
+}
+
 tree
 get_component (tree desc, unsigned field_idx)
 {
@@ -518,6 +527,14 @@ conv_type_set (stmtblock_t *block, tree desc, tree value)
  fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
+void
+conv_type_set (stmtblock_t *block, tree desc, int value)
+{
+  tree field = get_dtype_subfield (desc, GFC_DTYPE_TYPE);
+  tree val = build_int_cst (TREE_TYPE (field), value);
+  conv_type_set (block, desc, val);
+}
+
 tree
 get_dimensions (tree desc)
 {
@@ -870,6 +887,12 @@ gfc_conv_descriptor_type_set (stmtblock_t *block, tree 
desc, tree value)
   gfc_descriptor::conv_type_set (block, desc, value);
 }
 
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, int value)
+{
+  gfc_descriptor::conv_type_set (block, desc, value);
+}
+
 tree
 gfc_conv_descriptor_token_get (tree desc)
 {
@@ -2536,7 +2559,6 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
   ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
   ctype, build_int_cst (TREE_TYPE (ctype),
 CFI_type_mask));
-  tree type = gfc_conv_descriptor_type_get (gfc);
 
   /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN  */
   /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
@@ -2545,13 +2567,11 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
 
   stmtblock_t set_void;
   gfc_init_block (&set_void);
-  tree void_value = build_int_cst (TREE_TYPE (type), BT_VOID);
-  gfc_conv_descriptor_type_set (&set_void, gfc, void_value);
+  gfc_conv_descriptor_type_set (&set_void, gfc, BT_VOID);
 
   stmtblock_t set_unknown;
   gfc_init_block (&set_unknown);
-  tree unknown_value = build_int_cst (TREE_TYPE (type), BT_UNKNOWN);
-  gfc_conv_descriptor_type_set (&set_unknown, gfc, unknown_value);
+  gfc_conv_descriptor_type_set (&set_unknown, gfc, BT_UNKNOWN);
 
   tree tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, 
cond,
   gfc_finish_block (&set_void),
@@ -2563,8 +2583,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
 CFI_type_struct));
   stmtblock_t set_derived;
   gfc_init_block (&set_derived);
-  tree derived_value = build_int_cst (TREE_TYPE (type), BT_DERIVED);
-  gfc_conv_descriptor_type_set (&set_derived, gfc, derived_value);
+  gfc_conv_descriptor_type_set (&set_derived, gfc, BT_DERIVED);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  gfc_finish_block (&set_derived), tmp2);
 
@@ -2576,8 +2595,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
  CFI_type_Character));
   stmtblock_t set_character;
   gfc_init_block (&set_character);
-  tree character_value = build_int_cst (TREE_TYPE (type), BT_CHARACTER);
-  gfc_conv_descriptor_type_set (&set_character, gfc, character_value);
+  gfc_conv_descriptor_type_set (&set_character, gfc, BT_CHARACTER);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  gfc_finish_block (&set_character), tmp2);
 
@@ -2591,7 +2609,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
  build_int_cst (TREE_TYPE (tmp),
 CFI_type_ucs4_char));
   gfc_init_block (&set_character);
-  gfc_conv_descriptor_type_set (&set_character, gfc, character_value);
+  gfc_conv_descriptor_type_set (&set_character, gfc, BT_CHARACTER);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  gfc_finish_block (&set_character), tmp2);
 
@@ -2601,8 +2619,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
  CFI_type_Complex));
   stmtblock_t set_complex;
   gfc_init_block (&set_complex);
-  tree complex_value = build_int_cst (TREE_TYPE (type), BT_COMPLEX);
-  gfc_conv_descriptor_type_set (&set_complex, 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set temporary descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:b85b29d07c7c0ea86c09d4b9464eca64090a66e2

commit b85b29d07c7c0ea86c09d4b9464eca64090a66e2
Author: Mikael Morin 
Date:   Wed Feb 12 18:17:41 2025 +0100

Factorisation set temporary descriptor

Suppression code redondant initialisation descriptor temporaire

Réduction différences

Correction régression class_transformational_2

Diff:
---
 gcc/fortran/trans-array.cc | 119 -
 1 file changed, 74 insertions(+), 45 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8a7a72d4ecac..eccc32cc1a41 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3294,13 +3294,14 @@ gfc_set_loop_bounds_from_array_spec 
(gfc_interface_mapping * mapping,
DYNAMIC is true if the caller may want to extend the array later
using realloc.  This prevents us from putting the array on the stack.  */
 
-static void
+static tree
 gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
  gfc_array_info * info, tree size, tree nelem,
  tree initial, bool dynamic, bool dealloc)
 {
   tree tmp;
   tree desc;
+  tree ptr = NULL_TREE;
   bool onstack;
 
   desc = info->descriptor;
@@ -3308,7 +3309,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, 
stmtblock_t * post,
   if (size == NULL_TREE || (dynamic && integer_zerop (size)))
 {
   /* A callee allocated array.  */
-  gfc_conv_descriptor_data_set (pre, desc, null_pointer_node);
+  ptr = null_pointer_node;
   onstack = false;
 }
   else
@@ -3336,8 +3337,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, 
stmtblock_t * post,
   fold_build1_loc (input_location,
DECL_EXPR, TREE_TYPE (tmp),
tmp));
- tmp = gfc_build_addr_expr (NULL_TREE, tmp);
- gfc_conv_descriptor_data_set (pre, desc, tmp);
+ ptr = gfc_build_addr_expr (NULL_TREE, tmp);
}
   else
{
@@ -3345,7 +3345,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, 
stmtblock_t * post,
  if (initial == NULL_TREE)
{
  tmp = gfc_call_malloc (pre, NULL, size);
- tmp = gfc_evaluate_now (tmp, pre);
+ ptr = gfc_evaluate_now (tmp, pre);
}
  else
{
@@ -3388,18 +3388,12 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, 
stmtblock_t * post,
  build_empty_stmt (input_location));
  gfc_add_expr_to_block (pre, tmp);
 
- tmp = fold_convert (pvoid_type_node, packed);
+ ptr = fold_convert (pvoid_type_node, packed);
}
-
- gfc_conv_descriptor_data_set (pre, desc, tmp);
}
 }
   info->data = gfc_conv_descriptor_data_get (desc);
 
-  /* The offset is zero because we create temporaries with a zero
- lower bound.  */
-  gfc_conv_descriptor_offset_set (pre, desc, gfc_index_zero_node);
-
   if (dealloc && !onstack)
 {
   /* Free the temporary.  */
@@ -3407,6 +3401,8 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, 
stmtblock_t * post,
   tmp = gfc_call_free (tmp);
   gfc_add_expr_to_block (post, tmp);
 }
+
+  return ptr;
 }
 
 
@@ -3618,6 +3614,61 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, 
tree *eltype,
 }
 
 
+static void
+set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
+ tree elemsize, tree data_ptr,
+ tree ubound[GFC_MAX_DIMENSIONS],
+ tree stride[GFC_MAX_DIMENSIONS], int rank,
+ bool callee_allocated, bool rank_changer)
+{
+  int n;
+
+  if (!class_src)
+{
+  /* Fill in the array dtype.  */
+  gfc_conv_descriptor_dtype_set (block, desc,
+gfc_get_dtype (TREE_TYPE (desc)));
+}
+  else if (rank_changer)
+{
+  /* For classes, we copy the whole original class descriptor to the
+ temporary one, so we don't need to set the individual dtype fields.
+Except for the case of rank altering intrinsics for which we
+generate descriptors of different rank.  */
+
+  /* Take the dtype from the class expression.  */
+  tree src_data = gfc_class_data_get (class_src);
+  tree dtype = gfc_conv_descriptor_dtype_get (src_data);
+  gfc_conv_descriptor_dtype_set (block, desc, dtype);
+
+  /* These transformational functions change the rank.  */
+  gfc_conv_descriptor_rank_set (block, desc, rank);
+}
+
+  if (!callee_allocated)
+{
+  for (n = 0; n < rank; n++)
+   {
+ /* Store the stride and bound components in the descriptor.  */
+ gfc_conv_descriptor_stride_set (block, desc, gfc_rank_cst[n],
+ stride[n]);
+
+ 

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Suppression argument nelems gfc_array_allocate

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:4be447df2ea1fa08e1394514ded0a1412eccc49e

commit 4be447df2ea1fa08e1394514ded0a1412eccc49e
Author: Mikael Morin 
Date:   Fri Feb 14 12:11:43 2025 +0100

Suppression argument nelems gfc_array_allocate

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 285ec4380dcc..d9185bf23005 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8683,9 +8683,8 @@ retrieve_last_ref (gfc_ref **ref_in, gfc_ref 
**prev_ref_in)
 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 explicit_ts)
+   gfc_expr *expr3, tree e3_arr_desc, bool e3_has_nodescriptor,
+   gfc_omp_namelist *omp_alloc, bool explicit_ts)
 {
   tree tmp;
   tree pointer;
@@ -8822,7 +8821,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
 expr3_elem_size, expr3, e3_arr_desc,
 e3_has_nodescriptor, expr, element_size,
 explicit_ts, &empty_array_cond);
-  *nelems = count;
 
   tree size = get_array_memory_size (element_size, count, empty_array_cond,
 &se->pre, &overflow);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index f37f09c21cff..357bd64fb766 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -21,7 +21,7 @@ along with GCC; see the file COPYING3.  If not see
 /* Generate code to initialize and allocate an array.  Statements are added to
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,
+tree, gfc_expr *, tree, bool,
 gfc_omp_namelist *, bool);
 
 /* Allow the bounds of a loop to be set from a callee's array spec.  */
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f4e3ea36cbe3..4406bc6e4ce2 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6394,7 +6394,6 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist 
*omp_allocate)
   stmtblock_t block;
   stmtblock_t post;
   stmtblock_t final_block;
-  tree nelems;
   bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
   bool needs_caf_sync, caf_refs_comp;
   bool e3_has_nodescriptor = false;
@@ -6926,7 +6925,6 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist 
*omp_allocate)
 to handle the complete array allocation.  Only the element size
 needs to be provided, which is done most of the time by the
 pre-evaluation step.  */
-  nelems = NULL_TREE;
   if (expr3_len && (code->expr3->ts.type == BT_CHARACTER
|| code->expr3->ts.type == BT_CLASS))
{
@@ -6998,8 +6996,7 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist 
*omp_allocate)
}
 
   if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen,
-  label_finish, tmp, &nelems,
-  e3rhs ? e3rhs : code->expr3,
+  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))

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement fonction

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:f505307e25fbdb583454a11a936325f3bbd51fc8

commit f505307e25fbdb583454a11a936325f3bbd51fc8
Author: Mikael Morin 
Date:   Fri Feb 14 09:34:02 2025 +0100

Déplacement fonction

Diff:
---
 gcc/fortran/trans-array.cc | 53 ++
 gcc/fortran/trans-array.h  |  1 +
 gcc/fortran/trans-expr.cc  | 41 ++-
 3 files changed, 47 insertions(+), 48 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2f33dae6ad01..0be076f046ce 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2225,6 +2225,44 @@ gfc_conv_shift_descriptor_subarray (stmtblock_t *block, 
tree desc,
 }
 
 
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+  tree lbound[GFC_MAX_DIMENSIONS],
+  tree ubound[GFC_MAX_DIMENSIONS])
+{
+  tree size = gfc_index_one_node;
+  tree offset = gfc_index_zero_node;
+  for (int n = 0; n < rank; n++)
+{
+  tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp,
+gfc_index_one_node);
+  gfc_conv_descriptor_ubound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ tmp);
+  gfc_conv_descriptor_lbound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ gfc_index_one_node);
+  size = gfc_evaluate_now (size, block);
+  offset = fold_build2_loc (input_location, MINUS_EXPR,
+   gfc_array_index_type,
+   offset, size);
+  offset = gfc_evaluate_now (offset, block);
+  tmp = gfc_conv_array_extent_dim (lbound[n], ubound[n], nullptr);
+  size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+}
+
+  gfc_conv_descriptor_offset_set (block, desc,
+ offset);
+}
+
+
+
+
 int
 gfc_descriptor_rank (tree descriptor)
 {
@@ -8392,15 +8430,12 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
 start at zero, but when allocating it, the standard expects
 the array to start at one.  Therefore fix the upper bound to be
 (desc.ubound - desc.lbound) + 1.  */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-gfc_conv_descriptor_ubound_get (
-  expr3_desc, gfc_rank_cst[n]),
-gfc_conv_descriptor_lbound_get (
-  expr3_desc, gfc_rank_cst[n]));
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp,
-gfc_index_one_node);
+ tmp = gfc_conv_array_extent_dim (
+ gfc_conv_descriptor_lbound_get (expr3_desc,
+ gfc_rank_cst[n]),
+ gfc_conv_descriptor_ubound_get (expr3_desc,
+ gfc_rank_cst[n]),
+ nullptr);
  se.expr = gfc_evaluate_now (tmp, pblock);
}
  else
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 836a177da014..f37f09c21cff 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -237,6 +237,7 @@ void gfc_conv_shift_descriptor (stmtblock_t*, tree, const 
gfc_array_ref &);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, int);
 void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
 void gfc_conv_shift_descriptor_subarray (stmtblock_t*, tree, gfc_expr *, 
gfc_expr *);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, int, tree *, tree *);
 
 /* Add pre-loop scalarization code for intrinsic functions which require
special handling.  */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index fa8f9d71c8b9..ef8d69cb9162 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5359,43 +5359,6 @@ gfc_apply_interface_mapping (gfc_interface_mapping * 
mapping,
 }
 
 
-static void
-shift_descriptor (stmtblock_t *block, tree desc, int rank,
- tree lbound[GFC_MAX_DIMENSIONS],
- tree ubound[GFC_MAX_DIMENSIONS])
-
-{
-  tree size = gfc_index_one_node;
-  tree offset = gfc_index_zero_node;
-  for (int n = 0; n < rank; n++)
-{
-  tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
-  tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gf

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation descriptor_element_size

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:0af42b5926b283ceba927a70b6f0024949b46de7

commit 0af42b5926b283ceba927a70b6f0024949b46de7
Author: Mikael Morin 
Date:   Fri Feb 14 11:04:01 2025 +0100

Factorisation descriptor_element_size

Diff:
---
 gcc/fortran/trans-array.cc | 85 +++---
 1 file changed, 51 insertions(+), 34 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0be076f046ce..0ed3a5036e0d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8262,6 +8262,46 @@ gfc_conv_descriptor_cosize (tree desc, int rank, int 
corank)
 }
 
 
+static tree
+descriptor_element_size (tree descriptor, tree expr3_elem_size,
+gfc_expr *expr3)
+{
+  tree type;
+  tree tmp;
+
+  type = TREE_TYPE (descriptor);
+
+  /* Obviously, if there is a SOURCE expression (expr3) we must use its element
+ size.  */
+  if (expr3_elem_size != NULL_TREE)
+tmp = expr3_elem_size;
+  else if (expr3 != NULL)
+{
+  if (expr3->ts.type == BT_CLASS)
+   {
+ gfc_se se_sz;
+ gfc_expr *sz = gfc_copy_expr (expr3);
+ gfc_add_vptr_component (sz);
+ gfc_add_size_component (sz);
+ gfc_init_se (&se_sz, NULL);
+ gfc_conv_expr (&se_sz, sz);
+ gfc_free_expr (sz);
+ tmp = se_sz.expr;
+   }
+  else
+   {
+ tmp = gfc_typenode_for_spec (&expr3->ts);
+ tmp = TYPE_SIZE_UNIT (tmp);
+   }
+}
+  else
+tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+
+  /* Convert to size_t.  */
+  return fold_convert (size_type_node, tmp);
+}
+
+
 /* Fills in an array descriptor, and returns the size of the array.
The size will be a simple_val, ie a variable or a constant.  Also
calculates the offset of the base.  The pointer argument overflow,
@@ -8299,7 +8339,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, bool explicit_ts)
+tree element_size, bool explicit_ts)
 {
   tree type;
   tree tmp;
@@ -8532,37 +8572,10 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
 }
 
   /* The stride is the number of elements in the array, so multiply by the
- size of an element to get the total size.  Obviously, if there is a
- SOURCE expression (expr3) we must use its element size.  */
-  if (expr3_elem_size != NULL_TREE)
-tmp = expr3_elem_size;
-  else if (expr3 != NULL)
-{
-  if (expr3->ts.type == BT_CLASS)
-   {
- gfc_se se_sz;
- gfc_expr *sz = gfc_copy_expr (expr3);
- gfc_add_vptr_component (sz);
- gfc_add_size_component (sz);
- gfc_init_se (&se_sz, NULL);
- gfc_conv_expr (&se_sz, sz);
- gfc_free_expr (sz);
- tmp = se_sz.expr;
-   }
-  else
-   {
- tmp = gfc_typenode_for_spec (&expr3->ts);
- tmp = TYPE_SIZE_UNIT (tmp);
-   }
-}
-  else
-tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
-
-  /* Convert to size_t.  */
-  *element_size = fold_convert (size_type_node, tmp);
+ size of an element to get the total size.  */
 
   if (rank == 0)
-return *element_size;
+return element_size;
 
   *nelems = gfc_evaluate_now (stride, pblock);
   stride = fold_convert (size_type_node, stride);
@@ -8572,14 +8585,14 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
  dividing.  */
   tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
 size_type_node,
-TYPE_MAX_VALUE (size_type_node), *element_size);
+TYPE_MAX_VALUE (size_type_node), element_size);
   cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
logical_type_node, tmp, stride),
   PRED_FORTRAN_OVERFLOW);
   tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
 integer_one_node, integer_zero_node);
   cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
-   logical_type_node, *element_size,
+   logical_type_node, element_size,
build_int_cst (size_type_node, 0)),
   PRED_FORTRAN_SIZE_ZERO);
   tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
@@ -8589,7 +8602,7 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   *overflow = gfc_evaluate_now (tmp, pblock);
 
   size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- stride, *element_size);
+ stride, ele

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction erreurs non-lvalue lhs pr113363.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:22b0d8aef9655e7fa93da20bcf68457d7395a14d

commit 22b0d8aef9655e7fa93da20bcf68457d7395a14d
Author: Mikael Morin 
Date:   Wed Feb 12 10:47:31 2025 +0100

Correction erreurs non-lvalue lhs pr113363.f90

Diff:
---
 gcc/fortran/trans-decl.cc | 21 +
 gcc/fortran/trans.cc  |  4 ++--
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 8df09cfa46df..f6def491e5c7 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5144,10 +5144,23 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
  if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
{
  /* Nullify when entering the scope.  */
- tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-TREE_TYPE (se.expr), se.expr,
-fold_convert (TREE_TYPE (se.expr),
-  null_pointer_node));
+ if (sym->ts.type == BT_CLASS
+ && (CLASS_DATA (sym)->attr.dimension
+ || CLASS_DATA (sym)->attr.codimension))
+   {
+ stmtblock_t nullify;
+ gfc_init_block (&nullify);
+ gfc_conv_descriptor_data_set (&nullify, descriptor,
+   null_pointer_node);
+ tmp = gfc_finish_block (&nullify);
+   }
+ else
+   {
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+TREE_TYPE (se.expr), se.expr,
+fold_convert (TREE_TYPE 
(se.expr),
+  
null_pointer_node));
+   }
  if (sym->attr.optional)
{
  tree present = gfc_conv_expr_present (sym);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 9880726c6113..c72bf8be4198 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1737,7 +1737,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
 gfc_call_free (data_ptr),
 build_empty_stmt (input_location));
   gfc_add_expr_to_block (&se->loop->post, tmp);
-  gfc_add_modify (&se->loop->post, data_ptr, data_null);
+  gfc_conv_descriptor_data_set (&se->loop->post, desc, data_null);
 }
   else
 {
@@ -1751,7 +1751,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
 gfc_call_free (data_ptr),
 build_empty_stmt (input_location));
  gfc_add_expr_to_block (&se->finalblock, tmp);
- gfc_add_modify (&se->finalblock, data_ptr, data_null);
+ gfc_conv_descriptor_data_set (&se->finalblock, desc, data_null);
}
 }
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:2d7569cb25c53e1a865308d2c3104f84127ca4e7

commit 2d7569cb25c53e1a865308d2c3104f84127ca4e7
Author: Mikael Morin 
Date:   Thu Feb 13 21:03:54 2025 +0100

Factorisation shift_descriptor

Diff:
---
 gcc/fortran/trans-expr.cc | 76 ---
 1 file changed, 39 insertions(+), 37 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7b4e9c83f814..fa8f9d71c8b9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5359,6 +5359,43 @@ gfc_apply_interface_mapping (gfc_interface_mapping * 
mapping,
 }
 
 
+static void
+shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ tree lbound[GFC_MAX_DIMENSIONS],
+ tree ubound[GFC_MAX_DIMENSIONS])
+
+{
+  tree size = gfc_index_one_node;
+  tree offset = gfc_index_zero_node;
+  for (int n = 0; n < rank; n++)
+{
+  tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp,
+gfc_index_one_node);
+  gfc_conv_descriptor_ubound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ tmp);
+  gfc_conv_descriptor_lbound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ gfc_index_one_node);
+  size = gfc_evaluate_now (size, block);
+  offset = fold_build2_loc (input_location, MINUS_EXPR,
+   gfc_array_index_type,
+   offset, size);
+  offset = gfc_evaluate_now (offset, block);
+  tmp = gfc_conv_array_extent_dim (lbound[n], ubound[n], nullptr);
+  size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+}
+
+  gfc_conv_descriptor_offset_set (block, desc,
+ offset);
+}
+
+
 /* Returns a reference to a temporary array into which a component of
an actual argument derived type array is copied and then returned
after the function call.  */
@@ -5379,7 +5416,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, 
int g77,
   tree tmp_index;
   tree tmp;
   tree base_type;
-  tree size;
   stmtblock_t body;
   int n;
   int dimen;
@@ -5630,42 +5666,8 @@ class_array_fcn:
   /* Determine the offset for pointer formal arguments and set the
  lbounds to one.  */
   if (formal_ptr)
-{
-  size = gfc_index_one_node;
-  offset = gfc_index_zero_node;
-  for (n = 0; n < dimen; n++)
-   {
- tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
-   gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp,
-gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- tmp);
- gfc_conv_descriptor_lbound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- gfc_index_one_node);
- size = gfc_evaluate_now (size, &parmse->pre);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
-   gfc_array_index_type,
-   offset, size);
- offset = gfc_evaluate_now (offset, &parmse->pre);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-rse.loop->to[n], rse.loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type,
-tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
-   }
-
-  gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
- offset);
-}
+shift_descriptor (&parmse->pre, parmse->expr, dimen,
+ rse.loop->from, rse.loop->to);
 
   /* We want either the address for the data or the address of the descriptor,
  depending on the mode of passing array arguments.  */

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Mise à jour offset & span dans gfc_array_init_size

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:d8eaa4c2c72906f724445736c53ef049c24d6847

commit d8eaa4c2c72906f724445736c53ef049c24d6847
Author: Mikael Morin 
Date:   Fri Feb 14 11:22:35 2025 +0100

Mise à jour offset & span dans gfc_array_init_size

Diff:
---
 gcc/fortran/trans-array.cc | 34 --
 1 file changed, 12 insertions(+), 22 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0ed3a5036e0d..e9f7ea16097f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8334,8 +8334,8 @@ descriptor_element_size (tree descriptor, tree 
expr3_elem_size,
 /*GCC ARRAYS*/
 
 static tree
-gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
-gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
+gfc_array_init_size (tree descriptor, int rank, int corank, gfc_expr ** lower,
+gfc_expr ** upper, stmtblock_t * pblock,
 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,
@@ -8577,6 +8577,12 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   if (rank == 0)
 return element_size;
 
+  /* Update the array descriptor with the offset and the span.  */
+  offset = gfc_evaluate_now (offset, pblock);
+  gfc_conv_descriptor_offset_set (descriptor_block, descriptor, offset);
+  tmp = fold_convert (gfc_array_index_type, element_size);
+  gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp);
+
   *nelems = gfc_evaluate_now (stride, pblock);
   stride = fold_convert (size_type_node, stride);
 
@@ -8604,12 +8610,6 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
  stride, element_size);
 
-  if (poffset != NULL)
-{
-  offset = gfc_evaluate_now (offset, pblock);
-  *poffset = offset;
-}
-
   if (integer_zerop (or_expr))
 return size;
   if (integer_onep (or_expr))
@@ -8672,7 +8672,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
 {
   tree tmp;
   tree pointer;
-  tree offset = NULL_TREE;
   tree token = NULL_TREE;
   tree size;
   tree msg;
@@ -8801,11 +8800,10 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
   size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank
   : ref->u.ar.as->rank,
  coarray ? ref->u.ar.as->corank : 0,
- &offset, lower, upper,
- &se->pre, &set_descriptor_block, &overflow,
- expr3_elem_size, nelems, expr3, e3_arr_desc,
- e3_has_nodescriptor, expr, element_size,
- explicit_ts);
+ lower, upper, &se->pre, &set_descriptor_block,
+ &overflow, expr3_elem_size, nelems, expr3,
+ e3_arr_desc, e3_has_nodescriptor, expr,
+ element_size, explicit_ts);
 
   if (dimension)
 {
@@ -8942,14 +8940,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  /* Update the array descriptor with the offset and the span.  */
-  if (dimension)
-{
-  gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
-  tmp = fold_convert (gfc_array_index_type, element_size);
-  gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp);
-}
-
   set_descriptor = gfc_finish_block (&set_descriptor_block);
   if (status != NULL_TREE)
 {

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_dimension

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:4128faf3ad0d5953a26b0dce85fa603e0104419b

commit 4128faf3ad0d5953a26b0dce85fa603e0104419b
Author: Mikael Morin 
Date:   Thu Feb 13 20:26:47 2025 +0100

Factorisation set_descriptor_dimension

Correction typo

Diff:
---
 gcc/fortran/trans-array.cc | 12 +---
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index eccc32cc1a41..2f33dae6ad01 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1904,6 +1904,9 @@ set_bounds_update_offset (stmtblock_t *block, tree desc, 
int dim,
 gfc_conv_descriptor_stride_set (block, desc,
gfc_rank_cst[dim], stride);
 
+  if (!offset && !next_stride)
+return;
+
   /* Update offset.  */
   tree tmp = fold_build2_loc (input_location, MULT_EXPR,
  gfc_array_index_type, lbound_diff, stride);
@@ -3650,13 +3653,8 @@ set_temporary_descriptor (stmtblock_t *block, tree desc, 
tree class_src,
   for (n = 0; n < rank; n++)
{
  /* Store the stride and bound components in the descriptor.  */
- gfc_conv_descriptor_stride_set (block, desc, gfc_rank_cst[n],
- stride[n]);
-
- gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[n],
- gfc_index_zero_node);
-
- gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[n], 
ubound[n]);
+ set_descriptor_dimension (block, desc, n, gfc_index_zero_node, 
ubound[n],
+   stride[n], nullptr, nullptr);
}
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Renommage gfc_array_init_count -> gfc_descr_init_count

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:0374a209041fa96c3e173d46512d0313a5dad8b5

commit 0374a209041fa96c3e173d46512d0313a5dad8b5
Author: Mikael Morin 
Date:   Fri Feb 14 13:46:24 2025 +0100

Renommage gfc_array_init_count -> gfc_descr_init_count

Diff:
---
 gcc/fortran/trans-array.cc | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index fd28d1a0b180..9b026bac56a0 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8398,7 +8398,7 @@ get_array_memory_size (tree element_size, tree 
elements_count,
 /*GCC ARRAYS*/
 
 static tree
-gfc_array_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
+gfc_descr_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
  gfc_expr ** upper, stmtblock_t * pblock,
  stmtblock_t * descriptor_block, tree * overflow,
  tree expr3_elem_size, gfc_expr *expr3, tree expr3_desc,
@@ -8811,7 +8811,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
  later will mislead the generation of the array dimensions for allocatable/
  pointer components in derived types.  */
   int rank = alloc_w_e3_arr_spec ? expr->rank : ref->u.ar.as->rank;
-  tree count = gfc_array_init_count (se->expr, rank,
+  tree count = gfc_descr_init_count (se->expr, rank,
 coarray ? ref->u.ar.as->corank : 0,
 lower, upper, &se->pre,
 &set_descriptor_block, &overflow,

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction ICE class_to_type_1

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:5c1e019c73014fe6e7c2654dea03e9cc0b02d891

commit 5c1e019c73014fe6e7c2654dea03e9cc0b02d891
Author: Mikael Morin 
Date:   Fri Feb 14 17:11:03 2025 +0100

Correction ICE class_to_type_1

Diff:
---
 gcc/fortran/trans-array.cc | 30 --
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d085e76a14e3..ef9c5c8dfc16 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8144,22 +8144,24 @@ late_set_loop_bounds (gfc_loopinfo *loop)
 
   for (n = 0; n < loop->dimen; n++)
 {
-  /* We should have found the scalarization loop specifier.  If not,
-that's bad news.  */
-  gcc_assert (loopspec[n]);
-
-  info = &loopspec[n]->info->data.array;
-  dim = loopspec[n]->dim[n];
-
   /* Set the extents of this range.  */
-  if ((loop->from[n] == NULL_TREE
-  || loop->to[n] == NULL_TREE)
- && loopspec[n]->info->type == GFC_SS_FUNCTION
- && info->start[dim]
- && info->end[dim])
+  if (loop->from[n] == NULL_TREE
+ || loop->to[n] == NULL_TREE)
{
- loop->from[n] = info->start[dim];
- loop->to[n] = info->end[dim];
+ /* We should have found the scalarization loop specifier.  If not,
+that's bad news.  */
+ gcc_assert (loopspec[n]);
+
+ info = &loopspec[n]->info->data.array;
+ dim = loopspec[n]->dim[n];
+
+ if (loopspec[n]->info->type == GFC_SS_FUNCTION
+ && info->start[dim]
+ && info->end[dim])
+   {
+ loop->from[n] = info->start[dim];
+ loop->to[n] = info->end[dim];
+   }
}
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Séparation get_array_memory_size

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:e21cc2e485be9d0a0d97cb96996d07d6b323f7d8

commit e21cc2e485be9d0a0d97cb96996d07d6b323f7d8
Author: Mikael Morin 
Date:   Fri Feb 14 12:07:08 2025 +0100

Séparation get_array_memory_size

Diff:
---
 gcc/fortran/trans-array.cc | 160 ++---
 1 file changed, 91 insertions(+), 69 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e9f7ea16097f..285ec4380dcc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8302,6 +8302,70 @@ descriptor_element_size (tree descriptor, tree 
expr3_elem_size,
 }
 
 
+static tree
+get_array_memory_size (tree element_size, tree elements_count,
+  tree empty_array_cond, stmtblock_t * pblock,
+  tree * overflow)
+{
+  tree tmp;
+  tree size;
+  tree thencase;
+  tree elsecase;
+  tree cond;
+  tree var;
+  stmtblock_t thenblock;
+  stmtblock_t elseblock;
+
+
+
+  elements_count = fold_convert (size_type_node, elements_count);
+
+  /* First check for overflow. Since an array of type character can
+ have zero element_size, we must check for that before
+ dividing.  */
+  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+size_type_node,
+TYPE_MAX_VALUE (size_type_node), element_size);
+  cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
+   logical_type_node, tmp, elements_count),
+  PRED_FORTRAN_OVERFLOW);
+  tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+integer_one_node, integer_zero_node);
+  cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
+   logical_type_node, element_size,
+   build_int_cst (size_type_node, 0)),
+  PRED_FORTRAN_SIZE_ZERO);
+  tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+integer_zero_node, tmp);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+*overflow, tmp);
+  *overflow = gfc_evaluate_now (tmp, pblock);
+
+  size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+ elements_count, element_size);
+
+  if (integer_zerop (empty_array_cond))
+return size;
+  if (integer_onep (empty_array_cond))
+return build_int_cst (size_type_node, 0);
+
+  var = gfc_create_var (TREE_TYPE (size), "size");
+  gfc_start_block (&thenblock);
+  gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
+  thencase = gfc_finish_block (&thenblock);
+
+  gfc_start_block (&elseblock);
+  gfc_add_modify (&elseblock, var, size);
+  elsecase = gfc_finish_block (&elseblock);
+
+  tmp = gfc_evaluate_now (empty_array_cond, pblock);
+  tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+  gfc_add_expr_to_block (pblock, tmp);
+
+  return var;
+}
+
+
 /* Fills in an array descriptor, and returns the size of the array.
The size will be a simple_val, ie a variable or a constant.  Also
calculates the offset of the base.  The pointer argument overflow,
@@ -8334,25 +8398,20 @@ descriptor_element_size (tree descriptor, tree 
expr3_elem_size,
 /*GCC ARRAYS*/
 
 static tree
-gfc_array_init_size (tree descriptor, int rank, int corank, gfc_expr ** lower,
-gfc_expr ** upper, stmtblock_t * pblock,
-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, bool explicit_ts)
+gfc_array_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
+ gfc_expr ** upper, stmtblock_t * pblock,
+ 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 *empty_array_cond)
 {
   tree type;
   tree tmp;
   tree size;
   tree offset;
   tree stride;
-  tree or_expr;
-  tree thencase;
-  tree elsecase;
   tree cond;
-  tree var;
-  stmtblock_t thenblock;
-  stmtblock_t elseblock;
   gfc_expr *ubound;
   gfc_se se;
   int n;
@@ -8406,7 +8465,7 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, gfc_expr ** lower,
   else
 gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
 
-  or_expr = logical_false_node;
+  tree empty_cond = logical_false_node;
 
   for (n = 0; n < rank; n++)
 {
@@ -8499,7 +8558,8 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, gfc_expr ** lower,
  gfc_rank_cst[n], stride);
 
   /* Calculate size and check whethe

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Mise à jour commentaires.

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:4cdbf21a2b770dbae310eeb81b843d47d0d7b7e0

commit 4cdbf21a2b770dbae310eeb81b843d47d0d7b7e0
Author: Mikael Morin 
Date:   Fri Feb 14 12:23:42 2025 +0100

Mise à jour commentaires.

Diff:
---
 gcc/fortran/trans-array.cc | 37 ++---
 1 file changed, 18 insertions(+), 19 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d9185bf23005..fd28d1a0b180 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8302,6 +8302,13 @@ descriptor_element_size (tree descriptor, tree 
expr3_elem_size,
 }
 
 
+/* Calculates the memory size of an array, given the size of its elements,
+   the number of them, and the predicate whether the array is empty.
+elements_count = (size_t) elements_count;
+overflow += element_size == 0 ? 0: (MAX/element_size < elements_count ? 1: 
0);
+tmp = elements_count * element_size;
+return (tmp);  */
+
 static tree
 get_array_memory_size (tree element_size, tree elements_count,
   tree empty_array_cond, stmtblock_t * pblock,
@@ -8316,8 +8323,6 @@ get_array_memory_size (tree element_size, tree 
elements_count,
   stmtblock_t thenblock;
   stmtblock_t elseblock;
 
-
-
   elements_count = fold_convert (size_type_node, elements_count);
 
   /* First check for overflow. Since an array of type character can
@@ -8366,11 +8371,10 @@ get_array_memory_size (tree element_size, tree 
elements_count,
 }
 
 
-/* Fills in an array descriptor, and returns the size of the array.
-   The size will be a simple_val, ie a variable or a constant.  Also
-   calculates the offset of the base.  The pointer argument overflow,
-   which should be of integer type, will increase in value if overflow
-   occurs during the size calculation.  Returns the size of the array.
+/* Fills in an array descriptor, and returns the number of elements in the
+   array.  The pointer argument overflow, which should be of integer type,
+   will increase in value if overflow occurs during the size calculation.
+   Also sets the condition whether the array is empty through empty_array_cond.
{
 stride = 1;
 offset = 0;
@@ -8387,13 +8391,9 @@ get_array_memory_size (tree element_size, tree 
elements_count,
   }
 for (n = rank; n < rank+corank; n++)
   (Set lcobound/ucobound as above.)
-element_size = sizeof (array element);
-if (!rank)
-  return element_size
-stride = (size_t) stride;
-overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
-stride = stride * element_size;
-return (stride);
+if (rank == 0)
+  return 1;
+return stride;
}  */
 /*GCC ARRAYS*/
 
@@ -8633,9 +8633,6 @@ gfc_array_init_count (tree descriptor, int rank, int 
corank, gfc_expr ** lower,
 
   *empty_array_cond = empty_cond;
 
-  /* The stride is the number of elements in the array, so multiply by the
- size of an element to get the total size.  */
-
   if (rank == 0)
 return gfc_index_one_node;
 
@@ -8822,8 +8819,10 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
 e3_has_nodescriptor, expr, element_size,
 explicit_ts, &empty_array_cond);
 
-  tree size = get_array_memory_size (element_size, count, empty_array_cond,
-&se->pre, &overflow);
+  tree size = rank == 0
+ ? element_size
+ : get_array_memory_size (element_size, count, empty_array_cond,
+  &se->pre, &overflow);
 
   if (dimension)
 {

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régression class_assign_4.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:96f10811438e71886fe18291ac963b27fd8e2872

commit 96f10811438e71886fe18291ac963b27fd8e2872
Author: Mikael Morin 
Date:   Sat Feb 15 18:29:16 2025 +0100

Correction régression class_assign_4.f90

Diff:
---
 gcc/fortran/trans-array.cc | 6 --
 1 file changed, 6 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b15e4ba5a8f9..9fe54c76e0d8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3616,12 +3616,6 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, 
tree *eltype,
  tmp2 = gfc_class_len_get (class_expr);
  gfc_add_modify (pre, tmp, tmp2);
}
-
-  if (rhs_function)
-   {
- tmp = gfc_class_data_get (class_expr);
- gfc_conv_descriptor_offset_set (pre, tmp, gfc_index_zero_node);
-   }
 }
   else if (rhs_ss->info->data.array.descriptor)
{

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction class_result_10.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:4bd037871f3981246e94c5642f9adf2e848e72b6

commit 4bd037871f3981246e94c5642f9adf2e848e72b6
Author: Mikael Morin 
Date:   Fri Feb 14 18:48:22 2025 +0100

Correction class_result_10.f90

Diff:
---
 gcc/fortran/trans-array.cc | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7345b8c98e80..76ed869d6f8b 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7445,7 +7445,8 @@ done:
  int dim = ss->dim[n];
 
  info->start[dim]  = gfc_index_zero_node;
- info->end[dim]= gfc_index_zero_node;
+ if (ss_info->type != GFC_SS_FUNCTION)
+   info->end[dim]= gfc_index_zero_node;
  info->stride[dim] = gfc_index_one_node;
}
  break;

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régression class_to_type_2.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:77b5e02250d76285eb1c4e411bb0f020f5fea829

commit 77b5e02250d76285eb1c4e411bb0f020f5fea829
Author: Mikael Morin 
Date:   Fri Feb 14 17:23:47 2025 +0100

Correction régression class_to_type_2.f90

Diff:
---
 gcc/fortran/trans-array.cc | 8 +---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ef9c5c8dfc16..7345b8c98e80 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8246,9 +8246,11 @@ gfc_set_delta (gfc_loopinfo *loop)
   gfc_ss_type ss_type;
 
   ss_type = ss->info->type;
-  if (ss_type != GFC_SS_SECTION
- && ss_type != GFC_SS_COMPONENT
- && ss_type != GFC_SS_CONSTRUCTOR)
+  if (!(ss_type == GFC_SS_SECTION
+   || ss_type == GFC_SS_COMPONENT
+   || ss_type == GFC_SS_CONSTRUCTOR
+   || (ss_type == GFC_SS_FUNCTION
+   && gfc_is_class_array_function (ss->info->expr
continue;
 
   info = &ss->info->data.array;

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régressions inline_sum_*

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:2fa2259ae5c197ea6441966fc79ed190fbe6516f

commit 2fa2259ae5c197ea6441966fc79ed190fbe6516f
Author: Mikael Morin 
Date:   Fri Feb 14 18:55:55 2025 +0100

Correction régressions inline_sum_*

Diff:
---
 gcc/fortran/trans-array.cc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 76ed869d6f8b..b15e4ba5a8f9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8167,7 +8167,7 @@ late_set_loop_bounds (gfc_loopinfo *loop)
 }
 
   for (loop = loop->nested; loop; loop = loop->next)
-set_loop_bounds (loop);
+late_set_loop_bounds (loop);
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set descriptor with shape

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:cd8051de00286df2d1e2e5fdf884f56241c94b38

commit cd8051de00286df2d1e2e5fdf884f56241c94b38
Author: Mikael Morin 
Date:   Fri Jan 17 21:46:27 2025 +0100

Factorisation set descriptor with shape

Diff:
---
 gcc/fortran/trans-array.cc | 78 ++
 gcc/fortran/trans-array.h  |  2 ++
 gcc/fortran/trans-intrinsic.cc | 76 +++-
 3 files changed, 85 insertions(+), 71 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1822eef911a2..8054f49977ff 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1566,6 +1566,84 @@ copy_descriptor (stmtblock_t *block, tree dest, tree src,
   gfc_conv_descriptor_span_set (block, dest, tmp);
 }
 
+
+void
+gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc,
+  tree ptr, gfc_expr *shape,
+  locus *where)
+{
+  /* Set the span field.  */
+  tree tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+  tmp = fold_convert (gfc_array_index_type, tmp);
+  gfc_conv_descriptor_span_set (block, desc, tmp);
+
+  /* Set data value, dtype, and offset.  */
+  tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+  gfc_conv_descriptor_data_set (block, desc, fold_convert (tmp, ptr));
+  gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
+ gfc_get_dtype (TREE_TYPE (desc)));
+
+  /* Start scalarization of the bounds, using the shape argument.  */
+
+  gfc_ss *shape_ss = gfc_walk_expr (shape);
+  gcc_assert (shape_ss != gfc_ss_terminator);
+  gfc_se shapese;
+  gfc_init_se (&shapese, NULL);
+
+  gfc_loopinfo loop;
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, shape_ss);
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, where);
+  gfc_mark_ss_chain_used (shape_ss, 1);
+
+  gfc_copy_loopinfo_to_se (&shapese, &loop);
+  shapese.ss = shape_ss;
+
+  tree stride = gfc_create_var (gfc_array_index_type, "stride");
+  tree offset = gfc_create_var (gfc_array_index_type, "offset");
+  gfc_add_modify (block, stride, gfc_index_one_node);
+  gfc_add_modify (block, offset, gfc_index_zero_node);
+
+  /* Loop body.  */
+  stmtblock_t body;
+  gfc_start_scalarized_body (&loop, &body);
+
+  tree dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ loop.loopvar[0], loop.from[0]);
+
+  /* Set bounds and stride.  */
+  gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
+  gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
+
+  gfc_conv_expr (&shapese, shape);
+  gfc_add_block_to_block (&body, &shapese.pre);
+  gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
+  gfc_add_block_to_block (&body, &shapese.post);
+
+  /* Calculate offset.  */
+  gfc_add_modify (&body, offset,
+ fold_build2_loc (input_location, PLUS_EXPR,
+  gfc_array_index_type, offset, stride));
+  /* Update stride.  */
+  gfc_add_modify (&body, stride,
+ fold_build2_loc (input_location, MULT_EXPR,
+  gfc_array_index_type, stride,
+  fold_convert (gfc_array_index_type,
+shapese.expr)));
+  /* Finish scalarization loop.  */
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (block, &loop.pre);
+  gfc_add_block_to_block (block, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  gfc_add_modify (block, offset,
+ fold_build1_loc (input_location, NEGATE_EXPR,
+  gfc_array_index_type, offset));
+  gfc_conv_descriptor_offset_set (block, desc, offset);
+}
+
+
 /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info).  */
 
 void
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 3f39845c898f..05ea68d531ac 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -145,6 +145,8 @@ void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol 
*, tree);
 void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
 void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, tree);
 void gfc_set_scalar_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
+void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
+   gfc_expr *, locus *);
 
 /* Get a single array element.  */
 void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 2bdf663f6385..0ef69647a6ea 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -10513,11 +10513,8 @@ conv_isocbinding_subroutine (gfc_code *code)
   gfc_se se;
   gfc_se cptrse;
   gfc_se fptrse;
-  gfc_se shapese;
-  gfc_ss *shape_ss;
-  tree desc, dim, tmp, stride, offset;
-  stmtbl

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Sauvegarde modif

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:7a8cc81ed230a4fff48cc5c84534801da75e31fb

commit 7a8cc81ed230a4fff48cc5c84534801da75e31fb
Author: Mikael Morin 
Date:   Fri Feb 14 16:55:42 2025 +0100

Sauvegarde modif

Diff:
---
 gcc/fortran/trans-array.cc | 94 --
 gcc/fortran/trans-expr.cc  | 25 ++--
 2 files changed, 85 insertions(+), 34 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9b026bac56a0..d085e76a14e3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5591,18 +5591,48 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, 
bool subscript,
  break;
 
case GFC_SS_FUNCTION:
- /* Array function return value.  We call the function and save its
-result in a temporary for use inside the loop.  */
- gfc_init_se (&se, NULL);
- se.loop = loop;
- se.ss = ss;
- if (gfc_is_class_array_function (expr))
-   expr->must_finalize = 1;
- gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (&outer_loop->pre, &se.pre);
- gfc_add_block_to_block (&outer_loop->post, &se.post);
- gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
- ss_info->string_length = se.string_length;
+ {
+   /* Array function return value.  We call the function and save its
+  result in a temporary for use inside the loop.  */
+   gfc_init_se (&se, NULL);
+   se.loop = loop;
+   se.ss = ss;
+   bool class_func = gfc_is_class_array_function (expr);
+   if (class_func)
+ expr->must_finalize = 1;
+   gfc_conv_expr (&se, expr);
+   gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+   if (class_func
+   && se.expr
+   && GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+ {
+   tree tmp = gfc_class_data_get (se.expr);
+   info->descriptor = tmp;
+   info->data = gfc_conv_descriptor_data_get (tmp);
+   info->offset = gfc_conv_descriptor_offset_get (tmp);
+   for (gfc_ss *s = ss; s; s = s->parent)
+ for (int n = 0; n < s->dimen; n++)
+   {
+ int dim = s->dim[n];
+ tree tree_dim = gfc_rank_cst[dim];
+
+ tree start = gfc_conv_descriptor_lbound_get (tmp, 
tree_dim);
+ start = gfc_evaluate_now (start, &outer_loop->pre);
+ info->start[dim] = start;
+
+ tree end = gfc_conv_descriptor_ubound_get (tmp, tree_dim);
+ end = gfc_evaluate_now (end, &outer_loop->pre);
+ info->end[dim] = end;
+
+ tree stride = gfc_conv_descriptor_stride_get (tmp, 
tree_dim);
+ stride = gfc_evaluate_now (stride, &outer_loop->pre);
+ info->stride[dim] = stride;
+   }
+ }
+   gfc_add_block_to_block (&outer_loop->post, &se.post);
+   gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
+   ss_info->string_length = se.string_length;
+ }
  break;
 
case GFC_SS_CONSTRUCTOR:
@@ -8100,6 +8130,44 @@ set_loop_bounds (gfc_loopinfo *loop)
 }
 
 
+/* Last attempt to set the loop bounds, in case they depend on an allocatable
+   function result.  */
+
+static void
+late_set_loop_bounds (gfc_loopinfo *loop)
+{
+  int n, dim;
+  gfc_array_info *info;
+  gfc_ss **loopspec;
+
+  loopspec = loop->specloop;
+
+  for (n = 0; n < loop->dimen; n++)
+{
+  /* We should have found the scalarization loop specifier.  If not,
+that's bad news.  */
+  gcc_assert (loopspec[n]);
+
+  info = &loopspec[n]->info->data.array;
+  dim = loopspec[n]->dim[n];
+
+  /* Set the extents of this range.  */
+  if ((loop->from[n] == NULL_TREE
+  || loop->to[n] == NULL_TREE)
+ && loopspec[n]->info->type == GFC_SS_FUNCTION
+ && info->start[dim]
+ && info->end[dim])
+   {
+ loop->from[n] = info->start[dim];
+ loop->to[n] = info->end[dim];
+   }
+}
+
+  for (loop = loop->nested; loop; loop = loop->next)
+set_loop_bounds (loop);
+}
+
+
 /* Initialize the scalarization loop.  Creates the loop variables.  Determines
the range of the loop variables.  Creates a temporary if required.
Also generates code for scalar expressions which have been
@@ -8118,6 +8186,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
  allocating the temporary.  */
   gfc_add_loop_ss_code (loop, loop->ss, false, where);
 
+  late_set_loop_bounds (loop);
+
   tmp_ss = loop->temp_ss;
   /* If we want a temporary then create it.  */
   if (tmp_ss != NULL)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d13b7d9e61d4..1a42a78f66a1 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran

[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Mises à jour dumps

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:c3f09c54092157029661c05480f844c62dbaf1eb

commit c3f09c54092157029661c05480f844c62dbaf1eb
Author: Mikael Morin 
Date:   Tue Feb 11 18:07:23 2025 +0100

Mises à jour dumps

Mise à jour dump bind-c-contiguous-2.f90

Mise à jour dumps coarray_poly_*.f90

Mise à jour dump coarray_lock_7.f90

Correction dump coarray_allocate_7.f08

Mise à jour dump coarray_lib_alloc_4.f90

Mise à jour dump coarray_lib_alloc_2.f90

Mise à jour dump coarray_lib_alloc_3.f90

Mise à jour dump coarray_lib_alloc_1.f90

Mise à jour dump coarray_lib_token_4.f90

Mise à jour dump coarray_lib_token_3.f90

Mise à jour dump coarray_lib_token_2.f90

Mise à jour dump contiguous_3.f90

Diff:
---
 gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90 | 12 ++--
 gcc/testsuite/gfortran.dg/coarray_allocate_7.f08  |  2 +-
 gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 | 12 ++--
 gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 | 12 ++--
 gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 | 12 ++--
 gcc/testsuite/gfortran.dg/coarray_lib_alloc_4.f90 |  8 
 gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 |  4 ++--
 gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 |  4 ++--
 gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 |  6 +++---
 gcc/testsuite/gfortran.dg/coarray_lock_7.f90  | 12 ++--
 gcc/testsuite/gfortran.dg/coarray_poly_4.f90  |  2 +-
 gcc/testsuite/gfortran.dg/coarray_poly_5.f90  |  2 +-
 gcc/testsuite/gfortran.dg/coarray_poly_6.f90  |  2 +-
 gcc/testsuite/gfortran.dg/coarray_poly_7.f90  |  2 +-
 gcc/testsuite/gfortran.dg/coarray_poly_8.f90  |  2 +-
 gcc/testsuite/gfortran.dg/contiguous_3.f90|  4 ++--
 16 files changed, 49 insertions(+), 49 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90 
b/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
index 5b546800e7ff..243c4a57cba4 100644
--- a/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
+++ b/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
@@ -60,12 +60,12 @@ end
 
 ! Copy in + out
 
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\) 
xx->data \\+ xx->dtype.elem_len \\* arrayidx.\[0-9\]+, _xx->base_addr \\+ 
shift.\[0-9\]+, xx->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) xx->data 
\+ xx->dtype.elem_len \* arrayidx.[0-9]+, _xx->base_addr \+ shift.[0-9]+, 
(?:NON_LVALUE_EXPR <)?xx->dtype.elem_len>?\);} 1 "original" } }
 ! { dg-final { scan-tree-dump-times "xx->data = \\(void \\* restrict\\) 
_xx->base_addr;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\) 
xx->data \\+ xx->dtype.elem_len \\* arrayidx.\[0-9\]+, _xx->base_addr \\+ 
shift.\[0-9\]+, xx->dtype.elem_len\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\) 
yy->data \\+ yy->dtype.elem_len \\* arrayidx.\[0-9\]+, _yy->base_addr \\+ 
shift.\[0-9\]+, yy->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) xx->data 
\+ xx->dtype.elem_len \* arrayidx.[0-9]+, _xx->base_addr \+ shift.[0-9]+, 
(?:NON_LVALUE_EXPR <)?xx->dtype.elem_len>?\);} 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) yy->data 
\+ yy->dtype.elem_len \* arrayidx.[0-9]+, _yy->base_addr \+ shift.[0-9]+, 
(?:NON_LVALUE_EXPR <)?yy->dtype.elem_len>?\);} 1 "original" } }
 ! { dg-final { scan-tree-dump-times "yy->data = \\(void \\* restrict\\) 
_yy->base_addr;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(_yy->base_addr \\+ 
shift.\[0-9\]+, \\(void \\*\\) yy->data \\+ yy->dtype.elem_len \\* 
arrayidx.\[0-9\]+, yy->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(_yy->base_addr \+ 
shift.[0-9]+, \(void \*\) yy->data \+ yy->dtype.elem_len \* arrayidx.[0-9]+, 
(?:NON_LVALUE_EXPR <)?yy->dtype.elem_len>?\);} 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "zz = 
\\(character\\(kind=1\\)\\\[0:\\\]\\\[1:zz.\[0-9\]+\\\] \\* restrict\\) 
_zz->base_addr;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\) zz \\+ 
_zz->elem_len \\* arrayidx.\[0-9\]+, _zz->base_addr \\+ shift.\[0-9\]+, 
_zz->elem_len\\);" 1 "original" } }
@@ -73,10 +73,10 @@ end
 
 ! Copy in only
 
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\) 
aa->data \\+ aa->dtype.elem_len \\* arrayidx.\[0-9\]+, _aa->base_addr \\+ 
shift.\[0-9\]+, aa->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) aa->data 
\+ aa->dtype.elem_len \* arrayidx.[0-9]+, _aa->base_addr \+ shift.[0-9]+, 
(?:NON_LVALUE_EXPR <)?aa->dtype.elem_len>?\);} 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "aa->data = \\(void \\* restrict\\) 
_aa->base_addr;" 1 "original" } }

[gcc r15-7601] RISC-V: Fix failed tests for regression due to fix ICE patch

[Ma Jin via Gcc-cvs]

https://gcc.gnu.org/g:b22f191b7c594b33fb4b4a07769dbf0ca45bc9e9

commit r15-7601-gb22f191b7c594b33fb4b4a07769dbf0ca45bc9e9
Author: Jin Ma 
Date:   Mon Feb 17 10:43:22 2025 +0800

RISC-V: Fix failed tests for regression due to fix ICE patch

Ref:
https://github.com/ewlu/gcc-precommit-ci/issues/3096#issue-2854419069

gcc/testsuite/ChangeLog:

* gcc.target/riscv/rvv/base/bug-9.c: Added new failure check.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-17.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-18.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-19.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-20.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-21.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-22.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-23.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-24.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-25.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-26.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-27.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-28.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-29.c: 
Likewise.
* gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-3.c: 
Likewise.

Diff:
---
 gcc/testsuite/gcc.target/riscv/rvv/base/bug-9.c  | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-17.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-18.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-19.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-20.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-21.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-22.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-23.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-24.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-25.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-26.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-27.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-28.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-29.c | 1 +
 .../gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-3.c  | 1 +
 15 files changed, 15 insertions(+)

diff --git a/gcc/testsuite/gcc.target/riscv/rvv/base/bug-9.c 
b/gcc/testsuite/gcc.target/riscv/rvv/base/bug-9.c
index 20ae9ebf6f22..8cfe96588751 100644
--- a/gcc/testsuite/gcc.target/riscv/rvv/base/bug-9.c
+++ b/gcc/testsuite/gcc.target/riscv/rvv/base/bug-9.c
@@ -11,3 +11,4 @@ vfloat16m1_t f0 (vfloat16m1_t vs2, vfloat16m1_t vs1, size_t 
vl)
 }
 
 /* { dg-error "return type 'vfloat16m1_t' requires the zvfhmin or zvfh ISA 
extension" "" { target { "riscv*-*-*" } } 0 } */
+/* { dg-error "argument type 'vfloat16m1_t' requires the zvfhmin or zvfh ISA 
extension" "" { target { "riscv*-*-*" } } 0 } */
diff --git 
a/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-17.c
 
b/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-17.c
index a064417169d8..ebe31f5c961b 100644
--- 
a/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-17.c
+++ 
b/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-17.c
@@ -11,3 +11,4 @@ test_1 (vint64m1_t a, vint64m1_t b, size_t vl)
 }
 
 /* { dg-error "return type 'vint64m1_t' requires the zve64x, zve64f, zve64d or 
v ISA extension" "" { target { "riscv*-*-*" } } 0 } */
+/* { dg-error "argument type 'vint64m1_t' requires the zve64x, zve64f, zve64d 
or v ISA extension" "" { target { "riscv*-*-*" } } 0 } */
diff --git 
a/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-18.c
 
b/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-18.c
index 61d3fb25dc2d..7e9a101795dc 100644
--- 
a/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-18.c
+++ 
b/gcc/testsuite/gcc.target/riscv/rvv/base/target_attribute_v_with_intrinsic-18.c
@@ -11,3 +11,4 @@ test_1 (vfloat32m1_t a, vfloat32m1_t b, size_t vl)
 }
 
 /* { dg-error "return type 'vfloat32m1_t' requires the zve32f, zve64f, zve64d 
or v ISA extension" "" { target { "riscv*-*-*" } } 0 } */
+/* { dg-error "argument type 'vfloat32m1_t' requires the zve32f, zve64f, 
zve64d or v ISA extension

[gcc(refs/users/omachota/heads/rtl-ssa-dce)] rtl-ssa: dce add prelive conditions

[Ondrej Machota via Gcc-cvs]

https://gcc.gnu.org/g:175c246015a7c0f4d23c79b883467edfd4680855

commit 175c246015a7c0f4d23c79b883467edfd4680855
Author: Ondřej Machota 
Date:   Tue Feb 18 07:04:16 2025 +0100

rtl-ssa: dce add prelive conditions

Diff:
---
 gcc/dce.cc | 160 ++---
 1 file changed, 112 insertions(+), 48 deletions(-)

diff --git a/gcc/dce.cc b/gcc/dce.cc
index 929cb259e6d6..c3fdb32688bf 100644
--- a/gcc/dce.cc
+++ b/gcc/dce.cc
@@ -17,6 +17,7 @@ You should have received a copy of the GNU General Public 
License
 along with GCC; see the file COPYING3.  If not see
 .  */
 
+#include 
 #define INCLUDE_ALGORITHM
 #define INCLUDE_FUNCTIONAL
 #include "config.h"
@@ -39,6 +40,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree-pass.h"
 #include "dbgcnt.h"
 #include "rtl-iter.h"
+#include 
 
 using namespace rtl_ssa;
 
@@ -1237,30 +1239,81 @@ namespace
 
 } // namespace
 
-bool is_inherently_live(insn_info *insn)
+bool sets_global_register(rtx_insn* insn) {
+  rtx set = single_set(insn);
+  if (!set)
+return false;
+
+  rtx dest = SET_DEST(set);
+  if (REG_P(dest) && HARD_REGISTER_NUM_P(REGNO(dest)) && 
global_regs[REGNO(dest)]) {
+return true;
+  }
+
+  return false;
+}
+
+bool is_prelive(insn_info *insn)
 {
-  return insn->num_uses() > 0;
+  if (insn->is_artificial()) // phis are never prelive
+return false;
+
+  /*
+   * There are a few functions we can use to detect if an instruction is
+   * inherently live:
+   * rtlanal.cc:
+   *  bool side_effects_p (const_rtx x);
+   *  bool volatile_insn_p (const_rtx x);
+   *
+   * rtlanal.h
+   *  bool has_side_effects (); inside class rtx_properties
+   *
+   * dce.cc:
+   *  static bool deletable_insn_p_1(rtx body); uses bool volatile_insn_p 
(const_rtx x);
+   *  static bool deletable_insn_p(rtx_insn *insn, bool fast, bitmap 
arg_stores);
+   * 
+   * Possibly the most accurate way would be to rewrite `static bool
+   * deletable_insn_p(rtx_insn *insn, bool fast, bitmap arg_stores);`
+   * 
+  */
+
+  // Now, we only have to handle rtx insns
+  assert(insn->is_real());
+  auto rtl = insn->rtl();
+
+  if (!INSN_P(rtl)) // This might be useless
+return false;
+
+  rtx pat = PATTERN(rtl); // if we use this instead of rtl, then rtl notes 
wont be checked
+  
+  // TODO : join if statements
+
+  if (JUMP_P(rtl))
+return true;
+
+  // We need to describe all possible prelive instructions, a list of all the 
instructions is inside `rtl.def`
+
+  // Mark set of a global register
+  if (sets_global_register(rtl))
+return true;
+
+  // Call is inside side_effects_p
+  if (side_effects_p(rtl) || volatile_refs_p(rtl) || can_throw_internal(rtl))
+return true;
+
+  return false;
 }
 
 static void
-rtl_ssa_dce_init(sbitmap &marked_rtx)
+rtl_ssa_dce_init()
 {
   calculate_dominance_info(CDI_DOMINATORS);
+  // here we create ssa form for function
   crtl->ssa = new rtl_ssa::function_info(cfun);
-
-  marked_rtx = sbitmap_alloc(get_max_uid() + 1);
-  bitmap_clear(marked_rtx);
-  if (dump_file)
-fprintf(dump_file, "Allocated `marked_rtx` with size: %d\n", get_max_uid() 
+ 1);
 }
 
 static void
-rtl_ssa_dce_done(sbitmap marked_rtx)
+rtl_ssa_dce_done()
 {
-  sbitmap_free(marked_rtx);
-  if (dump_file)
-fprintf(dump_file, "Freed `marked_rtx`\n");
-
   free_dominance_info(CDI_DOMINATORS);
   if (crtl->ssa->perform_pending_updates())
 cleanup_cfg(0);
@@ -1273,24 +1326,20 @@ rtl_ssa_dce_done(sbitmap marked_rtx)
 }
 
 static void
-rtl_ssa_dce_mark_live(insn_info *info, vec &worklist, sbitmap 
marked_rtx)
+rtl_ssa_dce_mark_live(insn_info *info, vec &worklist, 
std::unordered_set marked)
 {
   int info_uid = info->uid();
   if (dump_file)
   {
 fprintf(dump_file, "  Adding insn %d to worklist\n", info_uid);
   }
-  if (info_uid < 0)
-  {
-  return;
-  }
-  bitmap_set_bit(marked_rtx, info_uid);
 
+  marked.emplace(info);
   worklist.safe_push(info);
 }
 
-static void
-rtl_ssa_dce_mark(sbitmap marked_rtx)
+static auto_vec
+rtl_ssa_dce_prelive(std::unordered_set marked)
 {
   insn_info *next;
   auto_vec worklist;
@@ -1316,9 +1365,9 @@ rtl_ssa_dce_mark(sbitmap marked_rtx)
 * Is seems, that insn->uid() is uniq enough
 */
 
-if (is_inherently_live(insn))
+if (is_prelive(insn))
 {
-  rtl_ssa_dce_mark_live(insn, worklist, marked_rtx);
+  rtl_ssa_dce_mark_live(insn, worklist, marked);
 }
 
 // if (insn->can_be_optimized () || insn->is_debug_insn ())
@@ -1326,12 +1375,18 @@ rtl_ssa_dce_mark(sbitmap marked_rtx)
 //  worklist.safe_push (insn);
   }
 
+  return worklist;
+}
+
+static void
+rtl_ssa_dce_mark(std::unordered_set marked)
+{
+  auto worklist = rtl_ssa_dce_prelive(marked);
+
   if (dump_file)
 fprintf(dump_file, "Finished inherently live, marking parents\n");
   while (!worklist.is_empty())
   {
-if (dump_file)
-  fprintf(dump_file, "Brruuh; ");
 insn_info *insn = worklist.pop();
 def_array defs = insn-

[gcc r15-7600] RISC-V: Fix ICE for target attributes has different xlen size

[Pan Li via Gcc-cvs]

https://gcc.gnu.org/g:17b95cfc310c0b3ef191cd47ceb3b4ee1205e8bf

commit r15-7600-g17b95cfc310c0b3ef191cd47ceb3b4ee1205e8bf
Author: Pan Li 
Date:   Sat Feb 15 14:33:35 2025 +0800

RISC-V: Fix ICE for target attributes has different xlen size

This patch would like to avoid the ICE when the target attribute
specific the xlen different to the cmd.  Aka compile with rv64gc
but target attribute with rv32gcv_zbb.  For example as blow:

   1   │ long foo (long a, long b)
   2   │ __attribute__((target("arch=rv32gcv_zbb")));
   3   │
   4   │ long foo (long a, long b)
   5   │ {
   6   │   return a + (b * 2);
   7   │ }

when compile with rv64gc -O3, it will have ICE similar as below

during RTL pass: fwprop1
test.c: In function ‘foo’:
test.c:10:1: internal compiler error: in add_use, at
rtl-ssa/accesses.cc:1234
   10 | }
  | ^
0x44d6b9d internal_error(char const*, ...)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/diagnostic-global-context.cc:517
0x44a26a6 fancy_abort(char const*, int, char const*)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/diagnostic.cc:1722
0x408fac9 rtl_ssa::function_info::add_use(rtl_ssa::use_info*)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/accesses.cc:1234
0x40a5eea
rtl_ssa::function_info::create_reg_use(rtl_ssa::function_info::build_info&,
rtl_ssa::insn_info*, rtl_ssa::resource_info)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/insns.cc:496
0x4456738

rtl_ssa::function_info::add_artificial_accesses(rtl_ssa::function_info::build_info&,
df_ref_flags)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/blocks.cc:900
0x4457297
rtl_ssa::function_info::start_block(rtl_ssa::function_info::build_info&,
rtl_ssa::bb_info*)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/blocks.cc:1082
0x4453627
rtl_ssa::function_info::bb_walker::before_dom_children(basic_block_def*)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/blocks.cc:118
0x3e9f3fb dom_walker::walk(basic_block_def*)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/domwalk.cc:311
0x445806f rtl_ssa::function_info::process_all_blocks()

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/blocks.cc:1298
0x40a22d3 rtl_ssa::function_info::function_info(function*)

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/rtl-ssa/functions.cc:51
0x3ec3f80 fwprop_init

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/fwprop.cc:893
0x3ec420d fwprop

/home/pli/gcc/111/riscv-gnu-toolchain/gcc/__RISC-V_BUILD__/../gcc/fwprop.cc:963
0x3ec43ad execute

Consider stage 4, we just report error for the above scenario when
detect the cmd xlen is different to the target attribute during the
target hook TARGET_OPTION_VALID_ATTRIBUTE_P implementation.

PR target/118540

gcc/ChangeLog:

* config/riscv/riscv-target-attr.cc 
(riscv_target_attr_parser::parse_arch):
Report error when cmd xlen is different with target attribute.

gcc/testsuite/ChangeLog:

* gcc.target/riscv/rvv/base/pr118540-1.c: New test.
* gcc.target/riscv/rvv/base/pr118540-2.c: New test.

Signed-off-by: Pan Li 

Diff:
---
 gcc/config/riscv/riscv-target-attr.cc| 14 ++
 gcc/testsuite/gcc.target/riscv/rvv/base/pr118540-1.c | 12 
 gcc/testsuite/gcc.target/riscv/rvv/base/pr118540-2.c | 12 
 3 files changed, 38 insertions(+)

diff --git a/gcc/config/riscv/riscv-target-attr.cc 
b/gcc/config/riscv/riscv-target-attr.cc
index 615f1b9c6ce1..1d968655f95d 100644
--- a/gcc/config/riscv/riscv-target-attr.cc
+++ b/gcc/config/riscv/riscv-target-attr.cc
@@ -100,6 +100,20 @@ riscv_target_attr_parser::parse_arch (const char *str)
   /* Check if it's setting full arch string.  */
   if (strncmp ("rv", str, strlen ("rv")) == 0)
 {
+  if (TARGET_64BIT && strncmp ("32", str + 2, strlen ("32")) == 0)
+   {
+ error_at (m_loc, "unexpected arch for % attribute: "
+   "must start with rv64 but found %qs", str);
+ goto fail;
+   }
+
+  if (!TARGET_64BIT && strncmp ("64", str + 2, strlen ("64")) == 0)
+   {
+ error_at (m_loc, "unexpected arch for % attribute: "
+   "must start with rv32 but found %qs", str);
+ goto fail;
+   }
+
   m_subset_list = riscv_subset_list::parse (str, m_loc);
 
   if (m_subset_list == nullptr)
diff --git a/gcc/testsuite/gcc.target/riscv/rvv/base/pr118540-1.c 
b/gcc/testsuite/gcc.target/riscv/rvv

[gcc r15-7602] tree-optimization/98845 - ICE with tail-merging and DCE/DSE disabled

[Richard Biener via Gcc-cvs]

https://gcc.gnu.org/g:6b8a8c9fd68c5dabaec5ddbc25efeade44f37a14

commit r15-7602-g6b8a8c9fd68c5dabaec5ddbc25efeade44f37a14
Author: Richard Biener 
Date:   Mon Feb 17 15:53:11 2025 +0100

tree-optimization/98845 - ICE with tail-merging and DCE/DSE disabled

The following shows that tail-merging will make dead SSA defs live
in paths where it wasn't before, possibly introducing UB or as
in this case, uses of abnormals that eventually fail coalescing
later.  The fix is to register such defs for stmt comparison.

PR tree-optimization/98845
* tree-ssa-tail-merge.cc (stmt_local_def): Consider a
def with no uses not local.

* gcc.dg/pr98845.c: New testcase.
* gcc.dg/pr81192.c: Adjust.

Diff:
---
 gcc/testsuite/gcc.dg/pr81192.c |  6 +-
 gcc/testsuite/gcc.dg/pr98845.c | 33 +
 gcc/tree-ssa-tail-merge.cc |  8 
 3 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/gcc/testsuite/gcc.dg/pr81192.c b/gcc/testsuite/gcc.dg/pr81192.c
index c46ac18fd9af..87a7a7a19c80 100644
--- a/gcc/testsuite/gcc.dg/pr81192.c
+++ b/gcc/testsuite/gcc.dg/pr81192.c
@@ -25,12 +25,16 @@ void __GIMPLE(ssa, startwith("pre")) fn2   ()
   if (j_6(D) != _Literal (int)2147483647)
 goto __BB4;
   else
-goto __BB5;
+goto __BB9;
 
   __BB(4):
   iftmp2_8 = j_6(D) + _Literal (int)1;
   goto __BB5;
 
+  __BB(9):
+  iftmp2_8 = j_6(D) + _Literal (int)1;
+  goto __BB5;
+
   __BB(5):
   b_lsm6_10 = _Literal (int)2147483647;
   goto __BB6;
diff --git a/gcc/testsuite/gcc.dg/pr98845.c b/gcc/testsuite/gcc.dg/pr98845.c
new file mode 100644
index ..074c979678f9
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr98845.c
@@ -0,0 +1,33 @@
+/* { dg-do compile } */
+/* { dg-options "-O2 -fno-tree-dce -fno-tree-dse" } */
+
+int n;
+
+__attribute__ ((returns_twice)) void
+foo (void);
+
+void
+bar (void);
+
+void
+quux (int x)
+{
+  if (x)
+++x;
+  else
+{
+  if (n)
+{
+  x = 1;
+  foo ();
+}
+  else
+bar ();
+
+  if (n)
+{
+  ++x;
+  ++n;
+}
+}
+}
diff --git a/gcc/tree-ssa-tail-merge.cc b/gcc/tree-ssa-tail-merge.cc
index d897970079ce..857e91c206b3 100644
--- a/gcc/tree-ssa-tail-merge.cc
+++ b/gcc/tree-ssa-tail-merge.cc
@@ -336,10 +336,13 @@ stmt_local_def (gimple *stmt)
 
   def_bb = gimple_bb (stmt);
 
+  bool any_use = false;
   FOR_EACH_IMM_USE_FAST (use_p, iter, val)
 {
   if (is_gimple_debug (USE_STMT (use_p)))
continue;
+
+  any_use = true;
   bb = gimple_bb (USE_STMT (use_p));
   if (bb == def_bb)
continue;
@@ -351,6 +354,11 @@ stmt_local_def (gimple *stmt)
   return false;
 }
 
+  /* When there is no use avoid making the stmt live on other paths.
+ This can happen with DCE disabled or not done as seen in PR98845.  */
+  if (!any_use)
+return false;
+
   return true;
 }

[gcc r15-7599] i386: Re-order i386.opt.urls

[Haochen Jiang via Gcc-cvs]

https://gcc.gnu.org/g:101e3101e0f311ed7cbd775f5db50ac04af71086

commit r15-7599-g101e3101e0f311ed7cbd775f5db50ac04af71086
Author: Haochen Jiang 
Date:   Tue Feb 18 10:59:11 2025 +0800

i386: Re-order i386.opt.urls

The order of i386.opt.urls need to be the same as i386.opt.

gcc/ChangeLog:

* config/i386/i386.opt.urls: Adjust the order for avx10.2
and avx10.2-512 due to their order change in i386.opt.

Diff:
---
 gcc/config/i386/i386.opt.urls | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/config/i386/i386.opt.urls b/gcc/config/i386/i386.opt.urls
index 5cb304d2a738..ee6806169df6 100644
--- a/gcc/config/i386/i386.opt.urls
+++ b/gcc/config/i386/i386.opt.urls
@@ -605,12 +605,12 @@ UrlSuffix(gcc/x86-Options.html#index-mavx10_002e1-512)
 mavx10.2-256
 UrlSuffix(gcc/x86-Options.html#index-mavx10_002e2-256)
 
-mavx10.2-512
-UrlSuffix(gcc/x86-Options.html#index-mavx10_002e2-512)
-
 mavx10.2
 UrlSuffix(gcc/x86-Options.html#index-mavx10_002e2)
 
+mavx10.2-512
+UrlSuffix(gcc/x86-Options.html#index-mavx10_002e2-512)
+
 mamx-avx512
 UrlSuffix(gcc/x86-Options.html#index-mamx-avx512)

[gcc r15-7597] [ifcombine] cope with signbit tests of extended values

[Alexandre Oliva via Gcc-cvs]

https://gcc.gnu.org/g:3768bedf7b5fcdd63a18871ecfce665ae1b8d87e

commit r15-7597-g3768bedf7b5fcdd63a18871ecfce665ae1b8d87e
Author: Alexandre Oliva 
Date:   Mon Feb 17 23:17:21 2025 -0300

[ifcombine] cope with signbit tests of extended values

A compare with zero may be taken as a sign bit test by
fold_truth_andor_for_ifcombine, but the operand may be extended from a
narrower field.  If the operand was narrower, the bitsize will reflect
the narrowing conversion, but if it was wider, we'll only know whether
the field is sign- or zero-extended from unsignedp, but we won't know
whether it needed to be extended, because arg will have changed to the
narrower variable when we get to the point in which we can compute the
arg width.  If it's sign-extended, we're testing the right bit, but if
it's zero-extended, there isn't any bit we can test.

Instead of punting and leaving the foldable compare to be figured out
by another pass, arrange for the sign bit resulting from the widening
zero-extension to be taken as zero, so that the modified compare will
yield the desired result.

While at that, avoid swapping the right-hand compare operands when
we've already determined that it was a signbit test: it no use to even
try.


for  gcc/ChangeLog

PR tree-optimization/118805
* gimple-fold.cc (fold_truth_andor_for_combine): Detect and
cope with zero-extension in signbit tests.  Reject swapping
right-compare operands if rsignbit.

for  gcc/testsuite/ChangeLog

PR tree-optimization/118805
* gcc.dg/field-merge-26.c: New.

Diff:
---
 gcc/gimple-fold.cc| 22 +-
 gcc/testsuite/gcc.dg/field-merge-26.c | 20 
 2 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc
index 29191685a43c..0380c7af4c21 100644
--- a/gcc/gimple-fold.cc
+++ b/gcc/gimple-fold.cc
@@ -8090,14 +8090,16 @@ fold_truth_andor_for_ifcombine (enum tree_code code, 
tree truth_type,
 
   /* Prepare to turn compares of signed quantities with zero into sign-bit
  tests.  We need not worry about *_reversep here for these compare
- rewrites: loads will have already been reversed before compares.  */
-  bool lsignbit = false, rsignbit = false;
+ rewrites: loads will have already been reversed before compares.  Save the
+ precision, because [lr]l_arg may change and we won't be able to tell how
+ wide it was originally.  */
+  unsigned lsignbit = 0, rsignbit = 0;
   if ((lcode == LT_EXPR || lcode == GE_EXPR)
   && integer_zerop (lr_arg)
   && INTEGRAL_TYPE_P (TREE_TYPE (ll_arg))
   && !TYPE_UNSIGNED (TREE_TYPE (ll_arg)))
 {
-  lsignbit = true;
+  lsignbit = TYPE_PRECISION (TREE_TYPE (ll_arg));
   lcode = (lcode == LT_EXPR ? NE_EXPR : EQ_EXPR);
 }
   /* Turn compares of unsigned quantities with powers of two into
@@ -8130,7 +8132,7 @@ fold_truth_andor_for_ifcombine (enum tree_code code, tree 
truth_type,
   && INTEGRAL_TYPE_P (TREE_TYPE (rl_arg))
   && !TYPE_UNSIGNED (TREE_TYPE (rl_arg)))
 {
-  rsignbit = true;
+  rsignbit = TYPE_PRECISION (TREE_TYPE (rl_arg));
   rcode = (rcode == LT_EXPR ? NE_EXPR : EQ_EXPR);
 }
   else if ((rcode == LT_EXPR || rcode == GE_EXPR)
@@ -8204,7 +8206,7 @@ fold_truth_andor_for_ifcombine (enum tree_code code, tree 
truth_type,
   || ! operand_equal_p (ll_inner, rl_inner, 0))
 {
   /* Try swapping the operands.  */
-  if (ll_reversep != rr_reversep
+  if (ll_reversep != rr_reversep || rsignbit
  || !operand_equal_p (ll_inner, rr_inner, 0))
return 0;
 
@@ -8284,6 +8286,14 @@ fold_truth_andor_for_ifcombine (enum tree_code code, 
tree truth_type,
   if (lsignbit)
 {
   wide_int sign = wi::mask (ll_bitsize - 1, true, ll_bitsize);
+  /* If ll_arg is zero-extended and we're testing the sign bit, we know
+what the result should be.  Shifting the sign bit out of sign will get
+us to mask the entire field out, yielding zero, i.e., the sign bit of
+the zero-extended value.  We know the masked value is being compared
+with zero, so the compare will get us the result we're looking
+for: TRUE if EQ_EXPR, FALSE if NE_EXPR.  */
+  if (lsignbit > ll_bitsize && ll_unsignedp)
+   sign <<= 1;
   if (!ll_and_mask.get_precision ())
ll_and_mask = sign;
   else
@@ -8303,6 +8313,8 @@ fold_truth_andor_for_ifcombine (enum tree_code code, tree 
truth_type,
   if (rsignbit)
 {
   wide_int sign = wi::mask (rl_bitsize - 1, true, rl_bitsize);
+  if (rsignbit > rl_bitsize && ll_unsignedp)
+   sign <<= 1;
   if (!rl_and_mask.get_precision ())
rl_and_mask = sign;
   else
diff --git a/gcc/testsuite/gcc.dg/field-merge-26.c 
b/gcc/testsuite/gcc.dg/field-merge-26.c
new file mode 100644

[gcc r15-7598] [testsuite] fix check-function-bodies usage

[Alexandre Oliva via Gcc-cvs]

https://gcc.gnu.org/g:f039584e9e6c4709998c9cfdcb76e7519ffa96d0

commit r15-7598-gf039584e9e6c4709998c9cfdcb76e7519ffa96d0
Author: Alexandre Oliva 
Date:   Mon Feb 17 23:17:25 2025 -0300

[testsuite] fix check-function-bodies usage

The existing usage comment for check-function-bodies is presumably a
typo, as it doesn't match existing uses.  Fix it.


for  gcc/testsuite/ChangeLog

* lib/scanasm.exp (check-function-bodies): Fix usage comment.

Diff:
---
 gcc/testsuite/lib/scanasm.exp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/testsuite/lib/scanasm.exp b/gcc/testsuite/lib/scanasm.exp
index beffedd5bce4..97935cb23c3c 100644
--- a/gcc/testsuite/lib/scanasm.exp
+++ b/gcc/testsuite/lib/scanasm.exp
@@ -985,7 +985,7 @@ proc check_function_body { functions name body_regexp } {
 
 # Check the implementations of functions against expected output.  Used as:
 #
-# { dg-do { check-function-bodies PREFIX TERMINATOR[ OPTION[ SELECTOR 
[MATCHED]]] } }
+# { dg-final { check-function-bodies PREFIX TERMINATOR[ OPTION[ SELECTOR 
[MATCHED]]] } }
 #
 # See sourcebuild.texi for details.

[gcc r15-7594] i386: Simplify PARALLEL RTX scan in ix86_find_all_reg_use

[Uros Bizjak via Gcc-cvs]

https://gcc.gnu.org/g:565d4e755498ad2b5ed55e368ef61eb9511cda3a

commit r15-7594-g565d4e755498ad2b5ed55e368ef61eb9511cda3a
Author: Uros Bizjak 
Date:   Mon Feb 17 20:47:14 2025 +0100

i386: Simplify PARALLEL RTX scan in ix86_find_all_reg_use

UNSPEC and UNSPEC_VOLATILE never store. Remove unnecessary checks and
simplify RTX scan in ix86_find_all_reg_use to scan only for SET RTX
in the PARALLEL.

gcc/ChangeLog:

* config/i386/i386.cc (ix86_find_all_reg_use):
Scan only for SET RTX in PARALLEL.

Diff:
---
 gcc/config/i386/i386.cc | 28 +++-
 1 file changed, 3 insertions(+), 25 deletions(-)

diff --git a/gcc/config/i386/i386.cc b/gcc/config/i386/i386.cc
index fafd4a511a3c..560e6525b56b 100644
--- a/gcc/config/i386/i386.cc
+++ b/gcc/config/i386/i386.cc
@@ -8538,31 +8538,9 @@ ix86_find_all_reg_use (HARD_REG_SET &stack_slot_access,
   for (int i = 0; i < XVECLEN (pat, 0); i++)
{
  rtx exp = XVECEXP (pat, 0, i);
- switch (GET_CODE (exp))
-   {
-   case ASM_OPERANDS:
-   case CLOBBER:
-   case PREFETCH:
-   case USE:
- break;
-   case UNSPEC:
-   case UNSPEC_VOLATILE:
- for (int j = XVECLEN (exp, 0) - 1; j >= 0; j--)
-   {
- rtx x = XVECEXP (exp, 0, j);
- if (GET_CODE (x) == SET)
-   ix86_find_all_reg_use_1 (x, stack_slot_access,
-worklist);
-   }
- break;
-   case SET:
- ix86_find_all_reg_use_1 (exp, stack_slot_access,
-  worklist);
- break;
-   default:
- gcc_unreachable ();
- break;
-   }
+
+ if (GET_CODE (exp) == SET)
+   ix86_find_all_reg_use_1 (exp, stack_slot_access, worklist);
}
 }
 }

[gcc r15-7595] OpenMP/Fortran: extend 'adjust_args' clause, fixes for it and declare variant [PR115271]

[Tobias Burnus via Gcc-cvs]

https://gcc.gnu.org/g:8268c8256dd430174e89142be9ee77b036d6310d

commit r15-7595-g8268c8256dd430174e89142be9ee77b036d6310d
Author: Tobias Burnus 
Date:   Mon Feb 17 22:52:34 2025 +0100

OpenMP/Fortran: extend 'adjust_args' clause, fixes for it and declare 
variant [PR115271]

On the extension side, it implements OpenMP 6.0's numeric values/ranges for
the adjust_args arguments, including 'omp_num_args'. And it adds parser
support for need_device_addr. It also implements the post-OpenMP-6.0
clarification of OpenMP spec Issue #4443 regarding type(c_ptr) with
dimension being invalid for need_device_ptr.

To be done: Adding full support for need_device_addr (optional, array
descriptor, ...).

On the invalid side, it removed a bogus c_ptr check that went through
all adjust_args without checking for need_device_ptr and the current scope.

And it finally also processes 'declare variant' in an INTERFACE block,
which is part of PR115271, but it does not handle .mod file yet - the
main issue tracked in that PR.

PR fortran/115271

gcc/fortran/ChangeLog:

* gfortran.h (gfc_omp_namelist): Change need_device_ptr to adj_args
union and add more flags.
* openmp.cc (gfc_match_omp_declare_variant,
gfc_resolve_omp_declare): For adjust_args, handle need_device_addr
and numeric values/ranges besides dummy argument names.
(resolve_omp_dispatch): Remove bogus a adjust_args check.
* trans-decl.cc (gfc_handle_omp_declare_variant): New.
(gfc_generate_module_vars, gfc_generate_function_code): Call it.
* trans-openmp.cc (gfc_trans_omp_declare_variant): Handle numeric
values/ranges besides dummy argument names.

gcc/testsuite/ChangeLog:

* gfortran.dg/gomp/adjust-args-1.f90: Update dg-.* expectations.
* gfortran.dg/gomp/adjust-args-2.f90: Likewise.
* gfortran.dg/gomp/adjust-args-2a.f90: Likewise.
* gfortran.dg/gomp/adjust-args-3.f90: Likewise.
* gfortran.dg/gomp/adjust-args-4.f90: Remove array from c_ptr.
* gfortran.dg/gomp/adjust-args-5.f90: Likewise.
* gfortran.dg/gomp/adjust-args-11.f90: Likewise. Add check that
INTERFACE is now handled in subroutines and in modules.
* gfortran.dg/gomp/adjust-args-13.f90: New test.
* gfortran.dg/gomp/adjust-args-14.f90: New test.
* gfortran.dg/gomp/adjust-args-15.f90: New test.
* gfortran.dg/gomp/declare-variant-21.f90: New test.

Diff:
---
 gcc/fortran/gfortran.h |  10 +-
 gcc/fortran/openmp.cc  | 247 +
 gcc/fortran/trans-decl.cc  |  23 ++
 gcc/fortran/trans-openmp.cc| 214 ++
 gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90   |   8 +-
 gcc/testsuite/gfortran.dg/gomp/adjust-args-11.f90  |  77 ++-
 gcc/testsuite/gfortran.dg/gomp/adjust-args-13.f90  |  18 ++
 gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90  |  85 +++
 gcc/testsuite/gfortran.dg/gomp/adjust-args-15.f90  |  35 +++
 gcc/testsuite/gfortran.dg/gomp/adjust-args-2.f90   |   3 +-
 gcc/testsuite/gfortran.dg/gomp/adjust-args-2a.f90  |   8 +-
 gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90   |   4 +-
 gcc/testsuite/gfortran.dg/gomp/adjust-args-4.f90   |   8 +-
 gcc/testsuite/gfortran.dg/gomp/adjust-args-5.f90   |   8 +-
 .../gfortran.dg/gomp/declare-variant-21.f90|  20 ++
 15 files changed, 662 insertions(+), 106 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fe127646152..557c5c76f411 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1412,7 +1412,15 @@ typedef struct gfc_omp_namelist
  bool target;
  bool targetsync;
} init;
-  bool need_device_ptr;
+  struct
+   {
+ bool need_ptr:1;
+ bool need_addr:1;
+ bool range_start:1;
+ bool omp_num_args_plus:1;
+ bool omp_num_args_minus:1;
+ bool error_p:1;
+   } adj_args;
 } u;
   union
 {
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index e8df9d63fec2..c30ab997f765 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6718,21 +6718,21 @@ gfc_match_omp_declare_variant (void)
 
   enum clause
   {
-   match,
-   adjust_args,
-   append_args
+   clause_match,
+   clause_adjust_args,
+   clause_append_args
   } ccode;
 
   if (gfc_match ("match") == MATCH_YES)
-   ccode = match;
+   ccode = clause_match;
   else if (gfc_match ("adjust_args") == MATCH_YES)
{
- ccode = adjust_args;
+ ccode = clause_adjust_args;
  adjust_args_loc = gfc_current_locus;
}
   else if (gfc_match ("append_args") == MATCH_YES)
{
-  

[gcc r15-7593] middle-end: Fixup constant integers when expanding __builtin_crc [PR118288]

[Uros Bizjak via Gcc-cvs]

https://gcc.gnu.org/g:09684c53bca7dad47d36875b359e83551f9015fd

commit r15-7593-g09684c53bca7dad47d36875b359e83551f9015fd
Author: Uros Bizjak 
Date:   Sun Feb 16 22:01:27 2025 +0100

middle-end: Fixup constant integers when expanding __builtin_crc [PR118288]

Constant integers with MSB set have to be represented as corresponding
signed integers.  Use gen_int_mode to emit them in the correct way.

PR middle-end/118288

gcc/ChangeLog:

* builtins.cc (expand_builtin_crc_table_based):
Use gen_int_mode to emit constant integers with MSB set.

gcc/testsuite/ChangeLog:

* gcc.dg/pr118288.c: New test.

Diff:
---
 gcc/builtins.cc | 3 +++
 gcc/testsuite/gcc.dg/pr118288.c | 8 
 2 files changed, 11 insertions(+)

diff --git a/gcc/builtins.cc b/gcc/builtins.cc
index 468bd65bc42a..c8841032f039 100644
--- a/gcc/builtins.cc
+++ b/gcc/builtins.cc
@@ -7803,6 +7803,9 @@ expand_builtin_crc_table_based (internal_fn fn, 
scalar_mode crc_mode,
   gcc_assert (TREE_CODE (rhs3) == INTEGER_CST);
   rtx op3 = gen_int_mode (TREE_INT_CST_LOW (rhs3), crc_mode);
 
+  if (CONST_INT_P (op2))
+op2 = gen_int_mode (INTVAL (op2), crc_mode);
+
   if (fn == IFN_CRC)
 expand_crc_table_based (target, op1, op2, op3, data_mode);
   else
diff --git a/gcc/testsuite/gcc.dg/pr118288.c b/gcc/testsuite/gcc.dg/pr118288.c
new file mode 100644
index ..8cc981d065d7
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr118288.c
@@ -0,0 +1,8 @@
+/* PR middle-end 118288 */
+/* { dg-do compile }  */
+/* { dg-options "-O2" } */
+
+signed char crc8_data8 ()
+{
+  return __builtin_crc8_data8 ('a', 0xff, 0x12);
+}

[gcc r13-9379] libgcc: On FreeBSD use GCC's crt objects for static linking

[Gerald Pfeifer via Gcc-cvs]

https://gcc.gnu.org/g:4f3a1ef6a8f32e4583d4c67fc452db9aa7fccb68

commit r13-9379-g4f3a1ef6a8f32e4583d4c67fc452db9aa7fccb68
Author: Dimitry Andric 
Date:   Tue Jan 28 18:36:16 2025 +0100

libgcc: On FreeBSD use GCC's crt objects for static linking

Add crtbeginT.o to extra_parts on FreeBSD. This ensures we use GCC's
crt objects for static linking. Otherwise it could mix crtbeginT.o
from the base system with libgcc's crtend.o, possibly leading to
segfaults.

libgcc:
PR target/118685
* config.host (*-*-freebsd*): Add crtbeginT.o to extra_parts.

Signed-off-by: Dimitry Andric 

Diff:
---
 libgcc/config.host | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/libgcc/config.host b/libgcc/config.host
index c94d69d84b7c..8621de4f6387 100644
--- a/libgcc/config.host
+++ b/libgcc/config.host
@@ -263,7 +263,7 @@ case ${host} in
   # machine-specific sections may refine and add to this
   # configuration.
   tmake_file="$tmake_file t-freebsd t-crtstuff-pic t-libgcc-pic t-eh-dw2-dip 
t-slibgcc t-slibgcc-gld t-slibgcc-elf-ver"
-  extra_parts="crtbegin.o crtend.o crtbeginS.o crtendS.o"
+  extra_parts="crtbegin.o crtend.o crtbeginS.o crtbeginT.o crtendS.o"
   case ${target_thread_file} in
 posix)
   tmake_file="${tmake_file} t-freebsd-thread"

[gcc r15-7587] gcc: testsuite: Fix builtin-speculation-overloads[14].C testism

[Matthew Malcomson via Gcc-cvs]

https://gcc.gnu.org/g:9335ff73a509a1f203de691052d600facd07c3f8

commit r15-7587-g9335ff73a509a1f203de691052d600facd07c3f8
Author: Matthew Malcomson 
Date:   Mon Feb 10 16:24:20 2025 +

gcc: testsuite: Fix builtin-speculation-overloads[14].C testism

When making warnings trigger a failure in template substitution I
could not find any way to trigger the warning about builtin speculation
not being available on the given target.

Turns out I misread the code -- this warning happens when the
speculation_barrier pattern is not defined.

Here we add an effective target to represent
"__builtin_speculation_safe_value is available on this target" and use
that to adjust our test on SFINAE behaviour accordingly.
N.b. this means that we get extra testing -- not just that things work
on targets which support __builtin_speculation_safe_value, but also that
the behaviour works on targets which don't support it.

Tested with AArch64 native, AArch64 cross compiler, and RISC-V cross
compiler (just running the tests that I've changed).

Ok for trunk?

gcc/testsuite/ChangeLog:

PR target/117991
* g++.dg/template/builtin-speculation-overloads.def: SUCCESS
argument in SPECULATION_ASSERTS now uses a macro `true_def`
instead of the literal `true` for arguments which should work
with `__builtin_speculation_safe_value`.
* g++.dg/template/builtin-speculation-overloads1.C: Define
`true_def` macro on command line to compiler according to the
effective target representing that
`__builtin_speculation_safe_value` does something on this
target.
* g++.dg/template/builtin-speculation-overloads4.C: Likewise.
* lib/target-supports.exp
(check_effective_target_speculation_barrier_defined): New.

Signed-off-by: Matthew Malcomson 

Diff:
---
 gcc/testsuite/g++.dg/template/builtin-speculation-overloads.def | 9 ++---
 gcc/testsuite/g++.dg/template/builtin-speculation-overloads1.C  | 2 ++
 gcc/testsuite/g++.dg/template/builtin-speculation-overloads4.C  | 2 ++
 gcc/testsuite/lib/target-supports.exp   | 9 +
 4 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/gcc/testsuite/g++.dg/template/builtin-speculation-overloads.def 
b/gcc/testsuite/g++.dg/template/builtin-speculation-overloads.def
index 39d9b748d524..ada13e6f77c3 100644
--- a/gcc/testsuite/g++.dg/template/builtin-speculation-overloads.def
+++ b/gcc/testsuite/g++.dg/template/builtin-speculation-overloads.def
@@ -15,14 +15,17 @@ class X{};
 class Large { public: int arr[10]; };
 class Incomplete;
 
+/* Using `true_def` in order to account for the fact that if this target
+ * doesn't support __builtin_speculation_safe_value at all everything fails to
+ * substitute.  */
 #define SPECULATION_ASSERTS
\
-  MAKE_SPECULATION_ASSERT (int, true)  
\
+  MAKE_SPECULATION_ASSERT (int, true_def)  
\
   MAKE_SPECULATION_ASSERT (float, false)   
\
   MAKE_SPECULATION_ASSERT (X, false)   
\
   MAKE_SPECULATION_ASSERT (Large, false)   
\
   MAKE_SPECULATION_ASSERT (Incomplete, false)  
\
-  MAKE_SPECULATION_ASSERT (int *, true)
\
-  MAKE_SPECULATION_ASSERT (long, true)
+  MAKE_SPECULATION_ASSERT (int *, true_def)
\
+  MAKE_SPECULATION_ASSERT (long, true_def)
 
 int main() {
 SPECULATION_ASSERTS
diff --git a/gcc/testsuite/g++.dg/template/builtin-speculation-overloads1.C 
b/gcc/testsuite/g++.dg/template/builtin-speculation-overloads1.C
index bc8f1083a994..4c50d4aa6f5e 100644
--- a/gcc/testsuite/g++.dg/template/builtin-speculation-overloads1.C
+++ b/gcc/testsuite/g++.dg/template/builtin-speculation-overloads1.C
@@ -1,5 +1,7 @@
 /* Check that overloaded builtins can be used in templates with SFINAE.  */
 // { dg-do compile { target c++17 } }
+// { dg-additional-options "-Dtrue_def=true" { target 
speculation_barrier_defined } }
+// { dg-additional-options "-Dtrue_def=false" { target { ! 
speculation_barrier_defined } } }
 
 /* Checks performed here:
Various types (some that work, some that don't).  */
diff --git a/gcc/testsuite/g++.dg/template/builtin-speculation-overloads4.C 
b/gcc/testsuite/g++.dg/template/builtin-speculation-overloads4.C
index c024a21fa18e..cc0b3131af77 100644
--- a/gcc/testsuite/g++.dg/template/builtin-speculation-overloads4.C
+++ b/gcc/testsuite/g++.dg/template/builtin-speculation-overloads4.C
@@ -1,5 +1,7 @@
 /* Check that overloaded builtins can be used in templates with SFINAE.  */
 // { dg-do compile { target c++17 } }
+// { dg-additional-o

[gcc(refs/users/mikael/heads/pr118896_v02)] fortran: Declare virtual tables read-only

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:5bdd45c4d910c83bb940e173c313aeed23bd183f

commit 5bdd45c4d910c83bb940e173c313aeed23bd183f
Author: Mikael Morin 
Date:   Sun Feb 16 22:25:01 2025 +0100

fortran: Declare virtual tables read-only

Add the read-only flag on the artificial variables we create to hold
virtual tables.

PR fortran/118896

gcc/fortran/ChangeLog:

* trans-decl.cc (gfc_get_symbol_decl): Set the read-only flag
on virtual table declarations.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_79.f90: New test.

Diff:
---
 gcc/fortran/trans-decl.cc  |  2 +-
 gcc/testsuite/gfortran.dg/class_79.f90 | 57 ++
 2 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 0acf0e9adb78..cce1ae96046b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2105,7 +2105,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   if (sym->attr.vtab || def_init)
 {
   DECL_ARTIFICIAL (decl) = 1;
-  if (def_init && sym->value)
+  if (sym->attr.vtab || sym->value)
TREE_READONLY (decl) = 1;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/class_79.f90 
b/gcc/testsuite/gfortran.dg/class_79.f90
new file mode 100644
index ..393a5cf1c37c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_79.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+!
+! PR fortran/118896
+! Check that optimizations devirtualize all the calls to the internal _copy
+! typebound subroutine, and no reference to the virtual table remains.
+!
+! { dg-additional-options {-O2 -fdump-tree-original -fdump-tree-optimized} }
+! { dg-final { scan-tree-dump {__vtab} {original} } }
+! { dg-final { scan-tree-dump-not {__vtab} {optimized} } }
+
+module m
+  implicit none
+  type :: t1
+integer :: i
+  end type
+end module m
+
+subroutine test_t1
+  use m
+  implicit none
+
+  class(t1), dimension(:), allocatable :: x, y
+
+  x = [t1(3), t1(2), t1(1)]
+
+  x = realloc_t1 (x)
+  if (.not.check_t1 (x, [2,3,1], 1) ) stop 3
+
+contains
+
+  function realloc_t1 (arg) result (res)
+class(t1), dimension(:), allocatable :: arg
+class(t1), dimension(:), allocatable :: res
+select type (arg)
+  type is (t1)
+allocate (res, source = [t1 (arg(2)%i), t1 (arg(1)%i), t1 (arg(3)%i)])
+end select
+  end function realloc_t1
+
+  logical function check_t1 (arg, array, t, array2)
+class(t1) :: arg(:)
+integer :: array (:), t
+integer, optional :: array2(:)
+check_t1 = .true.
+select type (arg)
+type is (t1)
+  if (any (arg%i .ne. array)) check_t1 = .false.
+  if (t .eq. 2) check_t1 = .false.
+class default
+  check_t1 = .false.
+end select
+  end function check_t1
+
+end subroutine test_t1
+
+  call test_t1
+end

[gcc/mikael/heads/pr118896_v02] fortran: Declare virtual tables read-only

[Mikael Morin via Gcc-cvs]

The branch 'mikael/heads/pr118896_v02' was updated to point to:

 5bdd45c4d910... fortran: Declare virtual tables read-only

It previously pointed to:

 e6abc3922ec9... fortran: Declare virtual tables read-only

Diff:

!!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST):
---

  e6abc39... fortran: Declare virtual tables read-only


Summary of changes (added commits):
---

  5bdd45c... fortran: Declare virtual tables read-only

[gcc r14-11317] FreeBSD: Stop linking _p libs for -pg as of FreeBSD 14

[Gerald Pfeifer via Gcc-cvs]

https://gcc.gnu.org/g:4467274face2553615d08f36707b3bd3df137733

commit r14-11317-g4467274face2553615d08f36707b3bd3df137733
Author: Andreas Tobler 
Date:   Sun Jun 9 23:18:04 2024 +0200

FreeBSD: Stop linking _p libs for -pg as of FreeBSD 14

As of FreeBSD version 14, FreeBSD no longer provides profiled system
libraries like libc_p and libpthread_p. Stop linking against them if
the FreeBSD major version is 14 or more.

gcc:
* config/freebsd-spec.h: Change fbsd-lib-spec for FreeBSD > 13,
do not link against profiled system libraries if -pg is invoked.
Add a define to note about this change.
* config/aarch64/aarch64-freebsd.h: Use the note to inform if
-pg is invoked on FreeBSD > 13.
* config/arm/freebsd.h: Likewise.
* config/i386/freebsd.h: Likewise.
* config/i386/freebsd64.h: Likewise.
* config/riscv/freebsd.h: Likewise.
* config/rs6000/freebsd64.h: Likewise.
* config/rs6000/sysv4.h: Likeise.

Diff:
---
 gcc/config/aarch64/aarch64-freebsd.h |  1 +
 gcc/config/arm/freebsd.h |  1 +
 gcc/config/freebsd-spec.h| 18 ++
 gcc/config/i386/freebsd.h|  1 +
 gcc/config/i386/freebsd64.h  |  1 +
 gcc/config/riscv/freebsd.h   |  1 +
 gcc/config/rs6000/freebsd64.h|  1 +
 gcc/config/rs6000/sysv4.h|  1 +
 8 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/gcc/config/aarch64/aarch64-freebsd.h 
b/gcc/config/aarch64/aarch64-freebsd.h
index 53cc17a1caf0..e26d69ce46c7 100644
--- a/gcc/config/aarch64/aarch64-freebsd.h
+++ b/gcc/config/aarch64/aarch64-freebsd.h
@@ -35,6 +35,7 @@
 #undef  FBSD_TARGET_LINK_SPEC
 #define FBSD_TARGET_LINK_SPEC " \
 %{p:%nconsider using `-pg' instead of `-p' with gprof (1)}  \
+" FBSD_LINK_PG_NOTE "  \
 %{v:-V} \
 %{assert*} %{R*} %{rpath*} %{defsym*}   \
 %{shared:-Bshareable %{h*} %{soname*}}  \
diff --git a/gcc/config/arm/freebsd.h b/gcc/config/arm/freebsd.h
index 9d0a5a842aba..ee4860ae6375 100644
--- a/gcc/config/arm/freebsd.h
+++ b/gcc/config/arm/freebsd.h
@@ -47,6 +47,7 @@
 #undef LINK_SPEC
 #define LINK_SPEC "\
   %{p:%nconsider using `-pg' instead of `-p' with gprof (1)}   \
+  " FBSD_LINK_PG_NOTE "
\
   %{v:-V}  \
   %{assert*} %{R*} %{rpath*} %{defsym*}
\
   %{shared:-Bshareable %{h*} %{soname*}}   \
diff --git a/gcc/config/freebsd-spec.h b/gcc/config/freebsd-spec.h
index a6d1ad1280fe..f43056bf2cf0 100644
--- a/gcc/config/freebsd-spec.h
+++ b/gcc/config/freebsd-spec.h
@@ -92,19 +92,29 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  
If not, see
libc, depending on whether we're doing profiling or need threads support.
(similar to the default, except no -lg, and no -p).  */
 
+#if FBSD_MAJOR < 14
+#define FBSD_LINK_PG_NOTHREADS "%{!pg: -lc}  %{pg: -lc_p}"
+#define FBSD_LINK_PG_THREADS   "%{!pg: %{pthread:-lpthread} -lc} " \
+   "%{pg: %{pthread:-lpthread} -lc_p}"
+#define FBSD_LINK_PG_NOTE ""
+#else
+#define FBSD_LINK_PG_NOTHREADS "%{-lc} "
+#define FBSD_LINK_PG_THREADS   "%{pthread:-lpthread} -lc "
+#define FBSD_LINK_PG_NOTE "%{pg:%nFreeBSD no longer provides profiled "\
+ "system libraries}"
+#endif
+
 #ifdef FBSD_NO_THREADS
 #define FBSD_LIB_SPEC "
\
   %{pthread: %eThe -pthread option is only supported on FreeBSD when gcc \
 is built with the --enable-threads configure-time option.} \
   %{!shared:   \
-%{!pg: -lc}
\
-%{pg:  -lc_p}  \
+" FBSD_LINK_PG_NOTHREADS " \
   }"
 #else
 #define FBSD_LIB_SPEC "
\
   %{!shared:   \
-%{!pg: %{pthread:-lpthread} -lc}   \
-%{pg:  %{pthread:-lpthread_p} -lc_p}   \
+" FBSD_LINK_PG_THREADS "   \
   }\
   %{shared:\
 %{pthread:-lpthread} -lc   \
diff --git a/gcc/config/i386/freebsd.h b/gcc/config/i386/freebsd.h
index 3c57dc7cfae0..583c75

[gcc/mikael/heads/pr118896_v02] fortran: Declare virtual tables read-only

[Mikael Morin via Gcc-cvs]

The branch 'mikael/heads/pr118896_v02' was updated to point to:

 c475cbeeabde... fortran: Declare virtual tables read-only

It previously pointed to:

 5bdd45c4d910... fortran: Declare virtual tables read-only

Diff:

!!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST):
---

  5bdd45c... fortran: Declare virtual tables read-only


Summary of changes (added commits):
---

  c475cbe... fortran: Declare virtual tables read-only

[gcc(refs/users/mikael/heads/pr118896_v02)] fortran: Declare virtual tables read-only

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:c475cbeeabdec525fee57cd372db6688e999ed02

commit c475cbeeabdec525fee57cd372db6688e999ed02
Author: Mikael Morin 
Date:   Sun Feb 16 22:25:01 2025 +0100

fortran: Declare virtual tables read-only

Add the read-only flag on the artificial variables we create to hold
virtual tables, so that indirect procedure calls going through the
virtual table can be devirtualized to direct calls.

PR fortran/118896

gcc/fortran/ChangeLog:

* trans-decl.cc (gfc_get_symbol_decl): Set the read-only flag
on virtual table declarations.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_79.f90: New test.

Diff:
---
 gcc/fortran/trans-decl.cc  |  6 ++--
 gcc/testsuite/gfortran.dg/class_79.f90 | 57 ++
 2 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 0acf0e9adb78..98c0eb3d01af 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2100,12 +2100,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
  Marking this as artificial means that OpenMP will treat this as
  predetermined shared.  */
 
-  bool def_init = startswith (sym->name, "__def_init");
-
-  if (sym->attr.vtab || def_init)
+  if (sym->attr.vtab || startswith (sym->name, "__def_init"))
 {
   DECL_ARTIFICIAL (decl) = 1;
-  if (def_init && sym->value)
+  if (sym->attr.vtab || sym->value)
TREE_READONLY (decl) = 1;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/class_79.f90 
b/gcc/testsuite/gfortran.dg/class_79.f90
new file mode 100644
index ..393a5cf1c37c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_79.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+!
+! PR fortran/118896
+! Check that optimizations devirtualize all the calls to the internal _copy
+! typebound subroutine, and no reference to the virtual table remains.
+!
+! { dg-additional-options {-O2 -fdump-tree-original -fdump-tree-optimized} }
+! { dg-final { scan-tree-dump {__vtab} {original} } }
+! { dg-final { scan-tree-dump-not {__vtab} {optimized} } }
+
+module m
+  implicit none
+  type :: t1
+integer :: i
+  end type
+end module m
+
+subroutine test_t1
+  use m
+  implicit none
+
+  class(t1), dimension(:), allocatable :: x, y
+
+  x = [t1(3), t1(2), t1(1)]
+
+  x = realloc_t1 (x)
+  if (.not.check_t1 (x, [2,3,1], 1) ) stop 3
+
+contains
+
+  function realloc_t1 (arg) result (res)
+class(t1), dimension(:), allocatable :: arg
+class(t1), dimension(:), allocatable :: res
+select type (arg)
+  type is (t1)
+allocate (res, source = [t1 (arg(2)%i), t1 (arg(1)%i), t1 (arg(3)%i)])
+end select
+  end function realloc_t1
+
+  logical function check_t1 (arg, array, t, array2)
+class(t1) :: arg(:)
+integer :: array (:), t
+integer, optional :: array2(:)
+check_t1 = .true.
+select type (arg)
+type is (t1)
+  if (any (arg%i .ne. array)) check_t1 = .false.
+  if (t .eq. 2) check_t1 = .false.
+class default
+  check_t1 = .false.
+end select
+  end function check_t1
+
+end subroutine test_t1
+
+  call test_t1
+end

[gcc(refs/users/mikael/heads/pr118896_v02)] fortran: Declare virtual tables read-only

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:e6abc3922ec9bc6598f09369e35848cd3d3d8ae4

commit e6abc3922ec9bc6598f09369e35848cd3d3d8ae4
Author: Mikael Morin 
Date:   Sun Feb 16 22:25:01 2025 +0100

fortran: Declare virtual tables read-only

Add the read-only flag on the artificial variables we create to hold
virtual tables.

PR fortran/118896

gcc/fortran/ChangeLog:

* trans-decl.cc (gfc_get_symbol_decl): Set the read-only flag
on virtual table declarations.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_79.f90: New test.

Diff:
---
 gcc/fortran/trans-decl.cc  |  2 +-
 gcc/testsuite/gfortran.dg/class_79.f90 | 57 ++
 2 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 0acf0e9adb78..36920d19b2d2 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2105,7 +2105,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   if (sym->attr.vtab || def_init)
 {
   DECL_ARTIFICIAL (decl) = 1;
-  if (def_init && sym->value)
+  if (sym->attr.vtab && sym->value)
TREE_READONLY (decl) = 1;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/class_79.f90 
b/gcc/testsuite/gfortran.dg/class_79.f90
new file mode 100644
index ..9b393232af5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_79.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+!
+! PR fortran/118896
+! Check that optimizations devirtualize all the calls to the internal _copy
+! typebound subroutine, and no reference to the virtual table remains.
+!
+! { dg-additional-options {-O2 -fdump-tree-optimized} }
+! { dg-final { scan-tree-dump-not {vtab} {optimized} } }
+
+module m
+  implicit none
+  type :: t1
+integer :: i
+  end type
+end module m
+
+subroutine test_t1
+  use m
+  implicit none
+
+  class(t1), dimension(:), allocatable :: x, y
+
+  x = [t1(3), t1(2), t1(1)]
+
+  x = realloc_t1 (x)
+  if (.not.check_t1 (x, [2,3,1], 1) ) stop 3
+
+contains
+
+  function realloc_t1 (arg) result (res)
+class(t1), dimension(:), allocatable :: arg
+class(t1), dimension(:), allocatable :: res
+select type (arg)
+  type is (t1)
+allocate (res, source = [t1 (arg(2)%i), t1 (arg(1)%i), t1 (arg(3)%i)])
+end select
+  end function realloc_t1
+
+  logical function check_t1 (arg, array, t, array2)
+class(t1) :: arg(:)
+integer :: array (:), t
+integer, optional :: array2(:)
+check_t1 = .true.
+select type (arg)
+type is (t1)
+  if (any (arg%i .ne. array)) check_t1 = .false.
+  if (t .eq. 2) check_t1 = .false.
+class default
+  check_t1 = .false.
+end select
+  end function check_t1
+
+end subroutine test_t1
+
+  call test_t1
+end
+

[gcc] Created branch 'mikael/heads/pr118896_v02' in namespace 'refs/users'

[Mikael Morin via Gcc-cvs]

The branch 'mikael/heads/pr118896_v02' was created in namespace 'refs/users' 
pointing to:

 e6abc3922ec9... fortran: Declare virtual tables read-only

[gcc r13-9380] FreeBSD: Stop linking _p libs for -pg as of FreeBSD 14

[Gerald Pfeifer via Gcc-cvs]

https://gcc.gnu.org/g:5f872c363890540fab2432ac3c50012e820e504b

commit r13-9380-g5f872c363890540fab2432ac3c50012e820e504b
Author: Andreas Tobler 
Date:   Sun Jun 9 23:18:04 2024 +0200

FreeBSD: Stop linking _p libs for -pg as of FreeBSD 14

As of FreeBSD version 14, FreeBSD no longer provides profiled system
libraries like libc_p and libpthread_p. Stop linking against them if
the FreeBSD major version is 14 or more.

gcc:
* config/freebsd-spec.h: Change fbsd-lib-spec for FreeBSD > 13,
do not link against profiled system libraries if -pg is invoked.
Add a define to note about this change.
* config/aarch64/aarch64-freebsd.h: Use the note to inform if
-pg is invoked on FreeBSD > 13.
* config/arm/freebsd.h: Likewise.
* config/i386/freebsd.h: Likewise.
* config/i386/freebsd64.h: Likewise.
* config/riscv/freebsd.h: Likewise.
* config/rs6000/freebsd64.h: Likewise.
* config/rs6000/sysv4.h: Likeise.

Diff:
---
 gcc/config/aarch64/aarch64-freebsd.h |  1 +
 gcc/config/arm/freebsd.h |  1 +
 gcc/config/freebsd-spec.h| 18 ++
 gcc/config/i386/freebsd.h|  1 +
 gcc/config/i386/freebsd64.h  |  1 +
 gcc/config/riscv/freebsd.h   |  1 +
 gcc/config/rs6000/freebsd64.h|  1 +
 gcc/config/rs6000/sysv4.h|  1 +
 8 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/gcc/config/aarch64/aarch64-freebsd.h 
b/gcc/config/aarch64/aarch64-freebsd.h
index c91a6bf0f4e5..d3b2d8a52fe1 100644
--- a/gcc/config/aarch64/aarch64-freebsd.h
+++ b/gcc/config/aarch64/aarch64-freebsd.h
@@ -35,6 +35,7 @@
 #undef  FBSD_TARGET_LINK_SPEC
 #define FBSD_TARGET_LINK_SPEC " \
 %{p:%nconsider using `-pg' instead of `-p' with gprof (1)}  \
+" FBSD_LINK_PG_NOTE "  \
 %{v:-V} \
 %{assert*} %{R*} %{rpath*} %{defsym*}   \
 %{shared:-Bshareable %{h*} %{soname*}}  \
diff --git a/gcc/config/arm/freebsd.h b/gcc/config/arm/freebsd.h
index 5b6a08e8a129..3962ecb04752 100644
--- a/gcc/config/arm/freebsd.h
+++ b/gcc/config/arm/freebsd.h
@@ -47,6 +47,7 @@
 #undef LINK_SPEC
 #define LINK_SPEC "\
   %{p:%nconsider using `-pg' instead of `-p' with gprof (1)}   \
+  " FBSD_LINK_PG_NOTE "
\
   %{v:-V}  \
   %{assert*} %{R*} %{rpath*} %{defsym*}
\
   %{shared:-Bshareable %{h*} %{soname*}}   \
diff --git a/gcc/config/freebsd-spec.h b/gcc/config/freebsd-spec.h
index 9050a8dcbf9b..091d1ad5a0c8 100644
--- a/gcc/config/freebsd-spec.h
+++ b/gcc/config/freebsd-spec.h
@@ -92,19 +92,29 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  
If not, see
libc, depending on whether we're doing profiling or need threads support.
(similar to the default, except no -lg, and no -p).  */
 
+#if FBSD_MAJOR < 14
+#define FBSD_LINK_PG_NOTHREADS "%{!pg: -lc}  %{pg: -lc_p}"
+#define FBSD_LINK_PG_THREADS   "%{!pg: %{pthread:-lpthread} -lc} " \
+   "%{pg: %{pthread:-lpthread} -lc_p}"
+#define FBSD_LINK_PG_NOTE ""
+#else
+#define FBSD_LINK_PG_NOTHREADS "%{-lc} "
+#define FBSD_LINK_PG_THREADS   "%{pthread:-lpthread} -lc "
+#define FBSD_LINK_PG_NOTE "%{pg:%nFreeBSD no longer provides profiled "\
+ "system libraries}"
+#endif
+
 #ifdef FBSD_NO_THREADS
 #define FBSD_LIB_SPEC "
\
   %{pthread: %eThe -pthread option is only supported on FreeBSD when gcc \
 is built with the --enable-threads configure-time option.} \
   %{!shared:   \
-%{!pg: -lc}
\
-%{pg:  -lc_p}  \
+" FBSD_LINK_PG_NOTHREADS " \
   }"
 #else
 #define FBSD_LIB_SPEC "
\
   %{!shared:   \
-%{!pg: %{pthread:-lpthread} -lc}   \
-%{pg:  %{pthread:-lpthread_p} -lc_p}   \
+" FBSD_LINK_PG_THREADS "   \
   }\
   %{shared:\
 %{pthread:-lpthread} -lc   \
diff --git a/gcc/config/i386/freebsd.h b/gcc/config/i386/freebsd.h
index 7fa9e8a93ff4..4de5ec4