[gcc r16-2398] libstdc++: Fix obvious mistake in inplace_vector::assign_range [PR119137]

[Tomasz Kaminski via Libstdc++-cvs]

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

commit r16-2398-gae00818713756fd45ee379a8a30ae907959433fe
Author: Tomasz Kamiński 
Date:   Tue Jul 22 09:32:47 2025 +0200

libstdc++: Fix obvious mistake in inplace_vector::assign_range [PR119137]

In case of input iterators, the loop that assigns to existing elements
should run up to number of elements in vector (_M_size) not capacity (_Nm).

PR libstdc++/119137

libstdc++-v3/ChangeLog:

* include/std/inplace_vector (inplace_vector::assign_range):
Replace _Nm with _M_size in the assigment loop.

Diff:
---
 libstdc++-v3/include/std/inplace_vector | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/libstdc++-v3/include/std/inplace_vector 
b/libstdc++-v3/include/std/inplace_vector
index e0943f52ab83..290cf6eb0e92 100644
--- a/libstdc++-v3/include/std/inplace_vector
+++ b/libstdc++-v3/include/std/inplace_vector
@@ -269,7 +269,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION
  auto __in = ranges::begin(__rg);
  auto __end = ranges::end(__rg);
  size_type __n = 0;
- for (; __n < _Nm && __in != __end; ++__in)
+ for (; __n < _M_size && __in != __end; ++__in)
_M_elems[__n++] = *__in;
 
  if (__in == __end)

[gcc r14-11903] rs6000: Add TARGET_FLOAT128_HW guard for quad-precision insns

[kishan parmar via Gcc-cvs]

https://gcc.gnu.org/g:845085856185560952331626fbca3a1414cc3adb

commit r14-11903-g845085856185560952331626fbca3a1414cc3adb
Author: Haochen Gui 
Date:   Thu Aug 15 13:45:35 2024 +0800

rs6000: Add TARGET_FLOAT128_HW guard for quad-precision insns

gcc/
* config/rs6000/rs6000.md (floatti2, floatunsti2,
fix_truncti2): Add guard TARGET_FLOAT128_HW.
* config/rs6000/vsx.md (xsxexpqp__,
xsxsigqp__, xsiexpqpf_,
xsiexpqp__, xscmpexpqp__,
*xscmpexpqp, xststdcnegqp_): Replace guard TARGET_P9_VECTOR
with TARGET_FLOAT128_HW.

gcc/testsuite/
* gcc.target/powerpc/float128-cmp2-runnable.c: Replace
ppc_float128_sw with ppc_float128_hw and remove p9vector_hw.

(cherry picked from commit bf891fcabca7a59ce71e85c8f2eea2bfabbffe59)

Diff:
---
 gcc/config/rs6000/rs6000.md   |  6 +++---
 gcc/config/rs6000/vsx.md  | 14 +++---
 gcc/testsuite/gcc.target/powerpc/float128-cmp2-runnable.c |  3 +--
 3 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/gcc/config/rs6000/rs6000.md b/gcc/config/rs6000/rs6000.md
index 74b87f926d7b..bbbd7041a198 100644
--- a/gcc/config/rs6000/rs6000.md
+++ b/gcc/config/rs6000/rs6000.md
@@ -6897,7 +6897,7 @@
 (define_insn "floatti2"
   [(set (match_operand:IEEE128 0 "vsx_register_operand" "=v")
(float:IEEE128 (match_operand:TI 1 "vsx_register_operand" "v")))]
-  "TARGET_POWER10"
+  "TARGET_POWER10 && TARGET_FLOAT128_HW"
 {
   return  "xscvsqqp %0,%1";
 }
@@ -6906,7 +6906,7 @@
 (define_insn "floatunsti2"
   [(set (match_operand:IEEE128 0 "vsx_register_operand" "=v")
(unsigned_float:IEEE128 (match_operand:TI 1 "vsx_register_operand" 
"v")))]
-  "TARGET_POWER10"
+  "TARGET_POWER10 && TARGET_FLOAT128_HW"
 {
   return  "xscvuqqp %0,%1";
 }
@@ -6915,7 +6915,7 @@
 (define_insn "fix_truncti2"
   [(set (match_operand:TI 0 "vsx_register_operand" "=v")
(fix:TI (match_operand:IEEE128 1 "vsx_register_operand" "v")))]
-  "TARGET_POWER10"
+  "TARGET_POWER10 && TARGET_FLOAT128_HW"
 {
   return  "xscvqpsqz %0,%1";
 }
diff --git a/gcc/config/rs6000/vsx.md b/gcc/config/rs6000/vsx.md
index 7a9c19ac9030..8665ee7f6dff 100644
--- a/gcc/config/rs6000/vsx.md
+++ b/gcc/config/rs6000/vsx.md
@@ -5132,7 +5132,7 @@
(unspec:V2DI_DI
  [(match_operand:IEEE128 1 "altivec_register_operand" "v")]
 UNSPEC_VSX_SXEXPDP))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
   "xsxexpqp %0,%1"
   [(set_attr "type" "vecmove")])
 
@@ -5151,7 +5151,7 @@
(unspec:VEC_TI [(match_operand:IEEE128 1
"altivec_register_operand" "v")]
 UNSPEC_VSX_SXSIG))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
   "xsxsigqp %0,%1"
   [(set_attr "type" "vecmove")])
 
@@ -5171,7 +5171,7 @@
 [(match_operand:IEEE128 1 "altivec_register_operand" "v")
  (match_operand:DI 2 "altivec_register_operand" "v")]
 UNSPEC_VSX_SIEXPQP))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
   "xsiexpqp %0,%1,%2"
   [(set_attr "type" "vecmove")])
 
@@ -5183,7 +5183,7 @@
 (match_operand:V2DI_DI 2
  "altivec_register_operand" "v")]
 UNSPEC_VSX_SIEXPQP))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
   "xsiexpqp %0,%1,%2"
   [(set_attr "type" "vecmove")])
 
@@ -5253,7 +5253,7 @@
(set (match_operand:SI 0 "register_operand" "=r")
(CMP_TEST:SI (match_dup 3)
 (const_int 0)))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
 {
   if ( == UNORDERED && !HONOR_NANS (mode))
 {
@@ -5271,7 +5271,7 @@
  (match_operand:IEEE128 2 "altivec_register_operand" 
"v")]
  UNSPEC_VSX_SCMPEXPQP)
 (match_operand:SI 3 "zero_constant" "j")))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
   "xscmpexpqp %0,%1,%2"
   [(set_attr "type" "fpcompare")])
 
@@ -5329,7 +5329,7 @@
(set (match_operand:SI 0 "register_operand" "=r")
(lt:SI (match_dup 2)
   (const_int 0)))]
-  "TARGET_P9_VECTOR"
+  "TARGET_FLOAT128_HW"
 {
   operands[2] = gen_reg_rtx (CCFPmode);
 })
diff --git a/gcc/testsuite/gcc.target/powerpc/float128-cmp2-runnable.c 
b/gcc/testsuite/gcc.target/powerpc/float128-cmp2-runnable.c
index d376a3ca68ec..f48aa089b05b 100644
--- a/gcc/testsuite/gcc.target/powerpc/float128-cmp2-runnable.c
+++ b/gcc/testsuite/gcc.target/powerpc/float128-cmp2-runnable.c
@@ -1,6 +1,5 @@
 /* { dg-do run } */
-/* { dg-require-effective-target ppc_float128_sw } */
-/* { dg-require-effective-target p9vector_hw } */
+/* { dg-require-effective-target ppc_float128_hw } */
 /* { dg-options "-O2 -mdejagnu-cpu=power9 " } */
 
 #define NAN_Q __builtin_nanq ("")

[gcc r16-2409] ada: Adding support to defer the addition of extra formals

[Marc Poulhies via Gcc-cvs]

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

commit r16-2409-ge7291bda2381fe7d7d6af6c85c798680276ab3a5
Author: Javier Miranda 
Date:   Wed Jul 2 19:22:33 2025 +

ada: Adding support to defer the addition of extra formals

Add support to create the extra formals when the underlying type
of some formal type or return type of a subprogram, subprogram type
or entry is not available when the entity is frozen. For example,
when a function that returns a private type is frozen before the
full-view of its private type is analyzed.

gcc/ada/ChangeLog:

* einfo.ads (Extra_Formals): Complete documentation.
(Has_First_Controlling_Parameter_Aspect): Place it in alphabetical 
order.
(Has_Frozen_Extra_Formals): New attribute.
* gen_il-fields.ads (Has_Frozen_Extra_Formals): New entity field.
* gen_il-gen-gen_entities.adb (Has_Frozen_Extra_Formals): Adding new
entity flag to subprograms, subprogram types, and and entries.
* gen_il-internals.adb (Image): Adding Has_Frozen_Extra_Formals.
* exp_ch3.adb (Build_Array_Init_Proc): Freeze its extra formals.
(Build_Init_Procedure): Freeze its extra formals.
(Expand_Freeze_Record_Type): For tagged types with foreign 
convention
create the extra formals of primitives with convention Ada.
* exp_ch6.ads (Create_Extra_Actuals): New subprogram.
* exp_ch6.adb (Check_BIP_Actuals): Adding assertions.
(Create_Extra_Actuals): New subprogram that factorizes code from
Expand_Call_Helper.
(Expand_Call_Helper): Adding support to defer the addition of extra
actuals. Move the code that adds the extra actuals to a new 
subprogram.
(Is_Unchecked_Union_Equality): Renamed as 
Is_Unchecked_Union_Predefined_
Equality_Call.
* exp_ch7.adb (Create_Finalizer): Freeze its extra formals.
(Wrap_Transient_Expression): Link the temporary with its relocated
expression to facilitate locating the expression in the expanded 
code.
* exp_ch9.ads (Expand_N_Entry_Declaration): Adding one formal.
* exp_ch9.adb (Expand_N_Entry_Declaration): Defer the expansion of
the entry if the extra formals are not available; analyze the built
declarations for the record type that holds all the parameters if
the expansion of the entry declaration was deferred.
* exp_disp.adb (Expand_Dispatching_Call): Handle deferred extra 
formals.
(Set_CPP_Constructors): Freeze its extra formals.
* freeze.adb (Freeze_Entity): Create the extra actuals of acccess to
subprograms whose designated type is a subprogram type.
(Freeze_Subprogram): Adjust assertion to support deferred extra 
formals,
and freeze extra formals of non-dispatching subprograms with foreign
convention. Added assertion to check matching of formals in thunks.
* sem_aux.adb (Get_Called_Entity): Adding documentation.
* sem_ch3.adb (Analyze_Full_Type_Declaration): Create the extra 
formals
of deferred subprograms, subprogram types and entries; create also 
the
extra actuals of deferred calls.
* sem_ch6.ads (Freeze_Extra_Formals): New subprogram.
(Deferred_Extra_Formals_Support): New package.
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Create the extra 
formals
of subprograms without separate spec.
(Add_Extra_Formal): Add documentation.
(Has_Extra_Formals): Removed.
(Parent_Subprogram): Adding documentation.
(Create_Extra_Formals): Defer adding extra formals if the 
underlying_type
of some formal type or return type is not available.
(Extra_Formals_Match_OK): Add missing check on the extra formals of
unchecked unions.
(Freeze_Extra_Formals): New subprogram.
(Deferred_Extra_Formals_Support): New package.
* sem_ch9.adb (Analyze_Entry_Declaration): Freeze its extra formals.
* sem_ch13.adb (New_Put_Image_Subprogram): ditto.
* sem_util.ads (Is_Unchecked_Union_Equality): New subprogram.
* sem_util.adb (Is_Unchecked_Union_Equality): ditto.

Diff:
---
 gcc/ada/einfo.ads   |   33 +-
 gcc/ada/exp_ch3.adb |   23 +-
 gcc/ada/exp_ch6.adb | 1228 +++
 gcc/ada/exp_ch6.ads |4 +
 gcc/ada/exp_ch7.adb |   12 +-
 gcc/ada/exp_ch9.adb |   44 +-
 gcc/ada/exp_ch9.ads |9 +-
 gcc/ada/exp_disp.adb|   72 +-
 gcc/ada/freeze.adb  |   19 +-
 gcc/ada/gen_il-fields.ads   |1 +
 gcc/ada/gen_il-gen-gen_entities.adb |  

[gcc r16-2410] ada: Fix unnecessary extra RE_Activation_Chain_Access with No_Task_Parts

[Marc Poulhies via Gcc-cvs]

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

commit r16-2410-g15cd3770ac14562d31d057cd5b65df6b9163521c
Author: Denis Mazzucato 
Date:   Mon Jul 7 11:11:08 2025 +0200

ada: Fix unnecessary extra RE_Activation_Chain_Access with No_Task_Parts

This patch checks the presence of No_Task_Parts on any ancestor or
inherited interface, not only its root type, since No_Task_Parts
prohibits tasking for any of its descendant. In case the current
subprogram is overridden/inherited, we need to return the same value
we would return for the original corresponding operation. The aspect
No_Task_Parts is nonoverridable and applies also when specified in a
partial view.

gcc/ada/ChangeLog:

* sem_ch6.adb (Might_Need_BIP_Task_Actuals): Check whether 
No_Task_Parts is enabled in any
of the derived types, or interfaces, from the user-defined 
primitive return type.
* sem_ch13.adb (Analyze_Aspect_Specifications): Add No_Task_Parts 
and No_Controlled_Parts to
the representation chain to be visible in the full view of private 
types.
* aspects.ads (Nonoverridable_Aspect_Id): As per GNAT RM, 
No_Task_Parts is nonoverridable.
* sem_util.adb (Check_Inherited_Nonoverridable_Aspects): Likewise.
* sem_util.ads: Fix typo and style.
* sem_disp.adb: Missing comment.

Diff:
---
 gcc/ada/aspects.ads  |  1 +
 gcc/ada/sem_ch13.adb |  8 
 gcc/ada/sem_ch6.adb  | 38 +++---
 gcc/ada/sem_disp.adb |  2 ++
 gcc/ada/sem_util.adb |  7 +--
 gcc/ada/sem_util.ads |  4 ++--
 6 files changed, 45 insertions(+), 15 deletions(-)

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index d8861bf8fd00..6d37ec7bf2ae 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -259,6 +259,7 @@ package Aspects is
  | Aspect_Iterator_Element
  | Aspect_Max_Entry_Queue_Length
  | Aspect_No_Controlled_Parts
+ | Aspect_No_Task_Parts
  | Aspect_Real_Literal
  | Aspect_String_Literal
  | Aspect_Variable_Indexing;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8a1cac0451d5..162de654323f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5064,6 +5064,14 @@ package body Sem_Ch13 is
 Check_Expr_Is_OK_Static_Expression (Expr, Any_Boolean);
  end if;
 
+ --  Record the No_Task_Parts aspects as a rep item so it
+ --  can be consistently looked up on the full view of the
+ --  type.
+
+ if Is_Private_Type (E) then
+Record_Rep_Item (E, Aspect);
+ end if;
+
  goto Continue;
 
   --  Ada 2022 (AI12-0075): static expression functions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a13f4bd97df1..ce5b800e48c9 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8647,7 +8647,16 @@ package body Sem_Ch6 is
 
   function Might_Need_BIP_Task_Actuals (E : Entity_Id) return Boolean is
  Subp_Id  : Entity_Id;
- Func_Typ : Entity_Id;
+ Original : Entity_Id;
+ Root : Entity_Id;
+
+ function Has_No_Task_Parts_Enabled (E : Entity_Id) return Boolean
+ is (Has_Enabled_Aspect (E, Aspect_No_Task_Parts));
+
+ function Collect_Ancestors_With_No_Task_Parts is new
+   Collect_Types_In_Hierarchy (Predicate => Has_No_Task_Parts_Enabled);
+
+  --  Start of processing for Might_Need_BIP_Task_Actuals
 
   begin
  if Global_No_Tasking or else No_Run_Time_Mode then
@@ -8675,21 +8684,28 @@ package body Sem_Ch6 is
  then
 Subp_Id := Protected_Body_Subprogram (E);
 
- else
+ --  For access to subprogram types we look at the return type of the
+ --  subprogram type itself, as it cannot be overridden or inherited.
+
+ elsif Ekind (E) = E_Subprogram_Type then
 Subp_Id := E;
- end if;
 
- --  We check the root type of the return type since the same
- --  decision must be taken for all descendants overriding a
- --  dispatching operation.
+ --  Otherwise, we need to return the same value we would return for
+ --  the original corresponding operation.
+
+ else
+Subp_Id := Original_Corresponding_Operation (E);
+ end if;
 
- Func_Typ := Root_Type (Underlying_Type (Etype (Subp_Id)));
+ Original := Underlying_Type (Etype (Subp_Id));
+ Root := Underlying_Type (Root_Type (Original));
 
  return Ekind (Subp_Id) in E_Function | E_Subprogram_Type
-   and then not Has_Foreign_Convention (F

[gcc r16-2407] ada: Expand continue procedure calls for GNATprove

[Marc Poulhies via Gcc-cvs]

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

commit r16-2407-gc543be28e2e9c1047b81e7abe6377ea6a6ccc1a6
Author: Martin Clochard 
Date:   Thu Jul 3 15:52:02 2025 +0200

ada: Expand continue procedure calls for GNATprove

Continue being a non-reserved keyword, occurrences of continue may
be resolved as procedure calls. Get that special case out of the
way for GNATprove, in anticipation of support for continue keyword.

gcc/ada/ChangeLog:

* exp_spark.adb (Expand_SPARK): Add expansion of continue 
statements.
(Expand_SPARK_N_Continue_Statement): Expand continue statements 
resolved
as procedure calls into said procedure calls.

Diff:
---
 gcc/ada/exp_spark.adb | 24 
 1 file changed, 24 insertions(+)

diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb
index 6e1c86acc39e..a75a507388bc 100644
--- a/gcc/ada/exp_spark.adb
+++ b/gcc/ada/exp_spark.adb
@@ -73,6 +73,10 @@ package body Exp_SPARK is
procedure Expand_SPARK_N_Attribute_Reference (N : Node_Id);
--  Perform attribute-reference-specific expansion
 
+   procedure Expand_SPARK_N_Continue_Statement (N : Node_Id);
+   --  Expand continue statements which are resolved as procedure calls, into
+   --  said procedure calls. Real continue statements are left as-is.
+
procedure Expand_SPARK_N_Delta_Aggregate (N : Node_Id);
--  Perform delta-aggregate-specific expansion
 
@@ -191,6 +195,9 @@ package body Exp_SPARK is
 
  --  In SPARK mode, no other constructs require expansion
 
+ when N_Continue_Statement =>
+Expand_SPARK_N_Continue_Statement (N);
+
  when others =>
 null;
   end case;
@@ -435,6 +442,23 @@ package body Exp_SPARK is
   end if;
end Expand_SPARK_Delta_Or_Update;
 
+   ---
+   -- Expand_SPARK_N_Continue_Statement --
+   ---
+
+   procedure Expand_SPARK_N_Continue_Statement (N : Node_Id) is
+  X : constant Node_Id := Call_Or_Target_Loop (N);
+   begin
+  if No (X) then
+ return;
+  end if;
+
+  if Nkind (X) = N_Procedure_Call_Statement then
+ Replace (N, X);
+ Analyze (N);
+  end if;
+   end Expand_SPARK_N_Continue_Statement;
+
--
-- Expand_SPARK_N_Aggregate --
--

[gcc r16-2406] ada: Tune check for restriction No_Relative_Delay and call to Set_Handler

[Marc Poulhies via Gcc-cvs]

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

commit r16-2406-g7e533dbd8ce2b786c5c5d174b992197947fbd70d
Author: Piotr Trojanek 
Date:   Thu Jul 3 10:10:56 2025 +0200

ada: Tune check for restriction No_Relative_Delay and call to Set_Handler

When checking restriction No_Relative_Delay and detecting calls to
Ada.Real_Time.Timing_Events.Set_Handler with a Time_Span parameter,
we looked at the exact type of the actual parameter, while we should
look at its base type.

This patch looks at the type of actual parameter like it is done in
Expand_N_Delay_Until_Statement.

gcc/ada/ChangeLog:

* sem_res.adb (Resolve_Call): Look at the base type of actual 
parameter
when checking call to Set_Handler.

Diff:
---
 gcc/ada/sem_res.adb | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e44994a681d7..29b776688023 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7270,7 +7270,9 @@ package body Sem_Res is
 
   if Restriction_Check_Required (No_Relative_Delay)
 and then Is_RTE (Nam, RE_Set_Handler)
-and then Is_RTE (Etype (Next_Actual (First_Actual (N))), RE_Time_Span)
+and then
+  Is_RTE
+(Base_Type (Etype (Next_Actual (First_Actual (N, RE_Time_Span)
   then
  Check_Restriction (No_Relative_Delay, N);
   end if;

[gcc r16-2400] ada: Ensure Expression_Copy has a parent before analysis

[Marc Poulhies via Gcc-cvs]

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

commit r16-2400-g3d1f1416180b586549d1a1427edfe1365e86a1a0
Author: Viljar Indus 
Date:   Mon Jun 30 22:41:45 2025 +0300

ada: Ensure Expression_Copy has a parent before analysis

Some analysis requires going up the parent chain to get the
relevant context. Ensure that is done for the Expression_Copy
node which is not a syntactic node.

gcc/ada/ChangeLog:

* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations):
Ensure the Expression_Copy always has a parent before
calling any analyze.

Diff:
---
 gcc/ada/sem_ch13.adb | 14 +++---
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 99acbf89e4eb..704bf3e04127 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11241,6 +11241,13 @@ package body Sem_Ch13 is
--  Start of processing for Check_Aspect_At_End_Of_Declarations
 
begin
+  --  Indicate that the expression comes from an aspect specification,
+  --  which is used in subsequent analysis even if expansion is off.
+
+  if Present (End_Decl_Expr) then
+ Set_Parent (End_Decl_Expr, ASN);
+  end if;
+
   --  In an instance we do not perform the consistency check between freeze
   --  point and end of declarations, because it was done already in the
   --  analysis of the generic. Furthermore, the delayed analysis of an
@@ -11332,13 +11339,6 @@ package body Sem_Ch13 is
 end if;
  end if;
 
- --  Indicate that the expression comes from an aspect specification,
- --  which is used in subsequent analysis even if expansion is off.
-
- if Present (End_Decl_Expr) then
-Set_Parent (End_Decl_Expr, ASN);
- end if;
-
  --  In a generic context the original aspect expressions have not
  --  been preanalyzed, so do it now. There are no conformance checks
  --  to perform in this case. As before, we have to make components

[gcc r16-2399] ada: Improved support for mutably tagged types

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:574bdf8e2150df4527e4ae054381caa6e22a227b

commit r16-2399-g574bdf8e2150df4527e4ae054381caa6e22a227b
Author: Steve Baird 
Date:   Fri Jun 13 13:53:20 2025 -0700

ada: Improved support for mutably tagged types

Fix bugs related to mutably tagged types in streaming operations, Put_Image
attributes, aggregates, composite equality comparisons with mutably-tagged
components, and other issues.

gcc/ada/ChangeLog:

* exp_aggr.adb (Build_Record_Aggr_Code.Gen_Assign): In the case of
an aggregate component where the component type is mutably tagged
and the component value is provided by a qualified aggregate (and
qualified with a specific type), avoid incorrectly rejecting the
inner aggregate for violating the rule that the type of an
aggregate shall not be class-wide.
* exp_attr.adb: For a predefined streaming operation (i.e., Read,
Write, Input, or Output) of a class-wide type, the external name
of the tag of the value is normally written out by Output and read
in by Input. In the case of a mutably tagged type, this is instead
done in Write and Read.
* exp_ch4.adb (Expand_Composite_Equality): In the case of an
equality comparison for a type having a mutably tagged component,
we want the component comparison to compare two values of the
mutably tagged type, not two values of the corresponding
array-of-bytes-ish representation type. Even if there are no
user-defined equality functions anywhere in sight, comparing the
array values still doesn't work because undefined bits may end up
participating in the comparison (resulting in an incorrect result
of False).
* exp_put_image.adb: In the case of a class-wide type, the
predefined Image attribute includes the name of the specific type
(and a "'" character, to follow qualified expression syntax) to
indicate the tag of the value. With the introduction of mutably
tagged types, this case can now arise in the case of a component
(of either an enclosing array or an enclosing record), not just
for a top-level object. So we factor the code to do this into a
new procedure, Put_Specific_Type_Name_Qualifier, so that it can be
called from more than one place. This reorganization also involves
replacing the procedure Put_String_Exp with a new procedure,
Put_String_Exp_To_Buffer, declared in a less nested scope. For
mutably tagged components (at the source level) the component type
(at the GNAT tree level) is an array of bytes (actually a two
field record containing an array of bytes, but that's a detail).
Appropriate conversions need to be generated so that we don't end
up generating an image for an array of bytes; this is done at the
same places where Put_Specific_Type_Name_Qualifier is called
(for components) by calling Make_Mutably_Tagged_Conversion.
* exp_strm.adb (Make_Field_Attribute): Add
Make_Mutably_Tagged_Conversion call where we construct a
Selected_Component node and the corresponding component type is
the internal representation type for a mutably tagged type.
(Stream_Base_Type): Return the mutably
tagged type if given the corresponding internal representation type.
* sem_ch3.adb (Array_Type_Declaration): In the case where the
source-level component type of an array type is mutably tagged,
set the Component_Type field of the base type of the declared
array type (as opposed to that of the first subtype of the array
type) to the corresponding internal representation type.
* sem_ch4.adb (Analyze_Selected_Component): In the case of a
selected component name which references a component whose type is
the internal representation type of a mutably tagged type,
generate a conversion to the mutably tagged type.

Diff:
---
 gcc/ada/exp_aggr.adb  |   5 +-
 gcc/ada/exp_attr.adb  | 404 ++
 gcc/ada/exp_ch4.adb   |  10 +-
 gcc/ada/exp_put_image.adb | 343 ++-
 gcc/ada/exp_strm.adb  |  35 ++--
 gcc/ada/sem_ch3.adb   |   2 +-
 gcc/ada/sem_ch4.adb   |   4 +
 7 files changed, 498 insertions(+), 305 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index bdb4c8556f2e..2f3bab44a786 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1422,8 +1422,11 @@ package body Exp_Aggr is
elsif Is_Mutably_Tagged_Type (Comp_Typ)
  and then Nkind (Expr) = N_Qualifi

[gcc r16-2401] ada: Add Unique_Component_Name function for use by CCG.

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:84468c33ffc2ce99678623693a98fcbdddf4ff47

commit r16-2401-g84468c33ffc2ce99678623693a98fcbdddf4ff47
Author: Steve Baird 
Date:   Fri Jun 27 13:41:51 2025 -0700

ada: Add Unique_Component_Name function for use by CCG.

Define a new function which, initially, is never called.
It is intended to be called from CCG. If an Ada tagged record type
has a component named Foo, then the generated corresponding C struct
might have a component with the same name. This approach almost works,
but breaks down in the (rare) case of an Ada record type where two or more
components have the same name (this is normally illegal, but is possible in
the case of an extension where some component of the parent type is not
visible at the point of the extension). This new function is intended for
use in coping with this case.

gcc/ada/ChangeLog:

* sem_aux.ads: Declare new function Unique_Component_Name.

* sem_aux.adb: Implement new function Unique_Component_Name.

Diff:
---
 gcc/ada/sem_aux.adb | 76 -
 gcc/ada/sem_aux.ads | 14 ++
 2 files changed, 89 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index bb1624da5b74..08ff0b11268b 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -25,7 +25,6 @@
 
 with Atree;  use Atree;
 with Einfo;  use Einfo;
-with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;use Einfo.Utils;
 with Nlists; use Nlists;
 with Sinfo;  use Sinfo;
@@ -1546,6 +1545,81 @@ package body Sem_Aux is
   return E;
end Ultimate_Alias;
 
+   ---
+   -- Unique_Component_Name --
+   ---
+
+   function Unique_Component_Name
+ (Component : Record_Field_Kind_Id) return Name_Id
+   is
+  Homographic_Component_Count : Pos := 1;
+  Hcc : Pos renames Homographic_Component_Count;
+  Enclosing_Type  : Entity_Id :=
+Underlying_Type (Base_Type (Scope (Component)));
+   begin
+  if Ekind (Enclosing_Type) = E_Record_Type
+and then Is_Tagged_Type (Enclosing_Type)
+and then Has_Private_Ancestor (Enclosing_Type)
+  then
+ --  traverse ancestors to determine Hcc value
+ loop
+declare
+   Type_Decl : constant Node_Id :=
+ Parent (Underlying_Type (Base_Type (Enclosing_Type)));
+   Type_Def : constant Node_Id := Type_Definition (Type_Decl);
+begin
+   exit when Nkind (Type_Def) /= N_Derived_Type_Definition;
+   Enclosing_Type :=
+ Underlying_Type (Base_Type (Etype (Enclosing_Type)));
+
+   declare
+  Ancestor_Comp : Opt_Record_Field_Kind_Id :=
+First_Component_Or_Discriminant (Enclosing_Type);
+   begin
+  while Present (Ancestor_Comp) loop
+ if Chars (Ancestor_Comp) = Chars (Component) then
+Hcc := Hcc + 1;
+exit; -- exit not required, but might as well
+ end if;
+ Next_Component_Or_Discriminant (Ancestor_Comp);
+  end loop;
+   end;
+end;
+ end loop;
+  end if;
+
+  if Hcc = 1 then
+ --  the usual case
+ return Chars (Component);
+  else
+ declare
+Buff : Bounded_String;
+ begin
+Append (Buff, Chars (Component));
+
+Append (Buff, "__");
+--  A double underscore in an identifier is legal in C, not in Ada.
+--  Returning a result that is not a legal Ada identifier
+--  ensures that we won't have problems with collisions.
+--  If we have a component named Foo and we just append a
+--  number (without any underscores), that new name might match
+--  the name of another component (which would be bad).
+--  The result of this function is intended for use as an
+--  identifier in generated C code, so it needs to be a
+--  legal C identifer.
+
+Append (Buff, Hcc);
+--  Should we instead append Hcc - 1 here? This is a human
+--  readability question. If parent type and extension each
+--  have a Foo component, do we want the name returned for the
+--  second Foo to be "foo__2" or "foo__1" ? Does it matter?
+--  Either way, the name returned for the first Foo will be "foo".
+
+return Name_Find (Buff);
+ end;
+  end if;
+   end Unique_Component_Name;
+
--
-- Unit_Declaration_Node --
--
diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index aad5d324efec..1a298a9a33fb 100644
--- a

[gcc r16-2403] ada: Capacity determination for container aggregate with container iterator

[Marc Poulhies via Gcc-cvs]

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

commit r16-2403-g2bcb3683f3b468dae3cd586db95ceb234cf6c98f
Author: Gary Dismukes 
Date:   Wed Jul 2 21:49:39 2025 +

ada: Capacity determination for container aggregate with container iterator

In the case of a container aggregate that has a 
container_element_association
given by an iterator_specification that iterates over a container object
(for example, "[for E of V => E]"), the compiler will now determine the
number of elements in the object and can use that in determining the 
capacity
value to be passed to the container type's Empty function when allocating
space for the aggregate object.  This implementation-dependent behavior
is allowed by RM22 4.3.5(40/5).

Prior to this enhancement, the compiler would generally use the Empty
function's default value for the Capacity parameter (a value of just
10 in the current implementation of the predefined containers), which
could easily lead to Capacity_Error being raised for the aggregate.

Note that this is only done for aggregates of container types coming
from instantiations of the predefined container generics, and not for
user-defined container types (due to the special knowledge the compiler
has of the availability of Length functions for the predefined types).
Also, it currently only applies when the object V being iterated over
is a simple object, and is not done for more complex cases, such as
when V is a function call.

gcc/ada/ChangeLog:

* exp_aggr.adb (Build_Size_Expr): Determine the length of a 
container
aggregate association in the case where it's an iteration over an
object of a container type coming from an instantiation of a 
predefined
container generic. Minor updates to existing comments.

Diff:
---
 gcc/ada/exp_aggr.adb | 92 +---
 1 file changed, 87 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 2f3bab44a786..5b9be1e9a965 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6732,6 +6732,7 @@ package body Exp_Aggr is
   function Build_Size_Expr (Comp : Node_Id) return Node_Id is
  Lo, Hi   : Node_Id;
  It   : Node_Id;
+ It_Subt  : Entity_Id;
  Siz_Exp  : Node_Id := Empty;
  Choice   : Node_Id;
  Temp_Siz_Exp : Node_Id;
@@ -6806,20 +6807,22 @@ package body Exp_Aggr is
  elsif Nkind (Comp) = N_Iterated_Component_Association then
 if Present (Iterator_Specification (Comp)) then
 
-   --  If the static size of the iterable object is known,
+   --  If the size of the iterable object can be determined,
--  attempt to return it.
 
It := Name (Iterator_Specification (Comp));
Preanalyze (It);
 
-   --  Handle the simplest cases for now where It denotes an array
-   --  object.
+   It_Subt := Etype (It);
+
+   --  Handle the simplest cases for now, where It denotes an array
+   --  object or a container object.
 
if Nkind (It) in N_Identifier
- and then Ekind (Etype (It)) = E_Array_Subtype
+ and then Ekind (It_Subt) = E_Array_Subtype
then
   declare
- Idx_N : Node_Id := First_Index (Etype (It));
+ Idx_N : Node_Id := First_Index (It_Subt);
  Siz_Exp : Node_Id := Empty;
   begin
  while Present (Idx_N) loop
@@ -6853,6 +6856,85 @@ package body Exp_Aggr is
 
  return Siz_Exp;
   end;
+
+   --  Case of iterating over a container object. Note that this
+   --  must be a simple object, and not something like a function
+   --  call (which might have side effects, and we wouldn't want
+   --  it to be evaluated more than once). We take advantage of
+   --  RM22 4.3.5(40/5), which allows implementation-defined
+   --  behavior for the parameter passed to the Empty function,
+   --  and here use the container Length function when available.
+   --  Class-wide objects are also excluded, since those would
+   --  lead to dispatching, which could call a user-defined
+   --  overriding of Length that might have arbitrary effects.
+
+   elsif Is_Entity_Name (It)
+ and then Is_Object (Entity (It))
+ and then Ekind (It_Subt) in Record_Kind
+ and then not Is_Class_Wide_Type (It_Subt)
+   then
+  declare
+ It_Base  : constant Entity_Id := Base_Type (It_Subt);
+ Empty_For

[gcc r16-2405] ada: Fix wrong indirect access to bit-packed array in iterated loop

[Marc Poulhies via Gcc-cvs]

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

commit r16-2405-gb14337e3777ac4525ceedd5df3decb63fc271604
Author: Eric Botcazou 
Date:   Wed Jul 2 15:25:55 2025 +0200

ada: Fix wrong indirect access to bit-packed array in iterated loop

This comes from a missing expansion of the bit-packed array reference in
the loop, because the actual subtype created for the dereference lacks a
Packed_Array_Impl_Type as it is ultimately created by the Preanalyze_Range
call present in Analyze_Loop_Statement.

gcc/ada/ChangeLog:

* sem_util.adb (Get_Actual_Subtype): Only create a new subtype when
the expander is active.  Remove a useless test of type inequality,
as well as a useless call to Set_Has_Delayed_Freeze on the subtype.

Diff:
---
 gcc/ada/sem_util.adb | 60 ++--
 1 file changed, 21 insertions(+), 39 deletions(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 40bc6339fd9a..d1d2537c6d68 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10061,16 +10061,19 @@ package body Sem_Util is
and then not Has_Unknown_Discriminants (Utyp)
and then not (Ekind (Utyp) = E_String_Literal_Subtype)
   then
- --  Nothing to do if in spec expression (why not???)
+ --  If the type has no discriminants, there is no subtype to build,
+ --  even if the underlying type is discriminated.
 
- if In_Spec_Expression then
+ if Is_Private_Type (Typ) and then not Has_Discriminants (Typ) then
 return Typ;
 
- elsif Is_Private_Type (Typ) and then not Has_Discriminants (Typ) then
-
---  If the type has no discriminants, there is no subtype to
---  build, even if the underlying type is discriminated.
+ --  If we are performing preanalysis on a conjured-up copy of a name
+ --  (see calls to Preanalyze_Range in sem_ch5.adb) then we don't want
+ --  to freeze Atyp, now or ever. In this case, the tree we eventually
+ --  pass to the back end should contain no references to Atyp (and a
+ --  freeze node would contain such a reference).
 
+ elsif not Expander_Active then
 return Typ;
 
  --  Else build the actual subtype
@@ -10086,42 +10089,21 @@ package body Sem_Util is
 
 Atyp := Defining_Identifier (Decl);
 
---  If Build_Actual_Subtype generated a new declaration then use it
-
-if Atyp /= Typ then
-
-   --  The actual subtype is an Itype, so analyze the declaration,
-   --  but do not attach it to the tree, to get the type defined.
-
-   Set_Parent (Decl, N);
-   Set_Is_Itype (Atyp);
-   Analyze (Decl, Suppress => All_Checks);
-   Set_Associated_Node_For_Itype (Atyp, N);
-   if Expander_Active then
-  Set_Has_Delayed_Freeze (Atyp, False);
-
-  --  We need to freeze the actual subtype immediately. This is
-  --  needed because otherwise this Itype will not get frozen
-  --  at all; it is always safe to freeze on creation because
-  --  any associated types must be frozen at this point.
+--  The actual subtype is an Itype, so analyze the declaration
+--  after attaching it to the tree, to get the type defined.
 
-  --  On the other hand, if we are performing preanalysis on
-  --  a conjured-up copy of a name (see calls to
-  --  Preanalyze_Range in sem_ch5.adb) then we don't want
-  --  to freeze Atyp, now or ever. In this case, the tree
-  --  we eventually pass to the back end should contain no
-  --  references to Atyp (and a freeze node would contain
-  --  such a reference). That's why Expander_Active is tested.
+Set_Parent (Decl, N);
+Set_Is_Itype (Atyp);
+Analyze (Decl, Suppress => All_Checks);
+Set_Associated_Node_For_Itype (Atyp, N);
 
-  Freeze_Itype (Atyp, N);
-   end if;
-   return Atyp;
-
---  Otherwise we did not build a declaration, so return original
+--  We need to freeze the actual subtype immediately. This is
+--  needed because otherwise this Itype will not get frozen
+--  at all; it is always safe to freeze on creation because
+--  any associated types must be frozen at this point.
 
-else
-   return Typ;
-end if;
+Freeze_Itype (Atyp, N);
+return Atyp;
  end if;
 
   --  For all remaining cases, the actual subtype is the same as

[gcc r16-2402] ada: exp_util.adb: prevent infinite loop in case of broken code

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:83219c97fabc1c0a8e0c42ad3d023706b8132827

commit r16-2402-g83219c97fabc1c0a8e0c42ad3d023706b8132827
Author: Ghjuvan Lacambre 
Date:   Wed Jul 2 09:11:03 2025 +0200

ada: exp_util.adb: prevent infinite loop in case of broken code

A recent commit modified exp_util.adb in order to fix the selection of
Finalize subprograms in the case of untagged objects.
This introduced regressions for GNATSAS in fixedbugs by causing
GNAT2SCIL to loop over the same type over and over in case of broken
code.
We fix this by simply checking that the loop is making progress, and if
it doesn't, assume that we're done.

gcc/ada/ChangeLog:

* exp_util.adb (Finalize_Address): Prevent infinite loop

Diff:
---
 gcc/ada/exp_util.adb | 9 +++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2172ce75709e..80e9a8101166 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6191,12 +6191,17 @@ package body Exp_Util is
 
  else
 declare
-   Root : constant Entity_Id := Underlying_Type (Root_Type (Btyp));
+   Root  : constant Entity_Id :=
+ Underlying_Type (Root_Type (Btyp));
+   Prev_Utyp : Entity_Id := Empty;
 begin
if Is_Protected_Type (Root) then
   Utyp := Corresponding_Record_Type (Root);
else
-  while No (TSS (Utyp, TSS_Finalize_Address)) loop
+  while No (TSS (Utyp, TSS_Finalize_Address))
+and then Utyp /= Prev_Utyp
+  loop
+ Prev_Utyp := Utyp;
  Utyp := Underlying_Type (Base_Type (Etype (Utyp)));
   end loop;
end if;

[gcc r16-2404] ada: Replace "not Present" test with "No" test

[Marc Poulhies via Gcc-cvs]

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

commit r16-2404-g9ffa0e4301deccce77cc377e27fa510736bb1fb7
Author: Gary Dismukes 
Date:   Wed Jul 2 21:57:57 2025 +

ada: Replace "not Present" test with "No" test

Minor change to satisfy GNAT SAS checker.

gcc/ada/ChangeLog:

* exp_aggr.adb (Build_Size_Expr): Change test of "not Present (...)"
to "No (...)".

Diff:
---
 gcc/ada/exp_aggr.adb | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 5b9be1e9a965..987db2a5d813 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6918,8 +6918,7 @@ package body Exp_Aggr is
   and then
 Present (First_Entity (Length_Subp))
   and then
-not Present
-  (Next_Entity (First_Entity (Length_Subp)))
+No (Next_Entity (First_Entity (Length_Subp)))
   and then
 Base_Type
   (Etype (First_Entity (Length_Subp))) = It_Base

[gcc r16-2417] ada: Add destructors extension

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:45e5196e8bfafe9af99f63109f9e6273763c02a8

commit r16-2417-g45e5196e8bfafe9af99f63109f9e6273763c02a8
Author: Ronan Desplanques 
Date:   Wed Jul 9 12:59:08 2025 +0200

ada: Add destructors extension

This patch adds a GNAT-specific extension which enables "destructors".
Destructors are an optional replacement for Ada.Finalization where some
aspects of the interaction with type derivation are different.

gcc/ada/ChangeLog:

* doc/gnat_rm/gnat_language_extensions.rst: Document new extension.
* snames.ads-tmpl: Add name for new aspect.
* gen_il-fields.ads (Has_Destructor, Is_Destructor): Add new fields.
* gen_il-gen-gen_entities.adb (E_Procedure, Type_Kind): Add new 
fields.
* einfo.ads (Has_Destructor, Is_Destructor): Document new fields.
* aspects.ads: Add new aspect.
* sem_ch13.adb (Analyze_Aspect_Specifications,
Check_Aspect_At_Freeze_Point, Check_Aspect_At_End_Of_Declarations):
Add semantic analysis for new aspect.
(Resolve_Finalization_Procedure): New function.
(Resolve_Finalizable_Argument): Use new function above.
* sem_util.adb (Propagate_Controlled_Flags): Extend for new field.
* freeze.adb (Freeze_Entity): Add legality check for new aspect.
* exp_ch3.adb (Expand_Freeze_Record_Type, 
Predefined_Primitive_Bodies):
Use new field.
* exp_ch7.adb (Build_Finalize_Statements): Add expansion for
destructors.
(Make_Final_Call, Build_Record_Deep_Procs): Adapt to new 
Has_Destructor
field.
(Build_Adjust_Statements): Tweak to handle cases of empty lists.
* gnat_rm.texi: Regenerate.

Diff:
---
 gcc/ada/aspects.ads  |   6 +
 gcc/ada/doc/gnat_rm/gnat_language_extensions.rst |  68 +++
 gcc/ada/einfo.ads|  21 +++-
 gcc/ada/exp_ch3.adb  |  34 +++---
 gcc/ada/exp_ch7.adb  | 132 ++
 gcc/ada/freeze.adb   |  29 +
 gcc/ada/gen_il-fields.ads|   2 +
 gcc/ada/gen_il-gen-gen_entities.adb  |   2 +
 gcc/ada/gnat_rm.texi | 138 +--
 gcc/ada/sem_ch13.adb | 138 +++
 gcc/ada/sem_util.adb |   4 +
 gcc/ada/snames.ads-tmpl  |   1 +
 12 files changed, 478 insertions(+), 97 deletions(-)

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 6d37ec7bf2ae..737f15136062 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -92,6 +92,7 @@ package Aspects is
   Aspect_Default_Value,
   Aspect_Depends,   -- GNAT
   Aspect_Designated_Storage_Model,  -- GNAT
+  Aspect_Destructor,-- GNAT
   Aspect_Dimension, -- GNAT
   Aspect_Dimension_System,  -- GNAT
   Aspect_Dispatching_Domain,
@@ -294,6 +295,7 @@ package Aspects is
   Aspect_CUDA_Global=> True,
   Aspect_Depends=> True,
   Aspect_Designated_Storage_Model   => True,
+  Aspect_Destructor => True,
   Aspect_Dimension  => True,
   Aspect_Dimension_System   => True,
   Aspect_Disable_Controlled => True,
@@ -448,6 +450,7 @@ package Aspects is
   Aspect_Default_Value  => Expression,
   Aspect_Depends=> Expression,
   Aspect_Designated_Storage_Model   => Name,
+  Aspect_Destructor => Name,
   Aspect_Dimension  => Expression,
   Aspect_Dimension_System   => Expression,
   Aspect_Dispatching_Domain => Expression,
@@ -552,6 +555,7 @@ package Aspects is
   Aspect_Default_Value=> True,
   Aspect_Depends  => False,
   Aspect_Designated_Storage_Model => True,
+  Aspect_Destructor   => False,
   Aspect_Dimension=> False,
   Aspect_Dimension_System => False,
   Aspect_Dispatching_Domain   => False,
@@ -727,6 +731,7 @@ package Aspects is
   Aspect_Default_Value=> Name_Default_Value,
   Aspect_Depends  => Name_Depends,
   Aspect_Designated_Storage_Model => Name_Designated_Storage_Model,
+  Aspect_Destructor   => Name_Destructor,
   Aspect_Dimension=> Name_Dimension,
   Aspect_Dimension_System => Name_Dimension_System,
   Aspect_Disable_Controlled   => Name_Disable_Controlled,
@@ -995,6 +1000,7 @@ package Aspects is
   Aspect_Default_Value=> Always_Delay,
   As

[gcc r16-2420] ada: Nested use_type_clause with "all" cancels use_type_clause with wider scope

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:585ade15412ae056c5ee17c046ae6316ca5d23c1

commit r16-2420-g585ade15412ae056c5ee17c046ae6316ca5d23c1
Author: Gary Dismukes 
Date:   Fri Jul 11 23:30:18 2025 +

ada: Nested use_type_clause with "all" cancels use_type_clause with wider 
scope

The compiler mishandles nested use_type_clauses in the case where the
outer one is a normal use_type_clause and the inner one has "all".
Upon leaving the scope of the inner use_type_clause, the outer one
is effectively disabled, because it's not considered redundant (and
in fact it's only partially redundant). This is fixed by testing for
the presence of a use_type_clause for the same type that has a wider
scope when ending the inner use_type_clause.

gcc/ada/ChangeLog:

* sem_ch8.adb (End_Use_Type): Add a test for there not being an 
earlier
use_type_clause for the same type as an additional criterion for 
turning
off In_Use and Current_Use_Clause.

Diff:
---
 gcc/ada/sem_ch8.adb | 10 +-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 54066b4f23ea..e6ef65860d63 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5444,7 +5444,15 @@ package body Sem_Ch8 is
  elsif In_Open_Scopes (Scope (Base_Type (T))) then
 null;
 
- elsif not Redundant_Use (Id) then
+ --  Turn off the use_type_clause on the type unless the clause is
+ --  redundant, or there's a previous use_type_clause. (The case where
+ --  a use_type_clause without "all" is followed by one with "all" in
+ --  a more nested scope is not considered redundant, necessitating
+ --  the test for a previous clause. One might expect the latter test
+ --  to suffice, but it turns out there are cases where Redundant_Use
+ --  is set, but Prev_Use_Clause is not set. ???)
+
+ elsif not Redundant_Use (Id) and then No (Prev_Use_Clause (N)) then
 Set_In_Use (T, False);
 Set_In_Use (Base_Type (T), False);
 Set_Current_Use_Clause (T, Empty);

[gcc r16-2416] ada: Fix crash when creating extra formals for aliased types

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:3289f1a374481d85c01f2db30201ea815624e612

commit r16-2416-g3289f1a374481d85c01f2db30201ea815624e612
Author: Denis Mazzucato 
Date:   Wed Jul 9 12:03:53 2025 +0200

ada: Fix crash when creating extra formals for aliased types

This patch makes sure that we return the same decision for all aliased
types when checking if the BIP task extra actuals are needed.

gcc/ada/ChangeLog:

* sem_ch6.adb (Might_Need_BIP_Task_Actuals): Before retrieving the 
original corresponding
operation we retrieve first the root of the aliased chain.

Diff:
---
 gcc/ada/sem_ch6.adb | 7 ---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index ce5b800e48c9..709f6254b5ec 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8684,17 +8684,18 @@ package body Sem_Ch6 is
  then
 Subp_Id := Protected_Body_Subprogram (E);
 
- --  For access to subprogram types we look at the return type of the
+ --  For access-to-subprogram types we look at the return type of the
  --  subprogram type itself, as it cannot be overridden or inherited.
 
  elsif Ekind (E) = E_Subprogram_Type then
 Subp_Id := E;
 
  --  Otherwise, we need to return the same value we would return for
- --  the original corresponding operation.
+ --  the original corresponding operation of the root of the aliased
+ --  chain.
 
  else
-Subp_Id := Original_Corresponding_Operation (E);
+Subp_Id := Original_Corresponding_Operation (Ultimate_Alias (E));
  end if;
 
  Original := Underlying_Type (Etype (Subp_Id));

[gcc r16-2408] ada: Tune recent change for bit-packed arrays to help GNATprove backend

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:918adccdf1f85273e016452c8da6f6b241496cb8

commit r16-2408-g918adccdf1f85273e016452c8da6f6b241496cb8
Author: Piotr Trojanek 
Date:   Fri Jul 4 11:52:46 2025 +0200

ada: Tune recent change for bit-packed arrays to help GNATprove backend

When GNAT is operating in GNATprove_Mode the Expander_Active flag is 
disabled,
but we still must do things that ordinary backends expect.

gcc/ada/ChangeLog:

* sem_util.adb (Get_Actual_Subtype): Do the same for GCC and 
GNATprove
backends.

Diff:
---
 gcc/ada/sem_util.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d1d2537c6d68..4c289c251f04 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10073,7 +10073,7 @@ package body Sem_Util is
  --  pass to the back end should contain no references to Atyp (and a
  --  freeze node would contain such a reference).
 
- elsif not Expander_Active then
+ elsif not (Expander_Active or GNATprove_Mode) then
 return Typ;
 
  --  Else build the actual subtype

[gcc r16-2413] ada: Wrong dispatch on result in presence of dependent expression

[Marc Poulhies via Gcc-cvs]

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

commit r16-2413-g4de3be28bab44350548cb559b61f69cc040b4016
Author: Javier Miranda 
Date:   Mon May 12 18:46:11 2025 +

ada: Wrong dispatch on result in presence of dependent expression

The compiler generates wrong code in a dispatching call on result
when the call is performed under dependent conditional expressions
or case-expressions.

gcc/ada/ChangeLog:

* sinfo.ads (Is_Expanded_Dispatching_Call): New flag.
(Tag_Propagated): New flag.
* exp_ch6.adb (Expand_Call_Helper): Propagate the tag when
the dispatching call is placed in conditionl expressions or
case-expressions.
* sem_ch5.adb (Analyze_Assignment): For assignment of tag-
indeterminate expression, do not propagate the tag if
previously done.
* sem_disp.adb (Is_Tag_Indeterminate): Add missing support
for conditional expression and case expression.
* exp_disp.ads (Is_Expanded_Dispatching_Call): Removed. Function
replaced by a new flag in the nodes.
* exp_disp.adb (Expand_Dispatching_Call): Set a flag in the
call node to remember that the call has been expanded.
(Is_Expanded_Dispatching_Call): Function removed.
* gen_il-fields.ads (Tag_Propagated): New flag.
(Is_Expanded_Dispatching_Call): New flag.
* gen_il-gen-gen_nodes.adb (Tag_Propagated): New flag.
(Is_Expanded_Dispatching_Call): New flag.

Diff:
---
 gcc/ada/exp_ch6.adb  | 49 
 gcc/ada/exp_disp.adb | 15 +++-
 gcc/ada/exp_disp.ads |  3 ---
 gcc/ada/gen_il-fields.ads|  2 ++
 gcc/ada/gen_il-gen-gen_nodes.adb |  9 ++--
 gcc/ada/sem_ch5.adb  |  9 +++-
 gcc/ada/sem_disp.adb | 47 ++
 gcc/ada/sinfo.ads| 36 +
 8 files changed, 127 insertions(+), 43 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 81686abbad81..1195582aaeab 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4756,27 +4756,34 @@ package body Exp_Ch6 is
   then
  declare
 Ass : Node_Id := Empty;
+Par : Node_Id := Parent (Call_Node);
 
  begin
-if Nkind (Parent (Call_Node)) = N_Assignment_Statement then
-   Ass := Parent (Call_Node);
+--  Search for the LHS of an enclosing assignment statement to a
+--  classwide type object (if present) and propagate the tag to
+--  this function call.
+
+while Nkind (Par) in N_Case_Expression
+   | N_Case_Expression_Alternative
+   | N_Explicit_Dereference
+   | N_If_Expression
+   | N_Qualified_Expression
+   | N_Unchecked_Type_Conversion
+loop
+   if Nkind (Par) = N_Case_Expression_Alternative then
+  Par := Parent (Par);
+   end if;
 
-elsif Nkind (Parent (Call_Node)) = N_Qualified_Expression
-  and then Nkind (Parent (Parent (Call_Node))) =
-  N_Assignment_Statement
-then
-   Ass := Parent (Parent (Call_Node));
+   exit when not Is_Tag_Indeterminate (Par);
 
-elsif Nkind (Parent (Call_Node)) = N_Explicit_Dereference
-  and then Nkind (Parent (Parent (Call_Node))) =
-  N_Assignment_Statement
-then
-   Ass := Parent (Parent (Call_Node));
-end if;
+   Par := Parent (Par);
+end loop;
 
-if Present (Ass)
-  and then Is_Class_Wide_Type (Etype (Name (Ass)))
+if Nkind (Par) = N_Assignment_Statement
+  and then Is_Class_Wide_Type (Etype (Name (Par)))
 then
+   Ass := Par;
+
--  Move the error messages below to sem???
 
if Is_Access_Type (Etype (Call_Node)) then
@@ -4789,6 +4796,12 @@ package body Exp_Ch6 is
  Call_Node, Root_Type (Etype (Name (Ass;
   else
  Propagate_Tag (Name (Ass), Call_Node);
+
+ --  Remember that the tag has been propagated to avoid
+ --  propagating it again, as part of the (bottom-up)
+ --  analysis of the enclosing assignment.
+
+ Set_Tag_Propagated (Name (Ass));
   end if;
 
elsif Etype (Call_Node) /= Root_Type (Etype (Name (Ass))) then
@@ -4799,6 +4812,12 @@ package body Exp_Ch6 is
 
else
  

[gcc r16-2419] ada: Only fold array attributes in SPARK when prefix is safe to evaluate

[Marc Poulhies via Gcc-cvs]

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

commit r16-2419-gbeb6c12a41738f6cf4a1305be6518a0955a55123
Author: Piotr Trojanek 
Date:   Thu Jul 10 12:35:47 2025 +0200

ada: Only fold array attributes in SPARK when prefix is safe to evaluate

Fix missing checks for prefixes of array attributes in GNATprove mode.

gcc/ada/ChangeLog:

* sem_attr.adb (Eval_Attribute): Only fold array attributes when 
prefix
is static or at least safe to evaluate

Diff:
---
 gcc/ada/sem_attr.adb | 42 ++
 1 file changed, 42 insertions(+)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 960294447172..f38380c381f6 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -9359,6 +9359,20 @@ package body Sem_Attr is
   when Attribute_First =>
  Set_Bounds;
 
+ --  In GNATprove mode we only fold array attributes when prefix is
+ --  static (because that's required by the Ada rules) or at least can
+ --  be evaluated without checks (because GNATprove would miss them).
+
+ if GNATprove_Mode
+and then
+  not (Static
+   or else (Is_Entity_Name (P) and then Is_Type (Entity (P)))
+   or else Statically_Names_Object (P)
+   or else Ekind (P_Type) = E_String_Literal_Subtype)
+ then
+return;
+ end if;
+
  if Compile_Time_Known_Value (Lo_Bound) then
 if Is_Real_Type (P_Type) then
Fold_Ureal (N, Expr_Value_R (Lo_Bound), Static);
@@ -9572,6 +9586,20 @@ package body Sem_Attr is
   when Attribute_Last =>
  Set_Bounds;
 
+ --  In GNATprove mode we only fold array attributes when prefix is
+ --  static (because that's required by the Ada rules) or at least can
+ --  be evaluated without checks (because GNATprove would miss them).
+
+ if GNATprove_Mode
+and then
+  not (Static
+   or else (Is_Entity_Name (P) and then Is_Type (Entity (P)))
+   or else Statically_Names_Object (P)
+   or else Ekind (P_Type) = E_String_Literal_Subtype)
+ then
+return;
+ end if;
+
  if Compile_Time_Known_Value (Hi_Bound) then
 if Is_Real_Type (P_Type) then
Fold_Ureal (N, Expr_Value_R (Hi_Bound), Static);
@@ -9655,6 +9683,20 @@ package body Sem_Attr is
 
  Set_Bounds;
 
+ --  In GNATprove mode we only fold array attributes when prefix is
+ --  static (because that's required by the Ada rules) or at least can
+ --  be evaluated without checks (because GNATprove would miss them).
+
+ if GNATprove_Mode
+and then
+  not (Static
+   or else (Is_Entity_Name (P) and then Is_Type (Entity (P)))
+   or else Statically_Names_Object (P)
+   or else Ekind (P_Type) = E_String_Literal_Subtype)
+ then
+return;
+ end if;
+
  --  For two compile time values, we can compute length
 
  if Compile_Time_Known_Value (Lo_Bound)

[gcc r16-2415] ada: Fix generation of Initialize and Adjust calls

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:6037cf8093eff77aa094ee759b3f3f02f31b9776

commit r16-2415-g6037cf8093eff77aa094ee759b3f3f02f31b9776
Author: Ronan Desplanques 
Date:   Wed Jul 9 10:19:00 2025 +0200

ada: Fix generation of Initialize and Adjust calls

Before this patch, Make_Init_Call and Make_Adjust_Call made the
assumption that if the type they were called with was untagged and a
derived type, it was the untagged private view of a tagged type. That
assumption made it possible to inspect the root type's primitives to
handle the case where the underlying type was implicitly generated by
the compiler without all inherited primitives.

The introduction of the Finalizable aspect broke that assumption, so
this patch adds a new field to type entities that make the generated
full view stand out, and updates Make_Init_Call and Make_Adjust_Call to
only jump to the root type when they're passed one of those generated
types.

Make_Final_Call and Finalize_Address are two other subprograms that
perform the same test on the types they're passed. They did not suffer
from the same bug as Make_Init_Call and Make_Adjust_Call because of an
earlier, more ad hoc fix, but this patch switches them over to the newly
introduced mechanism for the sake of consistency.

gcc/ada/ChangeLog:

* gen_il-fields.ads (Is_Implicit_Full_View): New field.
* gen_il-gen-gen_entities.adb (Type_Kind): Use new field.
* einfo.ads (Is_Implicit_Full_View): Document new field.
* exp_ch7.adb (Make_Adjust_Call, Make_Init_Call, Make_Final_Call): 
Use
new field.
* exp_util.adb (Finalize_Address): Likewise.
* sem_ch3.adb (Copy_And_Build): Set new field.

Diff:
---
 gcc/ada/einfo.ads   |  4 
 gcc/ada/exp_ch7.adb | 24 +---
 gcc/ada/exp_util.adb| 23 ++-
 gcc/ada/gen_il-fields.ads   |  1 +
 gcc/ada/gen_il-gen-gen_entities.adb |  1 +
 gcc/ada/sem_ch3.adb | 20 +++-
 6 files changed, 36 insertions(+), 37 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 11e3dd0254e4..b23cd9e8c27c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2787,6 +2787,10 @@ package Einfo is
 --   identifiers in standard library packages, and to implement the
 --   restriction No_Implementation_Identifiers.
 
+--Is_Implicit_Full_View
+--   Defined in types. Set on types that the compiler generates to act as
+--   full views of types that are derivations of private types.
+
 --Is_Imported
 --   Defined in all entities. Set if the entity is imported. For now we
 --   only allow the import of exceptions, functions, procedures, packages,
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 5d406a3416a2..9b88491d58f1 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -5601,7 +5601,10 @@ package body Exp_Ch7 is
 
   --  Deal with untagged derivation of private views
 
-  if Present (Utyp) and then Is_Untagged_Derivation (Typ) then
+  if Present (Utyp)
+and then Is_Untagged_Derivation (Typ)
+and then Is_Implicit_Full_View (Utyp)
+  then
  Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
  Ref  := Unchecked_Convert_To (Utyp, Ref);
  Set_Assignment_OK (Ref);
@@ -7909,16 +7912,12 @@ package body Exp_Ch7 is
   if Is_Untagged_Derivation (Typ) then
  if Is_Protected_Type (Typ) then
 Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
+ elsif Is_Implicit_Full_View (Utyp) then
+Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
 
- else
-declare
-   Root : constant Entity_Id :=
- Underlying_Type (Root_Type (Base_Type (Typ)));
-begin
-   if Is_Protected_Type (Root) then
-  Utyp := Corresponding_Record_Type (Root);
-   end if;
-end;
+if Is_Protected_Type (Utyp) then
+   Utyp := Corresponding_Record_Type (Utyp);
+end if;
  end if;
 
  Ref := Unchecked_Convert_To (Utyp, Ref);
@@ -8483,7 +8482,10 @@ package body Exp_Ch7 is
 
   --  Deal with untagged derivation of private views
 
-  if Is_Untagged_Derivation (Typ) and then not Is_Conc then
+  if Is_Untagged_Derivation (Typ)
+and then not Is_Conc
+and then Is_Implicit_Full_View (Utyp)
+  then
  Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
  Ref  := Unchecked_Convert_To (Utyp, Ref);
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 769e0c01c243..5a6fca081a69 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6189,23 +6189,12 @@ package body Exp_Util is
  if Is_Protected_Type (Btyp) then
 Utyp := Correspondi

[gcc r16-2414] ada: Remove obsolete code from Safe_Unchecked_Type_Conversion

[Marc Poulhies via Gcc-cvs]

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

commit r16-2414-g6a3abaf005f3d21eb261bd052d97dde2a87428e8
Author: Eric Botcazou 
Date:   Tue Jul 8 21:40:44 2025 +0200

ada: Remove obsolete code from Safe_Unchecked_Type_Conversion

That's a kludge added to work around the limitations of the stack checking
mechanism used in the early days.

gcc/ada/ChangeLog:

* exp_util.ads (May_Generate_Large_Temp): Delete.
* exp_util.adb (May_Generate_Large_Temp): Likewise.
(Safe_Unchecked_Type_Conversion): Do not take stack checking into
account to compute the result.

Diff:
---
 gcc/ada/exp_util.adb | 35 ---
 gcc/ada/exp_util.ads | 10 --
 2 files changed, 45 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index ac49c6b38267..769e0c01c243 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11741,34 +11741,6 @@ package body Exp_Util is
   end if;
end Matching_Standard_Type;
 
-   -
-   -- May_Generate_Large_Temp --
-   -
-
-   --  At the current time, the only types that we return False for (i.e. where
-   --  we decide we know they cannot generate large temps) are ones where we
-   --  know the size is 256 bits or less at compile time, and we are still not
-   --  doing a thorough job on arrays and records.
-
-   function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean is
-   begin
-  if not Size_Known_At_Compile_Time (Typ) then
- return False;
-  end if;
-
-  if Known_Esize (Typ) and then Esize (Typ) <= 256 then
- return False;
-  end if;
-
-  if Is_Array_Type (Typ)
-and then Present (Packed_Array_Impl_Type (Typ))
-  then
- return May_Generate_Large_Temp (Packed_Array_Impl_Type (Typ));
-  end if;
-
-  return True;
-   end May_Generate_Large_Temp;
-
---
-- Move_To_Initialization_Statements --
---
@@ -13872,14 +13844,7 @@ package body Exp_Util is
   --  known size, but we can't consider them that way here, because we are
   --  talking about the actual size of the object.
 
-  --  We also make sure that in addition to the size being known, we do not
-  --  have a case which might generate an embarrassingly large temp in
-  --  stack checking mode.
-
   elsif Size_Known_At_Compile_Time (Otyp)
-and then
-  (not Stack_Checking_Enabled
-or else not May_Generate_Large_Temp (Otyp))
 and then not (Is_Record_Type (Otyp) and then not Is_Constrained (Otyp))
   then
  return True;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index b8b752523c3c..4226fcc93777 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -1064,16 +1064,6 @@ package Exp_Util is
--  typically return Standard_Short_Integer. For fixed-point types, this
--  will return integer types of the corresponding size.
 
-   function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean;
-   --  Determines if the given type, Typ, may require a large temporary of the
-   --  kind that causes back-end trouble if stack checking is enabled. The
-   --  result is True only the size of the type is known at compile time and
-   --  large, where large is defined heuristically by the body of this routine.
-   --  The purpose of this routine is to help avoid generating troublesome
-   --  temporaries that interfere with stack checking mechanism. Note that the
-   --  caller has to check whether stack checking is actually enabled in order
-   --  to guide the expansion (typically of a function call).
-
procedure Move_To_Initialization_Statements (Decl, Stop : Node_Id);
--  Decl is an N_Object_Declaration node and Stop is a node past Decl in
--  the same list. Move all the nodes on the list between Decl and Stop

[gcc r16-2418] ada: Fix minor issues in comments

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:69bbc3a2b3fbd9ab632b1c581d0e51a7a5758bac

commit r16-2418-g69bbc3a2b3fbd9ab632b1c581d0e51a7a5758bac
Author: Ronan Desplanques 
Date:   Fri Jul 11 09:05:57 2025 +0200

ada: Fix minor issues in comments

gcc/ada/ChangeLog:

* einfo.ads (Is_Controlled_Active): Fix pasto in comment.
* sem_util.ads (Propagate_Controlled_Flags): Update comment for
Destructor aspect.

Diff:
---
 gcc/ada/einfo.ads|  2 +-
 gcc/ada/sem_util.ads | 10 +-
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 225f0fa0fccf..916d9c6f47c9 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2529,7 +2529,7 @@ package Einfo is
 --Is_Controlled_Active [base type only]
 --   Defined in all type entities. Indicates that the type is controlled,
 --   i.e. has been declared with the Finalizable or the Destructor aspect
---   or has inherited the this aspect from an ancestor. Can only be set for
+--   or has inherited the aspect from an ancestor. Can only be set for
 --   record types, tagged or untagged.
 --   System.Finalization_Root.Root_Controlled is an example of the former
 --   case while Ada.Finalization.Controlled and
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 943af8b5b142..4554f2423e19 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2977,11 +2977,11 @@ package Sem_Util is
   Comp : Boolean := False;
   Deriv: Boolean := False);
--  Set Disable_Controlled, Finalize_Storage_Only, Has_Controlled_Component,
-   --  Has_Relaxed_Finalization, and Is_Controlled_Active on Typ when the flags
-   --  are set on From_Typ. If Comp is True, From_Typ is assumed to be the type
-   --  of a component of Typ while, if Deriv is True, From_Typ is assumed to be
-   --  the parent type of Typ. This procedure can only set flags for Typ, and
-   --  never clear them.
+   --  Has_Destructor, Has_Relaxed_Finalization, and Is_Controlled_Active on
+   --  Typ when the flags are set on From_Typ. If Comp is True, From_Typ is
+   --  assumed to be the type of a component of Typ while, if Deriv is True,
+   --  From_Typ is assumed to be the parent type of Typ. This procedure can
+   --  only set flags for Typ, and never clear them.
 
procedure Propagate_DIC_Attributes
  (Typ  : Entity_Id;

[gcc r16-2411] ada: Fix assertion failure on aggregate with controlled component

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:06728901a03376bdeafc3ff48115113a0ffe169e

commit r16-2411-g06728901a03376bdeafc3ff48115113a0ffe169e
Author: Eric Botcazou 
Date:   Tue Jul 8 11:05:19 2025 +0200

ada: Fix assertion failure on aggregate with controlled component

The assertion is:

  pragma Assert (Side_Effect_Free (L));

in Make_Tag_Ctrl_Assignment and demonstrates that the sequence:

  Remove_Side_Effects (L);
  pragma Assert (Side_Effect_Free (L));

does not hold in this case.

What happens is that Remove_Side_Effects uses a renaming to remove the side
effects of L but, at the end, the renamed object is substituted back for the
renamed object in the node by Expand_Renaming, which is invoked because the
Is_Renaming_Of_Object flag is set on the renaming after Evaluate_Name has
been invoked on its Name.

This is a general discrepancy between Evaluate_Name and Side_Effect_Free of
Exp_Util, coming from the call to Safe_Unchecked_Type_Conversion present in
Side_Effect_Free in this case.  The long term goal is probably to remove the
call but, in the meantime, this change is sufficient to fix the failure.

gcc/ada/ChangeLog:

* exp_util.adb (Safe_Unchecked_Type_Conversion): Always return True
if the expression is the prefix of an N_Selected_Component.

Diff:
---
 gcc/ada/exp_util.adb | 13 -
 1 file changed, 4 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 80e9a8101166..ac49c6b38267 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13771,11 +13771,12 @@ package body Exp_Util is
--  The above requirements should be documented in Sinfo ???
 
function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean is
+  Pexp : constant Node_Id := Parent (Exp);
+
   Otyp   : Entity_Id;
   Ityp   : Entity_Id;
   Oalign : Uint;
   Ialign : Uint;
-  Pexp   : constant Node_Id := Parent (Exp);
 
begin
   --  If the expression is the RHS of an assignment or object declaration
@@ -13793,18 +13794,12 @@ package body Exp_Util is
  return True;
 
   --  If the expression is the prefix of an N_Selected_Component we should
-  --  also be OK because GCC knows to look inside the conversion except if
-  --  the type is discriminated. We assume that we are OK anyway if the
-  --  type is not set yet or if it is controlled since we can't afford to
-  --  introduce a temporary in this case.
+  --  also be OK because GCC knows to look inside the conversion.
 
   elsif Nkind (Pexp) = N_Selected_Component
 and then Prefix (Pexp) = Exp
   then
- return No (Etype (Pexp))
-   or else not Is_Type (Etype (Pexp))
-   or else not Has_Discriminants (Etype (Pexp))
-   or else Is_Constrained (Etype (Pexp));
+ return True;
   end if;
 
   --  Set the output type, this comes from Etype if it is set, otherwise we

[gcc r16-2412] ada: Additional condition for Capacity discriminant on bounded container aggregates

[Marc Poulhies via Gcc-cvs]

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

commit r16-2412-gcdbd7946acc884901c06ec40162e47923d941f12
Author: Gary Dismukes 
Date:   Mon Jul 7 20:59:18 2025 +

ada: Additional condition for Capacity discriminant on bounded container 
aggregates

This change test an additional condition as part of the criteria used
for deciding whether to generate a call to a container type's Length
function (for passing to the Empty function) when determining the
size of the object to allocate for a bounded container aggregate
with a "for of" iterator.

An update is also made to function Empty in 
Ada.Containers.Bounded_Hash_Maps,
adding a default to the formal Capacity, to make it consistent with other
bounded containers (and to make it conformant with the Ada RM).

gcc/ada/ChangeLog:

* libgnat/a-cbhama.ads (Empty): Add missing default to Capacity 
formal.
* libgnat/a-cbhama.adb (Empty): Add missing default to Capacity 
formal.
* exp_aggr.adb (Build_Size_Expr): Test for presence of Capacity
discriminant as additional criterion for generating the call to
the Length function. Update comments.

Diff:
---
 gcc/ada/exp_aggr.adb | 42 +++---
 gcc/ada/libgnat/a-cbhama.adb |  2 +-
 gcc/ada/libgnat/a-cbhama.ads |  2 +-
 3 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 987db2a5d813..9458bdea6633 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6874,6 +6874,7 @@ package body Exp_Aggr is
  and then not Is_Class_Wide_Type (It_Subt)
then
   declare
+ Aggr_Base: constant Entity_Id := Base_Type (Typ);
  It_Base  : constant Entity_Id := Base_Type (It_Subt);
  Empty_Formal : constant Entity_Id :=
   First_Formal (Entity (Empty_Subp));
@@ -6886,16 +6887,27 @@ package body Exp_Aggr is
  --  generally have a Length function. User-defined
  --  containers don't necessarily have such a function,
  --  or it may be named differently, or it may have
- --  the wrong semantics. The base subtype is tested,
- --  since its Sloc will refer to the original container
- --  generic in the predefined library, even though it's
- --  declared in a package instantiation within the current
- --  library unit. Also, this is only done when Empty_Subp
- --  has a formal parameter (usually named Capacity), and
- --  not in the case of a parameterless Empty function.
-
- if In_Predefined_Unit (It_Base)
-   and then Present (Empty_Formal)
+ --  the wrong semantics. The base subtypes are tested,
+ --  since their Sloc will refer to the original container
+ --  generics in the predefined library, even though the
+ --  types are declared in a package instantiation in some
+ --  other unit. Also, this is only done when Empty_Subp
+ --  has a formal parameter (generally named Capacity),
+ --  and not in the case of a parameterless Empty function.
+ --  Finally, we test for the container aggregate's type
+ --  having a first discriminant with the name Capacity,
+ --  since determining capacity via Length is only sensible
+ --  for container types with that discriminant (bounded
+ --  containers).
+
+ if Present (Empty_Formal)
+   and then In_Predefined_Unit (It_Base)
+   and then In_Predefined_Unit (Aggr_Base)
+   and then Has_Discriminants (Aggr_Base)
+   and then
+ Get_Name_String
+   (Chars (First_Discriminant (Aggr_Base)))
+   = "capacity"
  then
 --  Look for the container type's Length function in
 --  the package where it's defined.
@@ -6907,11 +6919,11 @@ package body Exp_Aggr is
 Pop_Scope;
 
 --  If we found a Length function that has a single
---  parameter of the container type, then expand a call
---  to that, passing the container object named in the
---  iterator_specification, and return that call, which
---  will be used as the "size" of the current aggregate
---  element a

[gcc r16-2434] testsuite: Fix overflow in gcc.dg/vect/pr116125.c

[Siddhesh Poyarekar via Gcc-cvs]

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

commit r16-2434-g96d5aef307025a771ae4ef47a9b382ef20eb06c4
Author: Siddhesh Poyarekar 
Date:   Mon Jul 21 06:43:20 2025 +0530

testsuite: Fix overflow in gcc.dg/vect/pr116125.c

The test ends up writing a byte beyond bounds of the buffer, which gets
trapped on some targets when the test is run with
-fstack-protector-strong.

gcc/testsuite/ChangeLog:

* gcc.dg/vect/pr116125.c (mem_overlap): Expand A to 10 members.

Signed-off-by: Siddhesh Poyarekar 

Diff:
---
 gcc/testsuite/gcc.dg/vect/pr116125.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/testsuite/gcc.dg/vect/pr116125.c 
b/gcc/testsuite/gcc.dg/vect/pr116125.c
index eab9efdc061b..1b882ec4002b 100644
--- a/gcc/testsuite/gcc.dg/vect/pr116125.c
+++ b/gcc/testsuite/gcc.dg/vect/pr116125.c
@@ -17,12 +17,12 @@ main (void)
 {
   check_vect ();
 
-  struct st a[9] = {};
+  struct st a[10] = {};
 
-  // input a = 0, 0, 0, 0, 0, 0, 0, 0, 0
+  // input a = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
   mem_overlap (&a[1], a);
 
-  // output a = 0, 1, 2, 3, 4, 5, 6, 7, 8
+  // output a = 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
   if (a[2].num == 2)
 return 0;
   else

[gcc r15-10057] testsuite: Fix overflow in gcc.dg/vect/pr116125.c

[Siddhesh Poyarekar via Gcc-cvs]

https://gcc.gnu.org/g:156c3ee6a9095c5ec6fc10d837fe3ae2291ad8a8

commit r15-10057-g156c3ee6a9095c5ec6fc10d837fe3ae2291ad8a8
Author: Siddhesh Poyarekar 
Date:   Mon Jul 21 06:43:20 2025 +0530

testsuite: Fix overflow in gcc.dg/vect/pr116125.c

The test ends up writing a byte beyond bounds of the buffer, which gets
trapped on some targets when the test is run with
-fstack-protector-strong.

gcc/testsuite/ChangeLog:

* gcc.dg/vect/pr116125.c (mem_overlap): Expand A to 10 members.

Signed-off-by: Siddhesh Poyarekar 
(cherry picked from commit 96d5aef307025a771ae4ef47a9b382ef20eb06c4)

Diff:
---
 gcc/testsuite/gcc.dg/vect/pr116125.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/testsuite/gcc.dg/vect/pr116125.c 
b/gcc/testsuite/gcc.dg/vect/pr116125.c
index eab9efdc061b..1b882ec4002b 100644
--- a/gcc/testsuite/gcc.dg/vect/pr116125.c
+++ b/gcc/testsuite/gcc.dg/vect/pr116125.c
@@ -17,12 +17,12 @@ main (void)
 {
   check_vect ();
 
-  struct st a[9] = {};
+  struct st a[10] = {};
 
-  // input a = 0, 0, 0, 0, 0, 0, 0, 0, 0
+  // input a = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
   mem_overlap (&a[1], a);
 
-  // output a = 0, 1, 2, 3, 4, 5, 6, 7, 8
+  // output a = 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
   if (a[2].num == 2)
 return 0;
   else

[gcc r16-2437] [aarch64] check for non-NULL vectype in aarch64_vector_costs::add_stmt_cost

[Richard Biener via Gcc-cvs]

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

commit r16-2437-g9a8d91219d65f7cb304b1d678957f95061bfe02b
Author: Richard Biener 
Date:   Tue Jul 22 15:04:16 2025 +0200

[aarch64] check for non-NULL vectype in aarch64_vector_costs::add_stmt_cost

With a patch still in development we get NULL STMT_VINFO_VECTYPE.
One side-effect is that during scalar stmt testing we no longer
pass a vectype.  The following adjusts aarch64_vector_costs::add_stmt_cost
to check for a non-NULL vectype before accessing it, like all the
code surrounding it.  The other fix possibility would have been
to re-orderr the check with the vect_mem_access_type one, but that
one is not going to exist during scalar code costing either in the
future.

* config/aarch64/aarch64.cc (aarch64_vector_costs::add_stmt_cost):
Check vectype is non-NULL before accessing it.

Diff:
---
 gcc/config/aarch64/aarch64.cc | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/config/aarch64/aarch64.cc b/gcc/config/aarch64/aarch64.cc
index 72a691b8e2f2..9e4a37bcaff0 100644
--- a/gcc/config/aarch64/aarch64.cc
+++ b/gcc/config/aarch64/aarch64.cc
@@ -17976,6 +17976,7 @@ aarch64_vector_costs::add_stmt_cost (int count, 
vect_cost_for_stmt kind,
 
   /* Check if we've seen an SVE gather/scatter operation and which size.  
*/
   if (kind == scalar_load
+ && vectype
  && aarch64_sve_mode_p (TYPE_MODE (vectype))
  && vect_mem_access_type (stmt_info, node) == VMAT_GATHER_SCATTER)
{

[gcc r16-2435] testsuite: Mark fn1 in pr81627.c as noinline [PR120101]

[Andrew Pinski via Gcc-cvs]

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

commit r16-2435-g2fda72d1315b72e9d43b05da2f260e5c59aaad41
Author: Andrew Pinski 
Date:   Tue Jul 22 22:11:29 2025 -0700

testsuite: Mark fn1 in pr81627.c as noinline [PR120101]

Since r16-372-g064cac730f88dc fn1 is now inlined into main
which meant the scan dump was failing since it was looking
for it only once. Marking fn1 as noinline gets us back to
the old behavior and no longer dependent on the inliner.

Pushed as obvious after a quick test.

PR testsuite/120101
gcc/testsuite/ChangeLog:

* gcc.dg/tree-ssa/pr81627.c (fn1): Mark as noinline.

Signed-off-by: Andrew Pinski 

Diff:
---
 gcc/testsuite/gcc.dg/tree-ssa/pr81627.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr81627.c 
b/gcc/testsuite/gcc.dg/tree-ssa/pr81627.c
index 9ba43be50525..ef35b298f40c 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/pr81627.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/pr81627.c
@@ -4,6 +4,7 @@
 int a, b, c, d[6], e = 3, f;
 
 void abort (void);
+void fn1 () __attribute__((noinline));
 void fn1 ()
 {
   for (b = 1; b < 5; b++)

[gcc(refs/users/meissner/heads/work216)] Update ChangeLog.*

[Michael Meissner via Gcc-cvs]

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

commit fbc7829c5ae473ca54b0b432c68b7c6696b57a8c
Author: Michael Meissner 
Date:   Tue Jul 22 20:48:04 2025 -0400

Update ChangeLog.*

Diff:
---
 gcc/ChangeLog.meissner | 60 ++
 1 file changed, 60 insertions(+)

diff --git a/gcc/ChangeLog.meissner b/gcc/ChangeLog.meissner
index db5d5a52836c..ef32c3a72e45 100644
--- a/gcc/ChangeLog.meissner
+++ b/gcc/ChangeLog.meissner
@@ -1,3 +1,63 @@
+ Branch work216, patch #1 
+
+Add support for -mcpu=future
+
+This patch adds the support that can be used in developing GCC support for
+future PowerPC processors.
+
+This support is done by adding support for CPU ISA bits that are set directly
+via the -mcpu= option, without having a -m bit.
+
+2025-07-22  Michael Meissner  
+
+gcc/
+
+   * config.gcc (powerpc*-*-*): Add support for configuration option
+   --with-cpu=future.
+   * config/rs6000/aix71.h (ASM_CPU_SPEC): Pass -mfuture to the assembler
+   if -mcpu=future was used.
+   * config/rs6000/aix72.h (ASM_CPU_SPEC): Likewise.
+   * config/rs6000/aix73.h (ASM_CPU_SPEC): Likewise.
+   * config/rs6000/driver-rs6000.cc (asm_names): Likewise.
+   * config/rs6000/rs6000-c.cc (rs6000_target_modify_macros): If
+   -mcpu=future, define _ARCH_FUTURE.  Add CPU ISA flag bit argument.
+   (rs6000_cpu_cpp_builtins): Likewise.
+   * config/rs6000/rs6000-cpus.def (FUTURE_MASKS_SERVER): New macro.
+   (RS6000_CPU_ISA): New optional macro.
+   (future cpu): Set up for -mcpu=future.
+   * config/rs6000/rs6000-opts.h (PROCESSOR_FUTURE): Define as
+   PROCESSOR_POWER11 for now.
+   * config/rs6000/rs6000-protos.h (rs6000_target_modify_macros): Add
+   argument for CPU ISA bits.
+   (CPU_ISA_MASK_FUTURE): New macro.
+   (rs6000_target_modify_macros_ptr): Likewise.
+   * config/rs6000/rs6000-tables.opt: Regenerate.
+   * config/rs6000/rs6000.cc (rs6000_target_modify_macros_ptr): Add
+   additional argument.
+   (rs6000_print_isa_options): Likewise.
+   (RS6000_CPU_ISA): New macro.
+   (DEBUG_FMT_WX): Update to print both isa flags and CPU isa flags.
+   (rs6000_debug_reg_global): Add support for CPU ISA options that are
+   set directly via -mcpu=, rather than having separate -m
+   arguments.
+   (rs6000_option_override_internal): Likewise.
+   (rs6000_coy_isa_masks): New list of CPU ISA options for debugging.
+   (rs6000_pragma_target_parse): Add support for CPU ISA options that are
+   set directly via -mcpu=, rather than having separate -m
+   arguments.
+   (rs6000_function_specific_print): Likewise.
+   (rs6000_print_options_internal): Likewise.
+   (rs6000_print_isa_options): Likewise.
+   * config/rs6000/rs6000.h (ASM_CPU_SPEC): Add support for -mcpu=future.
+   * config/rs6000/rs6000.opt (rs6000_cpu_isa_flags): New target global
+   variable.
+   (x_rs6000_cpu_isa_flags): Likewise.
+
+gcc/testsuite/
+
+   * gcc.target/powerpc/future-1.c: New test.
+   * gcc.target/powerpc/future-2.c: Likewise.
+
  Branch work216, baseline 
 
 2025-07-22   Michael Meissner  

[gcc(refs/users/meissner/heads/work216)] Add support for -mcpu=future

[Michael Meissner via Gcc-cvs]

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

commit c0acd26fd9875f014aa871297d5f6c6bc31c0e64
Author: Michael Meissner 
Date:   Tue Jul 22 20:46:04 2025 -0400

Add support for -mcpu=future

This patch adds the support that can be used in developing GCC support for
future PowerPC processors.

This support is done by adding support for CPU ISA bits that are set 
directly
via the -mcpu= option, without having a -m bit.

2025-07-22  Michael Meissner  

gcc/

* config.gcc (powerpc*-*-*): Add support for configuration option
--with-cpu=future.
* config/rs6000/aix71.h (ASM_CPU_SPEC): Pass -mfuture to the 
assembler
if -mcpu=future was used.
* config/rs6000/aix72.h (ASM_CPU_SPEC): Likewise.
* config/rs6000/aix73.h (ASM_CPU_SPEC): Likewise.
* config/rs6000/driver-rs6000.cc (asm_names): Likewise.
* config/rs6000/rs6000-c.cc (rs6000_target_modify_macros): If
-mcpu=future, define _ARCH_FUTURE.  Add CPU ISA flag bit argument.
(rs6000_cpu_cpp_builtins): Likewise.
* config/rs6000/rs6000-cpus.def (FUTURE_MASKS_SERVER): New macro.
(RS6000_CPU_ISA): New optional macro.
(future cpu): Set up for -mcpu=future.
* config/rs6000/rs6000-opts.h (PROCESSOR_FUTURE): Define as
PROCESSOR_POWER11 for now.
* config/rs6000/rs6000-protos.h (rs6000_target_modify_macros): Add
argument for CPU ISA bits.
(CPU_ISA_MASK_FUTURE): New macro.
(rs6000_target_modify_macros_ptr): Likewise.
* config/rs6000/rs6000-tables.opt: Regenerate.
* config/rs6000/rs6000.cc (rs6000_target_modify_macros_ptr): Add
additional argument.
(rs6000_print_isa_options): Likewise.
(RS6000_CPU_ISA): New macro.
(DEBUG_FMT_WX): Update to print both isa flags and CPU isa flags.
(rs6000_debug_reg_global): Add support for CPU ISA options that are
set directly via -mcpu=, rather than having separate -m
arguments.
(rs6000_option_override_internal): Likewise.
(rs6000_coy_isa_masks): New list of CPU ISA options for debugging.
(rs6000_pragma_target_parse): Add support for CPU ISA options that 
are
set directly via -mcpu=, rather than having separate -m
arguments.
(rs6000_function_specific_print): Likewise.
(rs6000_print_options_internal): Likewise.
(rs6000_print_isa_options): Likewise.
* config/rs6000/rs6000.h (ASM_CPU_SPEC): Add support for 
-mcpu=future.
* config/rs6000/rs6000.opt (rs6000_cpu_isa_flags): New target global
variable.
(x_rs6000_cpu_isa_flags): Likewise.

gcc/testsuite/

* gcc.target/powerpc/future-1.c: New test.
* gcc.target/powerpc/future-2.c: Likewise.

Diff:
---
 gcc/config.gcc  |   4 +-
 gcc/config/rs6000/aix71.h   |   1 +
 gcc/config/rs6000/aix72.h   |   1 +
 gcc/config/rs6000/aix73.h   |   1 +
 gcc/config/rs6000/driver-rs6000.cc  |   2 +
 gcc/config/rs6000/rs6000-c.cc   |  14 +++-
 gcc/config/rs6000/rs6000-cpus.def   |  24 +-
 gcc/config/rs6000/rs6000-opts.h |   4 +
 gcc/config/rs6000/rs6000-protos.h   |   5 +-
 gcc/config/rs6000/rs6000-tables.opt |  11 ++-
 gcc/config/rs6000/rs6000.cc | 118 +---
 gcc/config/rs6000/rs6000.h  |   7 ++
 gcc/config/rs6000/rs6000.opt|   8 ++
 gcc/testsuite/gcc.target/powerpc/future-1.c |  13 +++
 gcc/testsuite/gcc.target/powerpc/future-2.c |  24 ++
 15 files changed, 194 insertions(+), 43 deletions(-)

diff --git a/gcc/config.gcc b/gcc/config.gcc
index 8ed111392bb4..23143bf46b40 100644
--- a/gcc/config.gcc
+++ b/gcc/config.gcc
@@ -533,7 +533,7 @@ powerpc*-*-*)
extra_headers="${extra_headers} ppu_intrinsics.h spu2vmx.h vec_types.h 
si2vmx.h"
extra_headers="${extra_headers} amo.h"
case x$with_cpu in
-   
xpowerpc64|xdefault64|x6[23]0|x970|xG5|xpower[3456789]|xpower1[01]|xpower6x|xrs64a|xcell|xa2|xe500mc64|xe5500|xe6500)
+   
xpowerpc64|xdefault64|x6[23]0|x970|xG5|xpower[3456789]|xpower1[01]|xpower6x|xrs64a|xcell|xa2|xe500mc64|xe5500|xe6500|xfuture)
cpu_is_64bit=yes
;;
esac
@@ -5694,7 +5694,7 @@ case "${target}" in
tm_defines="${tm_defines} CONFIG_PPC405CR"
eval "with_$which=405"
;;
-   "" | common | native \
+   "" | common | native | future \
| power[3456789] | power1[01] | power5+ | power6x \
| po

[gcc r16-2436] middle-end/121216 - ICE with VLA const string initializer

[Richard Biener via Gcc-cvs]

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

commit r16-2436-g6acf9501771b8a26643fe6b887eb2d9b6d008b47
Author: Richard Biener 
Date:   Tue Jul 22 15:41:20 2025 +0200

middle-end/121216 - ICE with VLA const string initializer

constant_byte_string fails to consider the string type might be VLA
when initialized by an empty string CTOR.

PR middle-end/121216
* expr.cc (constant_byte_string): Check the string type
size fits an uhwi before converting to uhwi.

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

Diff:
---
 gcc/expr.cc | 2 ++
 gcc/testsuite/gcc.dg/pr121216.c | 9 +
 2 files changed, 11 insertions(+)

diff --git a/gcc/expr.cc b/gcc/expr.cc
index ac4fdfaa2181..3f2b121ee038 100644
--- a/gcc/expr.cc
+++ b/gcc/expr.cc
@@ -13206,6 +13206,8 @@ constant_byte_string (tree arg, tree *ptr_offset, tree 
*mem_size, tree *decl,
 of the expected type and size.  */
  if (!initsize)
initsize = integer_zero_node;
+ else if (!tree_fits_uhwi_p (initsize))
+   return NULL_TREE;
 
  unsigned HOST_WIDE_INT size = tree_to_uhwi (initsize);
  if (size > (unsigned HOST_WIDE_INT) INT_MAX)
diff --git a/gcc/testsuite/gcc.dg/pr121216.c b/gcc/testsuite/gcc.dg/pr121216.c
new file mode 100644
index ..a695b40d12dc
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr121216.c
@@ -0,0 +1,9 @@
+/* { dg-do compile } */
+/* { dg-options "" } */
+
+int foo (void)
+{
+const char *key = "obscurelevelofabstraction";
+const char reverse_key[__builtin_strlen(key)] = {'\0'}; /* { dg-error 
"variable-sized object may not be initialized except with an empty initializer" 
} */
+return __builtin_strlen(reverse_key);
+}

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

[Mikael Morin via Gcc-cvs]

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

 29e382e1a33f... Extraction gfc_set_gfc_from_cfi

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement fonctions descripteur vers fichier séparé

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:519145540dd7aa59f6c95571a8f45363e6906cba

commit 519145540dd7aa59f6c95571a8f45363e6906cba
Author: Mikael Morin 
Date:   Wed Jun 18 17:31:23 2025 +0200

Déplacement fonctions descripteur vers fichier séparé

Suppression déclarations trans-array.h

Inclusion trans-descriptor.h

Correction en-têtes

Suppression declaration gfc_array_data_ptr_type

Ajout commentaires

Diff:
---
 gcc/fortran/Make-lang.in|   7 +-
 gcc/fortran/trans-array.cc  | 509 +
 gcc/fortran/trans-array.h   |  35 ---
 gcc/fortran/trans-decl.cc   |   1 +
 gcc/fortran/trans-descriptor.cc | 547 
 gcc/fortran/trans-descriptor.h  |  87 +++
 gcc/fortran/trans-expr.cc   |   1 +
 gcc/fortran/trans-intrinsic.cc  |   1 +
 gcc/fortran/trans-io.cc |   1 +
 gcc/fortran/trans-openmp.cc |   1 +
 gcc/fortran/trans-stmt.cc   |   1 +
 gcc/fortran/trans.cc|   1 +
 12 files changed, 647 insertions(+), 545 deletions(-)

diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 5b2f921bf2ef..2ddb0366e9dc 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -63,9 +63,10 @@ F95_PARSER_OBJS = fortran/arith.o fortran/array.o 
fortran/bbt.o \
 F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \
 fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
 fortran/trans.o fortran/trans-array.o fortran/trans-common.o \
-fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \
-fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
-fortran/trans-stmt.o fortran/trans-types.o fortran/frontend-passes.o
+fortran/trans-const.o fortran/trans-decl.o fortran/trans-descriptor.o \
+fortran/trans-expr.o fortran/trans-intrinsic.o fortran/trans-io.o \
+fortran/trans-openmp.o fortran/trans-stmt.o fortran/trans-types.o \
+fortran/frontend-passes.o
 
 fortran_OBJS = $(F95_OBJS) fortran/gfortranspec.o
 
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8cabfa99649b..31ed8546488b 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 "trans-descriptor.h"
 
 static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
 
@@ -106,466 +107,6 @@ gfc_array_dataptr_type (tree desc)
   return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
 }
 
-/* Build expressions to access members of the CFI descriptor.  */
-#define CFI_FIELD_BASE_ADDR 0
-#define CFI_FIELD_ELEM_LEN 1
-#define CFI_FIELD_VERSION 2
-#define CFI_FIELD_RANK 3
-#define CFI_FIELD_ATTRIBUTE 4
-#define CFI_FIELD_TYPE 5
-#define CFI_FIELD_DIM 6
-
-#define CFI_DIM_FIELD_LOWER_BOUND 0
-#define CFI_DIM_FIELD_EXTENT 1
-#define CFI_DIM_FIELD_SM 2
-
-static tree
-gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
-{
-  tree type = TREE_TYPE (desc);
-  gcc_assert (TREE_CODE (type) == RECORD_TYPE
- && TYPE_FIELDS (type)
- && (strcmp ("base_addr",
-IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type
- == 0));
-  tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
-  gcc_assert (field != NULL_TREE);
-
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- desc, field, NULL_TREE);
-}
-
-tree
-gfc_get_cfi_desc_base_addr (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
-}
-
-tree
-gfc_get_cfi_desc_elem_len (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
-}
-
-tree
-gfc_get_cfi_desc_version (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
-}
-
-tree
-gfc_get_cfi_desc_rank (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
-}
-
-tree
-gfc_get_cfi_desc_type (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
-}
-
-tree
-gfc_get_cfi_desc_attribute (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
-}
-
-static tree
-gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
-{
-  tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
-  tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
-  tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
-  gcc_assert (field != NULL_TREE);
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- tmp, field, NULL_TREE);
-}
-
-tree
-gfc_get_cfi_dim_lbound (tree desc, tree idx)
-{
-  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
-}
-
-tree
-gfc_get_cfi_dim_extent (tree desc, tree idx)
-{
-  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
-}
-
-tree
-gfc_get_cfi_dim_sm (tree desc, tree i

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_offset_{g, s}et

[Mikael Morin via Gcc-cvs]

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

commit dc774b94602f01249536d888945e8ca85291c6e7
Author: Mikael Morin 
Date:   Thu Jun 19 18:04:56 2025 +0200

Utilisation gfc_conv_descriptor_offset_{g,s}et

Correction pr43808

Correction gfc_conv_descriptor_offset

Utilisation gfc_conv_descriptor_offset_set

Suppression retour à la ligne inutile offset_set

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 31ed8546488b..185de0886feb 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8996,9 +8996,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
  new_field = gfc_conv_descriptor_dtype (new_desc);
  gfc_add_modify (&se->pre, new_field, old_field);
 
- old_field = gfc_conv_descriptor_offset (old_desc);
- new_field = gfc_conv_descriptor_offset (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
+ old_field = gfc_conv_descriptor_offset_get (old_desc);
+ gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field);
 
  for (int i = 0; i < expr->rank; i++)
{
@@ -11168,8 +11167,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
  gfc_index_zero_node);
}
 
-  tmp = gfc_conv_descriptor_offset (desc);
-  gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
+  gfc_conv_descriptor_offset_set (&loop_pre_block, desc,
+ gfc_index_zero_node);
 
   tmp = fold_build2_loc (input_location, EQ_EXPR,
 logical_type_node, array1,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4660130c4464..88bbacd08e30 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -215,8 +215,8 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree 
desc, tree value)
 }
 
 
-tree
-gfc_conv_descriptor_offset (tree desc)
+static tree
+get_descriptor_offset (tree desc)
 {
   tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
   gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
@@ -226,14 +226,13 @@ gfc_conv_descriptor_offset (tree desc)
 tree
 gfc_conv_descriptor_offset_get (tree desc)
 {
-  return gfc_conv_descriptor_offset (desc);
+  return get_descriptor_offset (desc);
 }
 
 void
-gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
-   tree value)
+gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
 {
-  tree t = gfc_conv_descriptor_offset (desc);
+  tree t = get_descriptor_offset (desc);
   gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
 }
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index ade63bf19751..36365ff32ae0 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -57,7 +57,6 @@ tree gfc_conv_descriptor_type (tree desc);
 tree gfc_get_descriptor_dimension (tree desc);
 tree gfc_conv_descriptor_dimension (tree desc, tree dim);
 tree gfc_conv_descriptor_token (tree desc);
-tree gfc_conv_descriptor_offset (tree desc);
 
 tree gfc_conv_descriptor_data_get (tree desc);
 tree gfc_conv_descriptor_offset_get (tree desc);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6e380db29bcc..81861f59ea74 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9592,8 +9592,8 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component 
* cm,
 
   /* Shift the lbound and ubound of temporaries to being unity,
  rather than zero, based. Always calculate the offset.  */
+  gfc_conv_descriptor_offset_set (&block, dest, gfc_index_zero_node);
   offset = gfc_conv_descriptor_offset_get (dest);
-  gfc_add_modify (&block, offset, gfc_index_zero_node);
   tmp2 =gfc_create_var (gfc_array_index_type, NULL);
 
   for (n = 0; n < expr->rank; n++)

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_dtype compil' OK

[Mikael Morin via Gcc-cvs]

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

commit 5e83783ce1baa086327f25204faac9c53e96a955
Author: Mikael Morin 
Date:   Sat Jun 28 23:09:22 2025 +0200

Suppression gfc_conv_descriptor_dtype compil' OK

Suppression non_lvalue dtype_get

Ajout location descriptor_dtype_set

Suppression variable inutilisée

Suppression retour à la ligne inutile dtype_set

Diff:
---
 gcc/fortran/trans-array.cc  | 98 +
 gcc/fortran/trans-decl.cc   |  6 ++-
 gcc/fortran/trans-descriptor.cc | 30 ++---
 gcc/fortran/trans-descriptor.h  |  4 +-
 gcc/fortran/trans-expr.cc   | 36 +++
 gcc/fortran/trans-intrinsic.cc  | 11 ++---
 gcc/fortran/trans-stmt.cc   |  5 +--
 7 files changed, 92 insertions(+), 98 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 185de0886feb..23e3a64d04c8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1186,9 +1186,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
   if (rank_changer)
{
  /* Take the dtype from the class expression.  */
- dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (pre, tmp, dtype);
+ tree class_descr = gfc_class_data_get (class_expr);
+ dtype = gfc_conv_descriptor_dtype_get (class_descr);
+ gfc_conv_descriptor_dtype_set (pre, desc, dtype);
+
 
  /* These transformational functions change the rank.  */
  tmp = gfc_conv_descriptor_rank (desc);
@@ -1210,8 +1211,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
   else
 {
   /* Fill in the array dtype.  */
-  tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  gfc_conv_descriptor_dtype_set (pre, desc,
+gfc_get_dtype (TREE_TYPE (desc)));
 }
 
   info->descriptor = desc;
@@ -5806,8 +5807,8 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   && VAR_P (expr->ts.u.cl->backend_decl))
 {
   type = gfc_typenode_for_spec (&expr->ts);
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+  gfc_conv_descriptor_dtype_set (pblock, descriptor,
+gfc_get_dtype_rank_type (rank, type));
 }
   else if (expr->ts.type == BT_CHARACTER
   && expr->ts.deferred
@@ -5828,14 +5829,12 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
 TREE_OPERAND (descriptor, 0), tmp, NULL_TREE);
   tmp = fold_convert (gfc_charlen_type_node, tmp);
   type = gfc_get_character_type_len (expr->ts.kind, tmp);
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+  gfc_conv_descriptor_dtype_set (pblock, descriptor,
+gfc_get_dtype_rank_type (rank, type));
 }
   else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
-{
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
-}
+gfc_conv_descriptor_dtype_set (pblock, descriptor,
+  gfc_conv_descriptor_dtype_get (expr3_desc));
   else if (expr->ts.type == BT_CLASS && !explicit_ts
   && expr3 && expr3->ts.type != BT_CLASS
   && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
@@ -5845,10 +5844,7 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
  fold_convert (TREE_TYPE (tmp), expr3_elem_size));
 }
   else
-{
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
-}
+gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
 
   or_expr = logical_false_node;
 
@@ -8241,7 +8237,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
  the offsets because all elements are within the array data.  */
 
   /* Set the dtype.  */
-  tmp = gfc_conv_descriptor_dtype (parm);
   if (se->unlimited_polymorphic)
dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
   else if (expr->ts.type == BT_ASSUMED)
@@ -8251,11 +8246,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
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);
+ dtype = gfc_conv_descriptor_dtype_get (tmp2);
}
   else
dtype = gfc_get_dtype (parmtype);
-  gfc_add_modif

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_data_addr

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:421d080b5909191c00ebffd11c6029ae09cd0275

commit 421d080b5909191c00ebffd11c6029ae09cd0275
Author: Mikael Morin 
Date:   Sat Jun 28 22:02:40 2025 +0200

Suppression gfc_conv_descriptor_data_addr

Diff:
---
 gcc/fortran/trans-decl.cc   |  5 ++---
 gcc/fortran/trans-descriptor.cc | 10 --
 gcc/fortran/trans-descriptor.h  |  1 -
 3 files changed, 2 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 9db5a50cbd4f..3d648b6a31a3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5135,8 +5135,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
  se.descriptor_only = 1;
  gfc_conv_expr (&se, e);
  descriptor = se.expr;
- se.expr = gfc_conv_descriptor_data_addr (se.expr);
- se.expr = build_fold_indirect_ref_loc (input_location, 
se.expr);
+ se.expr = gfc_conv_descriptor_data_get (se.expr);
}
  gfc_free_expr (e);
 
@@ -5340,7 +5339,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
continue;
   /* 'omp allocate( {purpose: allocator, value: align},
{purpose: init-stmtlist, value: cleanup-stmtlist},
-   {purpose: size-var, value: last-size-expr}}
+   {purpose: size-var, value: last-size-expr} )
  where init-stmt/cleanup-stmt is the STATEMENT list to find the
  try-final block; last-size-expr is to find the location after
  which to add the code and 'size-var' is for the proper size, cf.
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e8748aad7dcc..4660130c4464 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -215,16 +215,6 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree 
desc, tree 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)
-{
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
-  return gfc_build_addr_expr (NULL_TREE, field);
-}
-
 tree
 gfc_conv_descriptor_offset (tree desc)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 1dd9d3ed4f73..ade63bf19751 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -48,7 +48,6 @@ tree gfc_get_cfi_dim_extent (tree desc, tree idx);
 tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
-tree gfc_conv_descriptor_data_addr (tree desc);
 tree gfc_conv_descriptor_dtype (tree desc);
 tree gfc_conv_descriptor_rank (tree desc);
 tree gfc_conv_descriptor_version (tree desc);

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_data_set

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:40050dcd731b5350bfc133413aac793af7be40ad

commit 40050dcd731b5350bfc133413aac793af7be40ad
Author: Mikael Morin 
Date:   Wed Feb 12 10:47:31 2025 +0100

Utilisation gfc_conv_descriptor_data_set

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 403aa56bef02..9db5a50cbd4f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5143,10 +5143,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 2242c81f5620..f67c69e60f44 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1741,7 +1741,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
 {
@@ -1755,7 +1755,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_v08)] Prise en charge affichage TARGET_MEM_REF

[Mikael Morin via Gcc-cvs]

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

commit d6d43da9cf6c777a249c164a6df692bc5be68e32
Author: Mikael Morin 
Date:   Mon Jul 7 08:52:38 2025 +0200

Prise en charge affichage TARGET_MEM_REF

Diff:
---
 gcc/gimple-simulate.cc| 87 ---
 gcc/selftest-run-tests.cc |  2 ++
 gcc/selftest.h|  1 +
 3 files changed, 86 insertions(+), 4 deletions(-)

diff --git a/gcc/gimple-simulate.cc b/gcc/gimple-simulate.cc
index aa29b68b748c..a85e6f63cc92 100644
--- a/gcc/gimple-simulate.cc
+++ b/gcc/gimple-simulate.cc
@@ -903,6 +903,9 @@ static tree
 find_mem_ref_replacement (simul_scope & context, tree data_ref,
  unsigned offset, unsigned min_size)
 {
+  gcc_assert (TREE_CODE (data_ref) == MEM_REF
+ || TREE_CODE (data_ref) == TARGET_MEM_REF);
+
   tree ptr = TREE_OPERAND (data_ref, 0);
   data_value ptr_val = context.evaluate (ptr);
   if (ptr_val.classify () != VAL_ADDRESS)
@@ -923,12 +926,30 @@ find_mem_ref_replacement (simul_scope & context, tree 
data_ref,
 {
   tree access_offset = TREE_OPERAND (data_ref, 1);
   gcc_assert (TREE_CONSTANT (access_offset));
-  gcc_assert (tree_fits_shwi_p (access_offset));
-  HOST_WIDE_INT shwi_offset = tree_to_shwi (access_offset);
-  gcc_assert (offset < UINT_MAX - shwi_offset);
-  HOST_WIDE_INT remaining_offset = shwi_offset * CHAR_BIT
+  gcc_assert (tree_fits_uhwi_p (access_offset));
+  HOST_WIDE_INT uhwi_offset = tree_to_uhwi (access_offset);
+  gcc_assert (offset < UINT_MAX - uhwi_offset);
+  HOST_WIDE_INT remaining_offset = uhwi_offset * CHAR_BIT
   + offset + ptr_address->offset;
 
+  if (TREE_CODE (data_ref) == TARGET_MEM_REF)
+   {
+ tree idx = TREE_OPERAND (data_ref, 2);
+ data_value idx_val = context.evaluate (idx);
+ gcc_assert (idx_val.classify () == VAL_KNOWN);
+ wide_int wi_idx = idx_val.get_known ();
+
+ tree step = TREE_OPERAND (data_ref, 3);
+ data_value step_val = context.evaluate (step);
+ gcc_assert (step_val.classify () == VAL_KNOWN);
+ wide_int wi_step = step_val.get_known ();
+
+ wi_idx *= wi_step;
+ gcc_assert (wi::fits_uhwi_p (wi_idx));
+ HOST_WIDE_INT idx_offset = wi_idx.to_uhwi ();
+ remaining_offset += idx_offset * CHAR_BIT;
+   }
+
   return pick_subref_at (var_ref, remaining_offset, nullptr, min_size);
 }
 }
@@ -957,6 +978,7 @@ context_printer::print_first_data_ref_part (simul_scope & 
context,
   switch (TREE_CODE (data_ref))
 {
 case MEM_REF:
+case TARGET_MEM_REF:
   {
tree mem_replacement = find_mem_ref_replacement (context, data_ref,
 offset, min_size);
@@ -4432,6 +4454,63 @@ context_printer_print_value_update_tests ()
   printer9.print_value_update (ctx9, ref9, val9_addr_i);
   const char *str9 = pp_formatted_text (&pp9);
   ASSERT_STREQ (str9, "# v17c[8B:+8B] = &i\n");
+
+
+  heap_memory mem10;
+  context_printer printer10;
+  pretty_printer & pp10 = printer10.pp;
+  pp_buffer (&pp10)->m_flush_p = false;
+
+  tree a11c_10 = build_array_type_nelts (char_type_node, 11);
+  tree v11c_10 = create_var (a11c_10, "v11c");
+  tree p_10 = create_var (ptr_type_node, "p");
+  tree i_10 = create_var (size_type_node, "i");
+
+  vec decls10{};
+  decls10.safe_push (v11c_10);
+  decls10.safe_push (p_10);
+  decls10.safe_push (i_10);
+
+  context_builder builder10;
+  builder10.add_decls (&decls10);
+  simul_scope ctx10 = builder10.build (mem10, printer10);
+
+  data_storage *strg10_v11 = ctx10.find_reachable_var (v11c_10);
+  gcc_assert (strg10_v11 != nullptr);
+  storage_address addr10_v11 (strg10_v11->get_ref (), 0);
+
+  data_value val10_addr_v11 (ptr_type_node);
+  val10_addr_v11.set_address (addr10_v11);
+
+  data_storage *strg10_p = ctx10.find_reachable_var (p_10);
+  gcc_assert (strg10_p != nullptr);
+  strg10_p->set (val10_addr_v11);
+
+  data_value val10_cst_2 (size_type_node);
+  wide_int cst2_10 = wi::uhwi (2, TYPE_PRECISION (size_type_node));
+  val10_cst_2.set_known (cst2_10);
+
+  data_storage *strg10_i = ctx10.find_reachable_var (i_10);
+  gcc_assert (strg10_i != nullptr);
+  strg10_i->set (val10_cst_2);
+
+  tree int_ptr_10 = build_pointer_type (integer_type_node);
+
+  tree ref10 = build5 (TARGET_MEM_REF, integer_type_node, p_10,
+  build_int_cst (int_ptr_10, -4), i_10,
+  build_int_cst (size_type_node, 4), NULL_TREE);
+
+  data_value val10_cst_13 (integer_type_node);
+  wide_int wi10_13 = wi::shwi (13, TYPE_PRECISION (integer_type_node));
+  val10_cst_13.set_known (wi10_13);
+
+  printer10.print_value_update (ctx10, ref10, val10_cst_13);
+  const char *str10 = pp_formatted_text (&pp10);
+  ASSERT_STREQ (str10,
+   "# v11c[4] = 13\n"
+   "# v11c[5] = 0\n"
+   "# v11c[6] = 0\n"
+  

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] fortran: Factor array descriptor references

[Mikael Morin via Gcc-cvs]

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

commit 0d69c054403723908b6ea5175dec94d2f38f8fd4
Author: Mikael Morin 
Date:   Wed Jul 9 21:18:18 2025 +0200

fortran: Factor array descriptor references

Regression tested on x86_64-pc-linux-gnu.
OK for master?

-- >8 --

Save subexpressions of array descriptor references to variables, so that
all the expressions using the descriptor as base object benefit from a
simplified reference using the variables.

This limits the size of the expressions generated in the original tree
dump, easing analysis of the code involving those expressions.
This is especially helpful with chains of array references where each
array in the chain uses a descriptor.

After optimizations, the effect of the change shouldn't be visible in
the vast majority of cases.  In rare cases it seems to permit a couple
more jump threadings.

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_conv_ss_descriptor): Move the descriptor
expression initialisation...
(set_factored_descriptor_value): ... to this new function.
Before initialisation, walk the reference expression passed as
argument and save some of its subexpressions to a variable.
(substitute_t): New struct.
(maybe_substitute_expr): New function.
(substitute_subexpr_in_expr): New function.

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 fffa6db639b6..8cabfa99649b 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3622,7 +3622,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, 
int base)
   /* Also the data pointer.  */
   tmp = gfc_conv_array_data (se.expr);
   /* If this is a variable or address or a class array, use it directly.
- Otherwise we must evaluate it now to avoid breaking dependency
+Otherwise we must evaluate it now to avoid breaking dependency
 analysis by pulling the expressions for elemental array indices
 inside the loop.  */
   if (save_descriptor_data (se.expr, tmp) && !ss->is_alloc_lhs)

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Sauvegarde/restoration cfun

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:6566bd8e3fd99f7a73036233a697c152abfcd27e

commit 6566bd8e3fd99f7a73036233a697c152abfcd27e
Author: Mikael Morin 
Date:   Tue Jul 8 13:13:25 2025 +0200

Sauvegarde/restoration cfun

Correction bootstrap

Correction bootstrap

Correction bootstrap

Diff:
---
 gcc/gimple-simulate.cc | 8 
 1 file changed, 8 insertions(+)

diff --git a/gcc/gimple-simulate.cc b/gcc/gimple-simulate.cc
index a85e6f63cc92..09491076e95d 100644
--- a/gcc/gimple-simulate.cc
+++ b/gcc/gimple-simulate.cc
@@ -4720,7 +4720,9 @@ simul_scope_evaluate_tests ()
   DECL_CONTEXT (result) = func;
   DECL_RESULT (func) = result;
 
+  push_cfun (nullptr);
   init_lowered_empty_function (func, true, profile_count::one ());
+  pop_cfun ();
 
   tree def_var = create_var (integer_type_node, "def_var");
   DECL_CONTEXT (def_var) = func;
@@ -6482,8 +6484,10 @@ simul_scope_simulate_call_tests ()
   DECL_CONTEXT (result) = my_int_func;
   DECL_RESULT (my_int_func) = result;
 
+  push_cfun (nullptr);
   basic_block bb = init_lowered_empty_function (my_int_func, true,
profile_count::one ());
+  pop_cfun ();
   gimple_stmt_iterator gsi = gsi_last_bb (bb);
   greturn *ret_stmt = gimple_build_return (cst6);
   gsi_insert_after (&gsi, ret_stmt, GSI_CONTINUE_LINKING);
@@ -6534,8 +6538,10 @@ simul_scope_simulate_call_tests ()
   DECL_ARGUMENTS (int_func_with_arg) = arg;
   layout_decl (arg, 0);
 
+  push_cfun (nullptr);
   basic_block bb2 = init_lowered_empty_function (int_func_with_arg, true,
 profile_count::one ());
+  pop_cfun ();
   gimple_stmt_iterator gsi2 = gsi_last_bb (bb2);
   greturn *ret_stmt2 = gimple_build_return (arg);
   gsi_insert_after (&gsi2, ret_stmt2, GSI_CONTINUE_LINKING);
@@ -6618,7 +6624,9 @@ simul_scope_simulate_call_tests ()
   DECL_CONTEXT (void_result) = simple_func;
   DECL_RESULT (simple_func) = void_result;
 
+  push_cfun (nullptr);
   init_lowered_empty_function (simple_func, true, profile_count::one ());
+  pop_cfun ();
 
   gcall * simple_call = gimple_build_call (simple_func, 0);

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Ajout non_lvalue getters.

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:7354fc47f9e73a5826a3b2034c1562b192684eea

commit 7354fc47f9e73a5826a3b2034c1562b192684eea
Author: Mikael Morin 
Date:   Thu Jun 19 17:22:05 2025 +0200

Ajout non_lvalue getters.

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

Correction dump coarray_poly_8

Ajout non_lvalue dtype_get

This reverts commit 753122549b057ad97ad6f98e5baa26c81706c9d9.

Ajout non_lvalue elem_len_get

This reverts commit b06c027e636068042a85adc5e5675ac8c48eb26c.

Ajout non_lvalue version_get

This reverts commit 708a228bd25a37b2d9590efe44a7f42b3eab46ed.

Ajout non_lvalue rank_get

This reverts commit e0fe5e4c8610e6dc14297a697287742a0c56386d.

Ajout non_lvalue type_get

This reverts commit 2c3a1a854faf2d271ade37615d1c5d32b07cf897.

Ajout non_lvalue dimension_get

This reverts commit 5e36be306d1faf013d4493ed302de8701f9815f9.

Correction motif intrinsic_size_3

Correction motifs dumps coarray_lib_this_image_{1,2}

Correction format dump bind_c_array_params_2

Correction motif dump PR93963

Correction motif dump coarray_lock_7

Correction motifs dump gomp/depend-5

Correction motifs dump gomp/depend-4

Correction motifs dump gomp/depend-6

Mise à jour formats dump bind-c-contiguous-2

Correction motifs dump array_reference_3

Correction motifs dump coarray_lock_7

Annulation partielle

Diff:
---
 gcc/fortran/trans-descriptor.cc| 50 +-
 gcc/testsuite/gfortran.dg/PR93963.f90  |  2 +-
 gcc/testsuite/gfortran.dg/array_reference_3.f90| 10 ++---
 gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90  | 12 +++---
 .../gfortran.dg/bind_c_array_params_2.f90  |  4 +-
 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  |  6 +--
 .../gfortran.dg/coarray_lib_this_image_1.f90   |  2 +-
 .../gfortran.dg/coarray_lib_this_image_2.f90   |  2 +-
 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   | 16 +++
 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 +-
 gcc/testsuite/gfortran.dg/gomp/depend-4.f90| 24 +--
 gcc/testsuite/gfortran.dg/gomp/depend-5.f90| 12 +++---
 gcc/testsuite/gfortran.dg/gomp/depend-6.f90| 24 +--
 gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 |  2 +-
 26 files changed, 120 insertions(+), 112 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 0ac1660d21ad..3d7cbeb7f43a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -196,6 +196,13 @@ gfc_get_descriptor_field (tree desc, unsigned field_idx)
  desc, field, NULL_TREE);
 }
 
+
+static tree
+get_descriptor_data (tree desc)
+{
+  return gfc_get_descriptor_field (desc, DATA_FIELD);
+}
+
 /* This provides READ-ONLY access to the data field.  The field itself
doesn't have the proper type.  */
 
@@ -203,11 +210,12 @@ tree
 gfc_conv_descriptor_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_descriptor_data (desc);
+  tree target_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+  tree t = fold_convert (target_type, field);
+  return non_lvalue_loc (input_location, t);
 }
 
 /* This provides WRITE access to the data field.
@@ -237,7 +245,7 @@ get_descriptor_offset (tree desc)
 tree
 gfc_con

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_type compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:92c52aba353b417e031170df3204bb25e8fc69cb

commit 92c52aba353b417e031170df3204bb25e8fc69cb
Author: Mikael Morin 
Date:   Sun Jun 29 14:11:50 2025 +0200

Suppression gfc_conv_descriptor_type compil' OK

Correction régression PR97046

Suppression non_lvalue type_get

Ajout location set_type

Diff:
---
 gcc/fortran/trans-decl.cc   | 23 -
 gcc/fortran/trans-descriptor.cc | 71 +++--
 gcc/fortran/trans-descriptor.h  |  5 ++-
 gcc/fortran/trans-expr.cc   |  2 +-
 4 files changed, 80 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 5ed1a1b6fbd3..2996dd72e6aa 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7283,25 +7283,20 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID);
+  tmp2 = gfc_conv_descriptor_type_set (gfc_desc, 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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_DERIVED);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  tmp, tmp2);
   /* if (CFI_type_Character) BT_CHARACTER else  < tmp2 >  */
@@ -7310,8 +7305,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, 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 >  */
@@ -7323,16 +7317,14 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  tmp, 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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_COMPLEX);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  tmp, tmp2);
   /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real)
@@ -7350,8 +7342,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
 CFI_type_Real));
   cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_dimension compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:68da492392029a8f6ff01bbcfa3dfabc5d4706b6

commit 68da492392029a8f6ff01bbcfa3dfabc5d4706b6
Author: Mikael Morin 
Date:   Sun Jun 29 14:28:16 2025 +0200

Suppression gfc_conv_descriptor_dimension compil' OK

Suppression non_lvalue dimension_get

ajout location dimension_set

Diff:
---
 gcc/fortran/trans-array.cc  | 10 +-
 gcc/fortran/trans-descriptor.cc | 35 ---
 gcc/fortran/trans-descriptor.h  |  5 -
 3 files changed, 41 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b34c8c7bff01..02d6c68b45c5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8989,11 +8989,11 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
 
  for (int i = 0; i < expr->rank; i++)
{
- old_field = gfc_conv_descriptor_dimension (old_desc,
-   gfc_rank_cst[get_array_ref_dim_for_loop_dim (ss, i)]);
- new_field = gfc_conv_descriptor_dimension (new_desc,
-   gfc_rank_cst[i]);
- gfc_add_modify (&se->pre, new_field, old_field);
+ int idx = get_array_ref_dim_for_loop_dim (ss, i);
+ old_field = gfc_conv_descriptor_dimension_get (old_desc, idx);
+ gfc_conv_descriptor_dimension_set (&se->pre, new_desc, i,
+old_field);
+ 
}
 
  if (flag_coarray == GFC_FCOARRAY_LIB
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 2a59f7dfd13f..43cfce6f4411 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -469,8 +469,8 @@ gfc_get_descriptor_dimension (tree desc)
 }
 
 
-tree
-gfc_conv_descriptor_dimension (tree desc, tree dim)
+static tree
+get_descriptor_dimension (tree desc, tree dim)
 {
   tree tmp;
 
@@ -479,6 +479,35 @@ gfc_conv_descriptor_dimension (tree desc, tree dim)
   return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
 }
 
+tree
+gfc_conv_descriptor_dimension_get (tree desc, tree dim)
+{
+  return get_descriptor_dimension (desc, dim);
+}
+
+tree
+gfc_conv_descriptor_dimension_get (tree desc, int dim)
+{
+  return gfc_conv_descriptor_dimension_get (desc, gfc_rank_cst[dim]);
+}
+
+void
+gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, tree dim,
+  tree value)
+{
+  location_t loc = input_location;
+  tree t = get_descriptor_dimension (desc, dim);
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+void
+gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, int dim,
+  tree value)
+{
+  gfc_conv_descriptor_dimension_set (block, desc, gfc_rank_cst[dim], value);
+}
+
 
 tree
 gfc_conv_descriptor_token (tree desc)
@@ -494,7 +523,7 @@ gfc_conv_descriptor_token (tree desc)
 static tree
 gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
 {
-  tree tmp = gfc_conv_descriptor_dimension (desc, dim);
+  tree tmp = get_descriptor_dimension (desc, dim);
   tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
   gcc_assert (field != NULL_TREE);
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 69cc4f3e2ac6..0547157bf2af 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -49,7 +49,6 @@ tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
 tree gfc_get_descriptor_dimension (tree desc);
-tree gfc_conv_descriptor_dimension (tree desc, tree dim);
 tree gfc_conv_descriptor_token (tree desc);
 
 tree gfc_conv_descriptor_data_get (tree desc);
@@ -61,6 +60,8 @@ tree gfc_conv_descriptor_rank_get (tree desc);
 tree gfc_conv_descriptor_type_get (tree desc);
 tree gfc_conv_descriptor_span_get (tree desc);
 
+tree gfc_conv_descriptor_dimension_get (tree desc, tree dim);
+tree gfc_conv_descriptor_dimension_get (tree desc, int dim);
 tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
 tree gfc_conv_descriptor_lbound_get (tree desc, tree dim);
 tree gfc_conv_descriptor_ubound_get (tree desc, tree dim);
@@ -77,6 +78,8 @@ void gfc_conv_descriptor_type_set (stmtblock_t *block, tree 
desc, tree value);
 tree gfc_conv_descriptor_type_set (tree desc, tree value);
 tree gfc_conv_descriptor_type_set (tree desc, int value);
 void gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value);
+void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, tree 
dim, tree value);
+void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, int 
dim, tree value);
 void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void g

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_token_set

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:9167d2a88480777dc3dbe70d667bddfc4f179d8a

commit 9167d2a88480777dc3dbe70d667bddfc4f179d8a
Author: Mikael Morin 
Date:   Tue Jul 15 17:17:33 2025 +0200

Utilisation gfc_conv_descriptor_token_set

Diff:
---
 gcc/fortran/trans-array.cc  | 12 +---
 gcc/fortran/trans-descriptor.cc | 10 ++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc   | 12 +---
 gcc/fortran/trans-intrinsic.cc  |  3 +--
 5 files changed, 22 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 02d6c68b45c5..acf643f6adbd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8365,7 +8365,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
  tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
}
 
- gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp);
+ gfc_conv_descriptor_token_set (&loop.pre, parm, tmp);
}
   desc = parm;
 }
@@ -8974,7 +8974,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
}
  else if (!ctree)
{
- tree old_field, new_field;
+ tree old_field;
 
  /* The original descriptor has transposed dims so we can't reuse
 it directly; we have to create a new one.  */
@@ -9002,8 +9002,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
 == GFC_ARRAY_ALLOCATABLE)
{
  old_field = gfc_conv_descriptor_token (old_desc);
- new_field = gfc_conv_descriptor_token (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
+ gfc_conv_descriptor_token_set (&se->pre, new_desc,
+old_field);
}
 
  gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
@@ -11839,9 +11839,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
 image.  This may happen, for example, with the caf_mpi
 implementation.  */
  TREE_STATIC (descriptor) = 1;
- tmp = gfc_conv_descriptor_token (descriptor);
- gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
-   null_pointer_node));
+ gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
 }
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 43cfce6f4411..0ac1660d21ad 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -520,6 +520,16 @@ gfc_conv_descriptor_token (tree desc)
   return field;
 }
 
+void
+gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t loc = input_location;
+  tree t = gfc_conv_descriptor_token (desc);
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+
 static tree
 gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0547157bf2af..3f602219c284 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -83,6 +83,7 @@ void gfc_conv_descriptor_dimension_set (stmtblock_t *block, 
tree desc, int dim,
 void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
+void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
 
 tree gfc_build_null_descriptor (tree type);
 
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dc4503a07352..2e35c6f6ec32 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -828,7 +828,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
   if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
   gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
-  gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+  gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
 }
 
   if (optional)
@@ -9848,8 +9848,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * 
cm,
{
  gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
  if (cm->attr.codimension && flag_coarray == GFC_FCOARRAY_LIB)
-   gfc_add_modify (&block, gfc_conv_descriptor_token (dest),
-   null_pointer_node);
+   gfc_conv_descriptor_token_set (&block, dest, null_pointer_node);
}
   else if (cm->attr.allocatable || cm->attr.pdt_array)
{
@@ -11607,10 +11606,9 @@ gfc_trans_scalar

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_rank compil' OK

[Mikael Morin via Gcc-cvs]

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

commit 9d5b0124b6d74d0e49633ee354b75c3968f32b76
Author: Mikael Morin 
Date:   Sun Jun 29 14:07:23 2025 +0200

Suppression gfc_conv_descriptor_rank compil' OK

Suppression non_lvalue rank_get

Ajout location rank_set

Diff:
---
 gcc/fortran/trans-array.cc  | 16 ++--
 gcc/fortran/trans-decl.cc   |  2 +-
 gcc/fortran/trans-descriptor.cc | 24 ++--
 gcc/fortran/trans-descriptor.h  |  4 +++-
 gcc/fortran/trans-expr.cc   | 24 +++-
 gcc/fortran/trans-intrinsic.cc  | 10 +-
 gcc/fortran/trans-openmp.cc |  2 +-
 gcc/fortran/trans-stmt.cc   |  2 +-
 8 files changed, 46 insertions(+), 38 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4ba32e6d7fe4..b34c8c7bff01 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1192,9 +1192,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
 
 
  /* These transformational functions change the rank.  */
- tmp = gfc_conv_descriptor_rank (desc);
- gfc_add_modify (pre, tmp,
- build_int_cst (TREE_TYPE (tmp), ss->loop->dimen));
+ gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen);
  fcn_ss->info->class_container = NULL_TREE;
}
 
@@ -4831,7 +4829,7 @@ done:
  && (gfc_option.allow_std & GFC_STD_F202Y)))
  gcc_assert (se.pre.head == NULL_TREE
  && se.post.head == NULL_TREE);
-   rank = gfc_conv_descriptor_rank (se.expr);
+   rank = gfc_conv_descriptor_rank_get (se.expr);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
   gfc_array_index_type,
   fold_convert (gfc_array_index_type,
@@ -8428,7 +8426,7 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, 
gfc_expr *expr, tree dim)
   enum gfc_array_kind akind = GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc));
   if (expr == NULL || expr->rank < 0)
 rank = fold_convert (signed_char_type_node,
-gfc_conv_descriptor_rank (desc));
+gfc_conv_descriptor_rank_get (desc));
   else
 rank = build_int_cst (signed_char_type_node, expr->rank);
 
@@ -8833,8 +8831,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
  tree tmp2 = gfc_conv_descriptor_dtype_get (se->expr);
  gfc_conv_descriptor_dtype_set (&block, arr, tmp2);
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
+ gfc_conv_descriptor_rank_set (&block, arr, 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);
@@ -9118,7 +9115,7 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int 
rank)
   tree nelems;
   tree tmp;
   if (rank < 0)
-idx = gfc_conv_descriptor_rank (decl);
+idx = gfc_conv_descriptor_rank_get (decl);
   else
 idx = gfc_rank_cst[rank - 1];
   nelems = gfc_conv_descriptor_ubound_get (decl, idx);
@@ -9328,8 +9325,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, 
tree src, tree type,
   else
 {
   /* Set the rank or unitialized memory access may be reported.  */
-  tmp = gfc_conv_descriptor_rank (dest);
-  gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), 
rank));
+  gfc_conv_descriptor_rank_set (&globalblock, dest, rank);
 
   if (rank)
nelems = gfc_full_array_size (&globalblock, src, rank);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index c52ad953f399..5ed1a1b6fbd3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7361,7 +7361,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
 {
   /* Set gfc->dtype.rank, if assumed-rank.  */
   rank = gfc_get_cfi_desc_rank (cfi);
-  gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank);
+  gfc_conv_descriptor_rank_set (&block, gfc_desc, rank);
 }
   else if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
 /* In that case, the CFI rank and the declared rank can differ.  */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6932becb3f0f..6b59699c652a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -284,8 +284,8 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
 }
 
 
-tree
-gfc_conv_descriptor_rank (tree desc)
+static tree
+get_descriptor_rank (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -298,6 +298,26 @@ 

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_elem_len compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:90c50ac950c154988e5ae206698f9689b778b4c0

commit 90c50ac950c154988e5ae206698f9689b778b4c0
Author: Mikael Morin 
Date:   Sun Jun 29 12:40:53 2025 +0200

Suppression gfc_conv_descriptor_elem_len compil' OK

Correction ICE class_allocate_21

Suppression non_lvalue elem_len_get

Ajout location elem_len_set

Suppression retour à la ligne inutile elem_len_set

Diff:
---
 gcc/fortran/trans-array.cc  |  8 ++--
 gcc/fortran/trans-decl.cc   | 10 +-
 gcc/fortran/trans-descriptor.cc | 18 --
 gcc/fortran/trans-descriptor.h  |  3 ++-
 gcc/fortran/trans-expr.cc   |  6 +++---
 gcc/fortran/trans-intrinsic.cc  |  2 +-
 gcc/fortran/trans-openmp.cc |  6 +++---
 7 files changed, 32 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 23e3a64d04c8..7218df21885e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5838,11 +5838,7 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   else if (expr->ts.type == BT_CLASS && !explicit_ts
   && expr3 && expr3->ts.type != BT_CLASS
   && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
-{
-  tmp = gfc_conv_descriptor_elem_len (descriptor);
-  gfc_add_modify (pblock, tmp,
- fold_convert (TREE_TYPE (tmp), expr3_elem_size));
-}
+gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size);
   else
 gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
 
@@ -11202,7 +11198,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
 {
   /* Unfortunately, the lhs vptr is set too early in many cases.
 Play it safe by using the descriptor element length.  */
-  tmp = gfc_conv_descriptor_elem_len (desc);
+  tmp = gfc_conv_descriptor_elem_len_get (desc);
   elemsize1 = fold_convert (gfc_array_index_type, tmp);
 }
   else
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 42d317962a97..c52ad953f399 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7276,8 +7276,8 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  gfc_conv_descriptor_elem_len_set (&block, 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),
@@ -7507,7 +7507,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   /* memcpy (lhs + idx*elem_len, rhs + shift, elem_len)  */
   tree elem_len;
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
-   elem_len = gfc_conv_descriptor_elem_len (gfc_desc);
+   elem_len = gfc_conv_descriptor_elem_len_get (gfc_desc);
   else
elem_len = gfc_get_cfi_desc_elem_len (cfi);
   lhs = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
@@ -7545,7 +7545,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   /* if do_copy_inout:  gfc->dspan = gfc->dtype.elem_len
  We use gfc instead of cfi on the RHS as this might be a constant.  */
   tmp = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_elem_len (gfc_desc));
+ gfc_conv_descriptor_elem_len_get (gfc_desc));
   if (!do_copy_inout)
 {
   /* gfc->dspan = ((cfi->dim[0].sm % gfc->elem_len)
@@ -7749,7 +7749,7 @@ done:
  /* memcpy (lhs + shift, rhs + idx*elem_len, elem_len) */
  tree elem_len;
  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
-   elem_len = gfc_conv_descriptor_elem_len (gfc_desc);
+   elem_len = gfc_conv_descriptor_elem_len_get (gfc_desc);
  else
elem_len = gfc_get_cfi_desc_elem_len (cfi);
  rhs = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 34a71cfda5d4..ea4817d1cc16 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -316,8 +316,8 @@ gfc_conv_descriptor_version (tree desc)
 
 /* Return the element length from the descriptor dtype field.  */
 
-tree
-gfc_conv_descriptor_elem_len (tree desc)
+static tree
+get_descriptor_elem_len (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -331,6 +331,20 @@ gfc_conv_descriptor_elem_len (tree desc)
  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_elem_len_get (tree desc)
+{
+  return get_descriptor_elem_len (desc);
+}
+
+void
+gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t l

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Refactoring getters & setters

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:889dea56374fb92762fe5b9e8dee7c2c404ebb1e

commit 889dea56374fb92762fe5b9e8dee7c2c404ebb1e
Author: Mikael Morin 
Date:   Tue Jul 1 22:10:35 2025 +0200

Refactoring getters & setters

Nettoyage refactoring

Correction refactoring

Diff:
---
 gcc/fortran/trans-descriptor.cc | 125 ++--
 1 file changed, 43 insertions(+), 82 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 3d7cbeb7f43a..20484abd39a0 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -174,33 +174,39 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
 
 
 static tree
-get_type_field (tree type, unsigned field_idx)
+get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
 {
   tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
-  gcc_assert (field != NULL_TREE);
+  gcc_assert (field != NULL_TREE
+ && (field_type == NULL_TREE
+ || TREE_TYPE (field) == field_type));
 
   return field;
 }
 
-
 static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
+get_ref_comp (tree ref, unsigned field_idx, tree type = NULL_TREE)
 {
-  tree type = TREE_TYPE (desc);
-  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-
-  tree field = get_type_field (type, field_idx);
-  gcc_assert (field != NULL_TREE);
+  tree field = get_type_field (TREE_TYPE (ref), field_idx, type);
 
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- desc, field, NULL_TREE);
+ ref, field, NULL_TREE);
+}
+
+
+static tree
+get_descr_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+{
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+
+  return get_ref_comp (desc, field_idx, type);
 }
 
 
 static tree
 get_descriptor_data (tree desc)
 {
-  return gfc_get_descriptor_field (desc, DATA_FIELD);
+  return get_descr_comp (desc, DATA_FIELD);
 }
 
 /* This provides READ-ONLY access to the data field.  The field itself
@@ -229,7 +235,7 @@ gfc_conv_descriptor_data_get (tree desc)
 void
 gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
 {
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+  tree field = get_descriptor_data (desc);
   gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
 }
 
@@ -237,9 +243,7 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree 
desc, tree value)
 static tree
 get_descriptor_offset (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
-  gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
-  return field;
+  return get_descr_comp (desc, OFFSET_FIELD, gfc_array_index_type);
 }
 
 tree
@@ -259,9 +263,7 @@ gfc_conv_descriptor_offset_set (stmtblock_t *block, tree 
desc, tree value)
 static tree
 get_descriptor_dtype (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
-  gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
-  return field;
+  return get_descr_comp (desc, DTYPE_FIELD, get_dtype_type_node ());
 }
 
 tree
@@ -283,9 +285,7 @@ gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree 
desc, tree value)
 static tree
 gfc_conv_descriptor_span (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
-  gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
-  return field;
+  return get_descr_comp (desc, SPAN_FIELD, gfc_array_index_type);
 }
 
 tree
@@ -295,26 +295,24 @@ gfc_conv_descriptor_span_get (tree desc)
 }
 
 void
-gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
-   tree value)
+gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
 {
   tree t = gfc_conv_descriptor_span (desc);
   gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
 }
 
 
+static tree
+get_dtype_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+{ 
+  tree dtype_ref = get_descriptor_dtype (desc);
+  return get_ref_comp (dtype_ref, field_idx, type);
+}
+
 static tree
 get_descriptor_rank (tree desc)
 {
-  tree tmp;
-  tree dtype;
-
-  dtype = get_descriptor_dtype (desc);
-  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
-  gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == signed_char_type_node);
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
+  return get_dtype_comp (desc, GFC_DTYPE_RANK, signed_char_type_node);
 }
 
 tree
@@ -341,15 +339,7 @@ gfc_conv_descriptor_rank_set (stmtblock_t *block, tree 
desc, int value)
 static tree
 get_descriptor_version (tree desc)
 {
-  tree tmp;
-  tree dtype;
-
-  dtype = get_descriptor_dtype (desc);
-  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
-  gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == integer_type_node);
-  return fold_build3_loc (input_location, COMPONENT_R

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_version compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:39c988d7fc97c71f45b322af0eb489685a85349d

commit 39c988d7fc97c71f45b322af0eb489685a85349d
Author: Mikael Morin 
Date:   Sun Jun 29 12:58:32 2025 +0200

Suppression gfc_conv_descriptor_version compil' OK

Suppression non_lvalue version_get

Ajout location version_set

Suppression mise à la ligne version_set

Diff:
---
 gcc/fortran/trans-array.cc  | 23 +--
 gcc/fortran/trans-descriptor.cc | 19 +--
 gcc/fortran/trans-descriptor.h  |  3 ++-
 gcc/fortran/trans.cc|  5 ++---
 4 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7218df21885e..4ba32e6d7fe4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6368,10 +6368,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
 build_tree_list (NULL_TREE, alloc),
 DECL_ATTRIBUTES (omp_alt_alloc));
   omp_alt_alloc = build_call_expr (omp_alt_alloc, 3, align, sz, alloc);
-  succ_add_expr = fold_build2_loc (input_location, MODIFY_EXPR,
-  void_type_node,
-  gfc_conv_descriptor_version (se->expr),
+  stmtblock_t tmp_block;
+  gfc_init_block (&tmp_block);
+  gfc_conv_descriptor_version_set (&tmp_block, se->expr,
   build_int_cst (integer_type_node, 1));
+  succ_add_expr = gfc_finish_block (&tmp_block);
 }
 
   /* The allocatable variant takes the old pointer as first argument.  */
@@ -10501,10 +10502,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
{
  tree cd, t;
  if (c->attr.pdt_array)
-   cd = fold_build2_loc (input_location, EQ_EXPR,
- boolean_type_node,
- gfc_conv_descriptor_version (comp),
- build_int_cst (integer_type_node, 1));
+   {
+ tree version = gfc_conv_descriptor_version_get (comp);
+ cd = fold_build2_loc (input_location, EQ_EXPR,
+   boolean_type_node, version,
+   build_int_cst (integer_type_node, 
1));
+   }
  else
cd = gfc_omp_call_is_alloc (tmp);
  t = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
@@ -10514,8 +10517,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  gfc_init_block (&tblock);
  gfc_add_expr_to_block (&tblock, t);
  if (c->attr.pdt_array)
-   gfc_add_modify (&tblock, gfc_conv_descriptor_version (comp),
-   integer_zero_node);
+   gfc_conv_descriptor_version_set (&tblock, comp,
+integer_zero_node);
  tmp = build3_loc (input_location, COND_EXPR, void_type_node,
cd, gfc_finish_block (&tblock),
gfc_call_free (tmp));
@@ -11566,7 +11569,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
{
  tree cond, omp_tmp;
  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- gfc_conv_descriptor_version (desc),
+ gfc_conv_descriptor_version_get (desc),
  build_int_cst (integer_type_node, 1));
  omp_tmp = builtin_decl_explicit (BUILT_IN_GOMP_REALLOC);
  omp_tmp = build_call_expr_loc (input_location, omp_tmp, 4,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index ea4817d1cc16..6932becb3f0f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -299,8 +299,8 @@ gfc_conv_descriptor_rank (tree desc)
 }
 
 
-tree
-gfc_conv_descriptor_version (tree desc)
+static tree
+get_descriptor_version (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -313,6 +313,21 @@ gfc_conv_descriptor_version (tree desc)
  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_version_get (tree desc)
+{
+  return get_descriptor_version (desc);
+}
+
+void
+gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t loc = input_location;
+  tree t = get_descriptor_version (desc);
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
 
 /* Return the element length from the descriptor dtype field.  */
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 8cd65b46f5fa..e5300bf0704e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-de

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_attribute compil' OK

[Mikael Morin via Gcc-cvs]

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

commit 5f685a977d20209ae4b8f54ec7844e2736a57842
Author: Mikael Morin 
Date:   Sun Jun 29 14:15:55 2025 +0200

Suppression gfc_conv_descriptor_attribute compil' OK

Diff:
---
 gcc/fortran/trans-descriptor.cc | 16 
 gcc/fortran/trans-descriptor.h  |  1 -
 2 files changed, 17 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 34a635cc90ca..2a59f7dfd13f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -393,22 +393,6 @@ gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree 
desc, tree value)
 }
 
 
-tree
-gfc_conv_descriptor_attribute (tree desc)
-{
-  tree tmp;
-  tree dtype;
-
-  dtype = get_descriptor_dtype (desc);
-  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
-  GFC_DTYPE_ATTRIBUTE);
-  gcc_assert (tmp!= NULL_TREE
- && TREE_TYPE (tmp) == short_integer_type_node);
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-
 static tree
 get_descriptor_type (tree desc)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 96f66b004ecb..69cc4f3e2ac6 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -48,7 +48,6 @@ tree gfc_get_cfi_dim_extent (tree desc, tree idx);
 tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
-tree gfc_conv_descriptor_attribute (tree desc);
 tree gfc_get_descriptor_dimension (tree desc);
 tree gfc_conv_descriptor_dimension (tree desc, tree dim);
 tree gfc_conv_descriptor_token (tree desc);

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

[Mikael Morin via Gcc-cvs]

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

commit dea29b45050970dbbf3ba793907ed504f9852c2d
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 fbf47dd9b60a..b36579e7c7a6 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -7248,6 +7248,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_v08)] Modif gfc_init_descriptor_variable

[Mikael Morin via Gcc-cvs]

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

commit a507baafc413d1317a71fba98d82c2f062aebd21
Author: Mikael Morin 
Date:   Sat Jul 19 15:55:19 2025 +0200

Modif gfc_init_descriptor_variable

Diff:
---
 gcc/fortran/trans-descriptor.cc | 20 +---
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f89ad587f62f..cc25347551a6 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -673,22 +673,28 @@ gfc_get_descriptor_offsets_for_info (const_tree 
desc_type, tree *data_off,
 void
 gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
 {
+  symbol_attribute attr = gfc_symbol_attr (sym);
+
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
  pointers when -fcheck=pointer is specified.  */
-  if (sym->attr.allocatable
-  || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+  if (attr.allocatable
+  || (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
 {
   gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
-  if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+  if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
 }
 
   tree etype;
 
-  gcc_assert (sym->as && sym->as->rank>=0);
+  gfc_array_spec *as;
+  if (sym->ts.type == BT_CLASS)
+as = CLASS_DATA (sym)->as;
+  else
+as = sym->as;
+
+  gcc_assert (as && as->rank >= 0);
   etype = gfc_get_element_type (TREE_TYPE (descr));
   gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (sym->as->rank,
- etype));
+gfc_get_dtype_rank_type (as->rank, etype));
 }
-

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Introduction gfc_init_descriptor_result

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:523363da0851354da5634dd9b2cf085746678ea6

commit 523363da0851354da5634dd9b2cf085746678ea6
Author: Mikael Morin 
Date:   Sat Jul 19 15:55:36 2025 +0200

Introduction gfc_init_descriptor_result

Revert "Suppression gfc_init_descriptor_result"

This reverts commit 0f85f1e92970d2a0f13dc61a9781323f33a3b631.

Diff:
---
 gcc/fortran/trans-decl.cc   | 4 +---
 gcc/fortran/trans-descriptor.cc | 8 
 gcc/fortran/trans-descriptor.h  | 1 +
 3 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 2996dd72e6aa..fd9268793508 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4773,14 +4773,12 @@ 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_init_descriptor_result (&init, tmp);
  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
 }
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index cc25347551a6..27c85d4e73c1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -698,3 +698,11 @@ gfc_init_descriptor_variable (stmtblock_t *block, 
gfc_symbol *sym, tree descr)
   gfc_conv_descriptor_dtype_set (block, descr,
 gfc_get_dtype_rank_type (as->rank, etype));
 }
+
+
+void
+gfc_init_descriptor_result (stmtblock_t *block, tree descr)
+{
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 6058f54fc5fd..0b6540116452 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -93,5 +93,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 tree *upper_suboff);
 
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
+void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:42b09001a5ad7d51f659fd070031707aaf009ef0

commit 42b09001a5ad7d51f659fd070031707aaf009ef0
Author: Mikael Morin 
Date:   Sat Jul 19 13:55:28 2025 +0200

Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor

Revert "Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable"

This reverts commit 6a87820bffc834c09c5dcf8edb61f55cf6eec34c.

Revert "Correction compilation"

This reverts commit 5131afedc5568d33c68046a098a0143f9ae03eb9.

Revert partiel

Renseignement expression

Renommage

Correction régression null_actual_6

Diff:
---
 gcc/fortran/trans-descriptor.cc | 47 +++--
 gcc/fortran/trans-descriptor.h  |  5 ++-
 gcc/fortran/trans-expr.cc   | 93 +
 gcc/fortran/trans-types.cc  |  9 +++-
 gcc/fortran/trans-types.h   |  1 +
 gcc/fortran/trans.h |  1 +
 6 files changed, 132 insertions(+), 24 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e3762d70bb36..2d48a1834ba1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -671,7 +671,8 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 #undef UBOUND_SUBFIELD
 
 void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr 
*expr, tree descr)
+gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *sym, gfc_expr *expr,
+   tree descr, tree string_length)
 {
   symbol_attribute attr = gfc_symbol_attr (sym);
 
@@ -705,8 +706,15 @@ gfc_init_descriptor_variable (stmtblock_t *block, 
gfc_symbol *sym, gfc_expr *exp
 rank = -1;
 
   etype = gfc_get_element_type (TREE_TYPE (descr));
-  gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (rank, etype));
+  tree dtype = gfc_get_dtype_rank_type_slen (rank, etype, string_length);
+  gfc_conv_descriptor_dtype_set (block, descr, dtype);
+}
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
+ gfc_expr *expr, tree descr)
+{
+  return gfc_nullify_descriptor (block, sym, expr, descr, NULL_TREE);
 }
 
 
@@ -771,3 +779,36 @@ gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
   gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
 }
 
+
+void
+gfc_set_scalar_descriptor (stmtblock_t *block, tree descr, tree value)
+{
+  tree etype = TREE_TYPE (value);
+
+  if (POINTER_TYPE_P (etype)
+  && TREE_TYPE (etype)
+  && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+etype = TREE_TYPE (etype);
+  gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type (0, etype));
+  gfc_conv_descriptor_data_set (block, descr, value);
+  gfc_conv_descriptor_span_set (block, descr,
+   gfc_conv_descriptor_elem_len_get (descr));
+}
+
+
+void
+gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *expr, tree descr,
+   tree string_length)
+{
+  tree etype = gfc_get_element_type (TREE_TYPE (descr));
+  if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+etype = TREE_TYPE (etype);
+  gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type_slen (expr->rank, 
etype,
+  string_length));
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+  gfc_conv_descriptor_span_set (block, descr,
+   gfc_conv_descriptor_elem_len_get (descr));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index de57a8e606e8..92603cde494a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -19,9 +19,7 @@ along with GCC; see the file COPYING3.  If not see
 #ifndef GFC_TRANS_DESCRIPTOR_H
 #define GFC_TRANS_DESCRIPTOR_H
 
-/* Build a null array descriptor constructor.  */
 tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
-void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
 void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -95,7 +93,10 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
 void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
+void gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, 
tree, tree);
 void gfc_init_static_descriptor (tree descr);
 void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
+void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
+void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, tree, tree);

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_init_descriptor_variable

[Mikael Morin via Gcc-cvs]

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

commit ac326e1c48c940b410122ba6219a7fc1782cb376
Author: Mikael Morin 
Date:   Tue Jul 15 18:28:30 2025 +0200

Extraction gfc_init_descriptor_variable

Correction nom block

Correction libgomp.fortran/allocators-1.f90

Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable

Diff:
---
 gcc/fortran/trans-array.cc | 18 ++--
 gcc/fortran/trans-descriptor.cc| 24 ++
 gcc/fortran/trans-descriptor.h |  4 ++--
 libgomp/testsuite/libgomp.fortran/allocators-1.f90 |  4 ++--
 4 files changed, 30 insertions(+), 20 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index acf643f6adbd..4cb21a42c1a8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11828,10 +11828,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
  pointers when -fcheck=pointer is specified.  */
   if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save
-  && (sym->attr.allocatable
- || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER
+  && (sym->attr.allocatable || sym->attr.pointer))
 {
-  gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
   if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
{
  /* Declare the variable static so its array descriptor stays present
@@ -11839,22 +11837,10 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
 image.  This may happen, for example, with the caf_mpi
 implementation.  */
  TREE_STATIC (descriptor) = 1;
- gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
+  gfc_init_descriptor_variable (&init, sym, descriptor);
 }
 
-  /* Set initial TKR for pointers and allocatables */
-  if (GFC_DESCRIPTOR_TYPE_P (type)
-  && (sym->attr.pointer || sym->attr.allocatable))
-{
-  tree etype;
-
-  gcc_assert (sym->as && sym->as->rank>=0);
-  etype = gfc_get_element_type (type);
-  gfc_conv_descriptor_dtype_set (&init, descriptor,
-gfc_get_dtype_rank_type (sym->as->rank,
- etype));
-}
   input_location = loc;
   gfc_init_block (&cleanup);
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5f0076ab855..f89ad587f62f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -668,3 +668,27 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 #undef STRIDE_SUBFIELD
 #undef LBOUND_SUBFIELD
 #undef UBOUND_SUBFIELD
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+  /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
+ pointers when -fcheck=pointer is specified.  */
+  if (sym->attr.allocatable
+  || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+{
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+  if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+   gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
+}
+
+  tree etype;
+
+  gcc_assert (sym->as && sym->as->rank>=0);
+  etype = gfc_get_element_type (TREE_TYPE (descr));
+  gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type (sym->as->rank,
+ etype));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 3f602219c284..6058f54fc5fd 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -22,9 +22,7 @@ along with GCC; see the file COPYING3.  If not see
 /* 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 *, 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_null_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -94,4 +92,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 tree *stride_suboff, tree *lower_suboff,
 tree *upper_suboff);
 
+void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
+
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/libgomp/testsuite/lib

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_build_default_class_descriptor

[Mikael Morin via Gcc-cvs]

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

commit ee977c6735bed47228266806e3ee1e4283b52115
Author: Mikael Morin 
Date:   Tue Jul 15 20:30:45 2025 +0200

Extraction gfc_build_default_class_descriptor

Correction régression class_allocate_14

Diff:
---
 gcc/fortran/trans-decl.cc   | 24 ++
 gcc/fortran/trans-descriptor.cc | 44 -
 gcc/fortran/trans-descriptor.h  |  4 +++-
 gcc/fortran/trans-expr.cc   | 14 ++---
 gcc/fortran/trans.h |  1 +
 5 files changed, 56 insertions(+), 31 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 66fd67e61f60..65a782b6dddf 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4926,30 +4926,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
  && (sym->attr.save || flag_max_stack_var_size == 0)
  && CLASS_DATA (sym)->attr.allocatable)
{
- tree vptr;
-
-  if (UNLIMITED_POLY (sym))
-   vptr = null_pointer_node;
- else
-   {
- gfc_symbol *vsym;
- vsym = gfc_find_derived_vtab (sym->ts.u.derived);
- vptr = gfc_get_symbol_decl (vsym);
- vptr = gfc_build_addr_expr (NULL, vptr);
-   }
-
- if (CLASS_DATA (sym)->attr.dimension
- || (CLASS_DATA (sym)->attr.codimension
- && flag_coarray != GFC_FCOARRAY_LIB))
-   {
- tmp = gfc_class_data_get (sym->backend_decl);
- tmp = gfc_build_null_descriptor (TREE_TYPE (tmp));
-   }
- else
-   tmp = null_pointer_node;
+ tree class_type = TREE_TYPE (sym->backend_decl);
 
  DECL_INITIAL (sym->backend_decl)
-   = gfc_class_set_static_fields (sym->backend_decl, vptr, tmp);
+   = gfc_build_default_class_descriptor (sym->ts, class_type);
  TREE_CONSTANT (DECL_INITIAL (sym->backend_decl)) = 1;
}
   else if ((sym->attr.dimension || sym->attr.codimension
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 27c85d4e73c1..57570145118d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -173,8 +173,8 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
 #define UBOUND_SUBFIELD 2
 
 
-static tree
-get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
+tree
+gfc_get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
 {
   tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
   gcc_assert (field != NULL_TREE
@@ -187,7 +187,7 @@ get_type_field (tree type, unsigned field_idx, tree 
field_type = NULL_TREE)
 static tree
 get_ref_comp (tree ref, unsigned field_idx, tree type = NULL_TREE)
 {
-  tree field = get_type_field (TREE_TYPE (ref), field_idx, type);
+  tree field = gfc_get_type_field (TREE_TYPE (ref), field_idx, type);
 
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
  ref, field, NULL_TREE);
@@ -415,8 +415,9 @@ gfc_conv_descriptor_type_set (stmtblock_t *block, tree 
desc, int value)
   tree type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
-  tree dtype_field = get_type_field (type, DTYPE_FIELD, get_dtype_type_node 
());
-  tree field = get_type_field (TREE_TYPE (dtype_field), GFC_DTYPE_TYPE);
+  tree dtype_field = gfc_get_type_field (type, DTYPE_FIELD,
+get_dtype_type_node ());
+  tree field = gfc_get_type_field (TREE_TYPE (dtype_field), GFC_DTYPE_TYPE);
 
   tree type_value = build_int_cst (TREE_TYPE (field), value);
   gfc_conv_descriptor_type_set (block, desc, type_value);
@@ -706,3 +707,36 @@ gfc_init_descriptor_result (stmtblock_t *block, tree descr)
   gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
 }
 
+
+tree
+gfc_build_default_class_descriptor (const gfc_typespec &ts, tree class_type)
+{
+  gcc_assert (ts.type == BT_CLASS);
+
+  gfc_symbol *derived = ts.u.derived;
+
+  tree vptr;
+  if (derived->attr.unlimited_polymorphic)
+vptr = null_pointer_node;
+  else
+{
+  gfc_symbol *vsym;
+  vsym = gfc_find_derived_vtab (derived);
+  vptr = gfc_get_symbol_decl (vsym);
+  vptr = gfc_build_addr_expr (NULL, vptr);
+}
+
+  tree tmp;
+  if (derived->components->attr.dimension
+  || (derived->components->attr.codimension
+ && flag_coarray != GFC_FCOARRAY_LIB))
+{
+  tmp = gfc_class_type_data_field_get (class_type);
+  tmp = gfc_build_null_descriptor (TREE_TYPE (tmp));
+}
+  else
+tmp = null_pointer_node;
+
+  return gfc_class_set_static_fields (class_type, vptr, tmp);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0b6540116452..f5b5e59f1cfe 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -21,7 +21,7 @@ along with GCC; see the 

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Introduction gfc_symbol_attr

[Mikael Morin via Gcc-cvs]

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

commit 2dd89733d88fcb6252ec0421368b6095e0f4b621
Author: Mikael Morin 
Date:   Thu Jul 17 16:38:25 2025 +0200

Introduction gfc_symbol_attr

Ajout déclaration gfc_symbol_attr

Diff:
---
 gcc/fortran/gfortran.h |  1 +
 gcc/fortran/primary.cc | 86 --
 2 files changed, 56 insertions(+), 31 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d85095c4da91..2ed8be344d69 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4131,6 +4131,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 f0e1fef6812e..6f69130d2f81 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2909,43 +2909,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;
-  bool has_substring_ref = false;
-
-  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)
 {
   dimension = CLASS_DATA (sym)->attr.dimension;
@@ -2981,6 +2952,59 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
target = 0;
 }
 
+  attr.dimension = dimension;
+  attr.codimension = codimension;
+  attr.pointer = pointer;
+  attr.allocatable = allocatable;
+  attr.target = target;
+
+  return attr;
+}
+
+
+/* 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)
+{
+  int dimension, codimension, pointer, allocatable, target, optional;
+  symbol_attribute attr;
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  gfc_component *comp;
+  bool has_inquiry_part;
+  bool has_substring_ref = false;
+
+  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 = gfc_symbol_attr (sym);
+
+  optional = attr.optional;
+  dimension = attr.dimension;
+  codimension = attr.codimension;
+  pointer = attr.pointer;
+  allocatable = attr.allocatable;
+  target = attr.target;
+
   if (ts != NULL && expr->ts.type == BT_UNKNOWN)
 *ts = sym->ts;

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Ajout locations setters

[Mikael Morin via Gcc-cvs]

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

commit b7b4a236eb3efe3197aebe0604b3c37a8eb4c7b9
Author: Mikael Morin 
Date:   Tue Jul 1 22:20:34 2025 +0200

Ajout locations setters

Diff:
---
 gcc/fortran/trans-descriptor.cc | 28 
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 20484abd39a0..e5f0076ab855 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -218,10 +218,10 @@ gfc_conv_descriptor_data_get (tree desc)
   tree type = TREE_TYPE (desc);
   gcc_assert (TREE_CODE (type) != REFERENCE_TYPE);
 
+  location_t loc = input_location;
   tree field = get_descriptor_data (desc);
   tree target_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
-  tree t = fold_convert (target_type, field);
-  return non_lvalue_loc (input_location, t);
+  return non_lvalue_loc (loc, fold_convert_loc (loc, target_type, field));
 }
 
 /* This provides WRITE access to the data field.
@@ -235,8 +235,10 @@ gfc_conv_descriptor_data_get (tree desc)
 void
 gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
 {
+  location_t loc = input_location;
   tree field = get_descriptor_data (desc);
-  gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
+  gfc_add_modify_loc (loc, block, field,
+ fold_convert_loc (loc, TREE_TYPE (field), value));
 }
 
 
@@ -255,8 +257,10 @@ gfc_conv_descriptor_offset_get (tree desc)
 void
 gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_offset (desc);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 
@@ -297,8 +301,10 @@ gfc_conv_descriptor_span_get (tree desc)
 void
 gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
 {
+  location_t loc = input_location;
   tree t = gfc_conv_descriptor_span (desc);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 
@@ -543,8 +549,10 @@ void
 gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
tree dim, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_stride (desc, dim);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 static tree
@@ -563,8 +571,10 @@ void
 gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
tree dim, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_lbound (desc, dim);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 static tree
@@ -583,8 +593,10 @@ void
 gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
tree dim, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_ubound (desc, dim);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_init_absent_descriptor

[Mikael Morin via Gcc-cvs]

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

commit 5c581cf1c7b04f8cbaff04e9324646c7637131ae
Author: Mikael Morin 
Date:   Tue Jul 15 21:49:27 2025 +0200

Extraction gfc_init_absent_descriptor

Correction gfc_clear_descriptor assumed rank

Correction partielle class_optional_2

Correction class_optional_2

Diff:
---
 gcc/fortran/trans-descriptor.cc | 31 +++
 gcc/fortran/trans-descriptor.h  |  2 +-
 gcc/fortran/trans-expr.cc   |  5 ++---
 3 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 26fd6ba4fcf8..e3762d70bb36 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -670,15 +670,15 @@ gfc_get_descriptor_offsets_for_info (const_tree 
desc_type, tree *data_off,
 #undef LBOUND_SUBFIELD
 #undef UBOUND_SUBFIELD
 
-
 void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr 
*expr, tree descr)
 {
   symbol_attribute attr = gfc_symbol_attr (sym);
 
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
  pointers when -fcheck=pointer is specified.  */
   if (attr.allocatable
+  || attr.optional
   || (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
 {
   gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
@@ -694,10 +694,26 @@ gfc_init_descriptor_variable (stmtblock_t *block, 
gfc_symbol *sym, tree descr)
   else
 as = sym->as;
 
-  gcc_assert (as && as->rank >= 0);
+  int rank;
+  if (as == nullptr)
+rank = 0;
+  else if (as->type != AS_ASSUMED_RANK)
+rank = as->rank;
+  else if (expr)
+rank = expr->rank;
+  else
+rank = -1;
+
   etype = gfc_get_element_type (TREE_TYPE (descr));
   gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (as->rank, etype));
+gfc_get_dtype_rank_type (rank, etype));
+}
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+  return gfc_init_descriptor_variable (block, sym, nullptr, descr);
 }
 
 
@@ -748,3 +764,10 @@ gfc_build_default_class_descriptor (const gfc_typespec 
&ts, tree class_type)
   return gfc_class_set_static_fields (class_type, vptr, tmp);
 }
 
+
+void
+gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
+{
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index f28565d783ee..de57a8e606e8 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -20,7 +20,6 @@ along with GCC; see the file COPYING3.  If not see
 #define GFC_TRANS_DESCRIPTOR_H
 
 /* Build a null array descriptor constructor.  */
-tree gfc_build_null_descriptor (tree);
 tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
 void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
 void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
@@ -97,5 +96,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
 void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
 void gfc_init_static_descriptor (tree descr);
+void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 5f3a0cf8d8d6..2e54e78824e6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -978,10 +978,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
  tmp = gfc_finish_block (&block);
 
  gfc_init_block (&block);
- gfc_conv_descriptor_data_set (&block, ctree, null_pointer_node);
+ gfc_init_absent_descriptor (&block, ctree);
  if (derived_array && *derived_array != NULL_TREE)
-   gfc_conv_descriptor_data_set (&block, *derived_array,
- null_pointer_node);
+   gfc_init_absent_descriptor (&block, *derived_array);
 
  tmp = build3_v (COND_EXPR, cond_optional, tmp,
  gfc_finish_block (&block));

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_init_static_descriptor

[Mikael Morin via Gcc-cvs]

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

commit be7b8b0e1b361ef662d63a4f85cc175171232fe1
Author: Mikael Morin 
Date:   Tue Jul 15 21:06:28 2025 +0200

Extraction gfc_init_static_descriptor

Correction compilation

Renommage gfc_clear_descriptor -> gfc_init_static_descriptor

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4cb21a42c1a8..d79cc8ea3a40 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -555,12 +555,8 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
 void
 gfc_trans_static_array_pointer (gfc_symbol * sym)
 {
-  tree type;
-
   gcc_assert (TREE_STATIC (sym->backend_decl));
-  /* Just zero the data member.  */
-  type = TREE_TYPE (sym->backend_decl);
-  DECL_INITIAL (sym->backend_decl) = gfc_build_null_descriptor (type);
+  gfc_init_static_descriptor (sym->backend_decl);
 }
 
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 57570145118d..26fd6ba4fcf8 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -708,6 +708,14 @@ gfc_init_descriptor_result (stmtblock_t *block, tree descr)
 }
 
 
+void
+gfc_init_static_descriptor (tree descr)
+{
+  tree type = TREE_TYPE (descr);
+  DECL_INITIAL (descr) = gfc_build_null_descriptor (type);
+}
+
+
 tree
 gfc_build_default_class_descriptor (const gfc_typespec &ts, tree class_type)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index f5b5e59f1cfe..f28565d783ee 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -96,5 +96,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
 void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
+void gfc_init_static_descriptor (tree descr);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */

[gcc r15-10052] ada: Tune recent change for bit-packed arrays to help GNATprove backend

[Eric Botcazou via Gcc-cvs]

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

commit r15-10052-gc6b571c6c7c45bd86abe4de22fb5f10130ed92e1
Author: Piotr Trojanek 
Date:   Fri Jul 4 11:52:46 2025 +0200

ada: Tune recent change for bit-packed arrays to help GNATprove backend

When GNAT is operating in GNATprove_Mode the Expander_Active flag is 
disabled,
but we still must do things that ordinary backends expect.

gcc/ada/ChangeLog:

* sem_util.adb (Get_Actual_Subtype): Do the same for GCC and 
GNATprove
backends.

Diff:
---
 gcc/ada/sem_util.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3fced544fb5f..d4bfd64483a4 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10002,7 +10002,7 @@ package body Sem_Util is
  --  pass to the back end should contain no references to Atyp (and a
  --  freeze node would contain such a reference).
 
- elsif not Expander_Active then
+ elsif not (Expander_Active or GNATprove_Mode) then
 return Typ;
 
  --  Else build the actual subtype

[gcc r15-10053] ada: Fix assertion failure on aggregate with controlled component

[Eric Botcazou via Gcc-cvs]

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

commit r15-10053-g2b05983ca270f1dae905d987415b3e624d17ceb2
Author: Eric Botcazou 
Date:   Tue Jul 8 11:05:19 2025 +0200

ada: Fix assertion failure on aggregate with controlled component

The assertion is:

  pragma Assert (Side_Effect_Free (L));

in Make_Tag_Ctrl_Assignment and demonstrates that the sequence:

  Remove_Side_Effects (L);
  pragma Assert (Side_Effect_Free (L));

does not hold in this case.

What happens is that Remove_Side_Effects uses a renaming to remove the side
effects of L but, at the end, the renamed object is substituted back for the
renamed object in the node by Expand_Renaming, which is invoked because the
Is_Renaming_Of_Object flag is set on the renaming after Evaluate_Name has
been invoked on its Name.

This is a general discrepancy between Evaluate_Name and Side_Effect_Free of
Exp_Util, coming from the call to Safe_Unchecked_Type_Conversion present in
Side_Effect_Free in this case.  The long term goal is probably to remove the
call but, in the meantime, this change is sufficient to fix the failure.

gcc/ada/ChangeLog:

* exp_util.adb (Safe_Unchecked_Type_Conversion): Always return True
if the expression is the prefix of an N_Selected_Component.

Diff:
---
 gcc/ada/exp_util.adb | 13 -
 1 file changed, 4 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index b3dbe98e02bd..cfbca9100174 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13662,11 +13662,12 @@ package body Exp_Util is
--  The above requirements should be documented in Sinfo ???
 
function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean is
+  Pexp : constant Node_Id := Parent (Exp);
+
   Otyp   : Entity_Id;
   Ityp   : Entity_Id;
   Oalign : Uint;
   Ialign : Uint;
-  Pexp   : constant Node_Id := Parent (Exp);
 
begin
   --  If the expression is the RHS of an assignment or object declaration
@@ -13684,18 +13685,12 @@ package body Exp_Util is
  return True;
 
   --  If the expression is the prefix of an N_Selected_Component we should
-  --  also be OK because GCC knows to look inside the conversion except if
-  --  the type is discriminated. We assume that we are OK anyway if the
-  --  type is not set yet or if it is controlled since we can't afford to
-  --  introduce a temporary in this case.
+  --  also be OK because GCC knows to look inside the conversion.
 
   elsif Nkind (Pexp) = N_Selected_Component
 and then Prefix (Pexp) = Exp
   then
- return No (Etype (Pexp))
-   or else not Is_Type (Etype (Pexp))
-   or else not Has_Discriminants (Etype (Pexp))
-   or else Is_Constrained (Etype (Pexp));
+ return True;
   end if;
 
   --  Set the output type, this comes from Etype if it is set, otherwise we

[gcc r15-10054] ada: Remove obsolete code from Safe_Unchecked_Type_Conversion

[Eric Botcazou via Gcc-cvs]

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

commit r15-10054-g0bccb1eb75549db809e0685557dcce65798bf746
Author: Eric Botcazou 
Date:   Tue Jul 8 21:40:44 2025 +0200

ada: Remove obsolete code from Safe_Unchecked_Type_Conversion

That's a kludge added to work around the limitations of the stack checking
mechanism used in the early days.

gcc/ada/ChangeLog:

* exp_util.ads (May_Generate_Large_Temp): Delete.
* exp_util.adb (May_Generate_Large_Temp): Likewise.
(Safe_Unchecked_Type_Conversion): Do not take stack checking into
account to compute the result.

Diff:
---
 gcc/ada/exp_util.adb | 35 ---
 gcc/ada/exp_util.ads | 10 --
 2 files changed, 45 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cfbca9100174..3dcf98001eca 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11632,34 +11632,6 @@ package body Exp_Util is
   end if;
end Matching_Standard_Type;
 
-   -
-   -- May_Generate_Large_Temp --
-   -
-
-   --  At the current time, the only types that we return False for (i.e. where
-   --  we decide we know they cannot generate large temps) are ones where we
-   --  know the size is 256 bits or less at compile time, and we are still not
-   --  doing a thorough job on arrays and records.
-
-   function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean is
-   begin
-  if not Size_Known_At_Compile_Time (Typ) then
- return False;
-  end if;
-
-  if Known_Esize (Typ) and then Esize (Typ) <= 256 then
- return False;
-  end if;
-
-  if Is_Array_Type (Typ)
-and then Present (Packed_Array_Impl_Type (Typ))
-  then
- return May_Generate_Large_Temp (Packed_Array_Impl_Type (Typ));
-  end if;
-
-  return True;
-   end May_Generate_Large_Temp;
-
---
-- Move_To_Initialization_Statements --
---
@@ -13763,14 +13735,7 @@ package body Exp_Util is
   --  known size, but we can't consider them that way here, because we are
   --  talking about the actual size of the object.
 
-  --  We also make sure that in addition to the size being known, we do not
-  --  have a case which might generate an embarrassingly large temp in
-  --  stack checking mode.
-
   elsif Size_Known_At_Compile_Time (Otyp)
-and then
-  (not Stack_Checking_Enabled
-or else not May_Generate_Large_Temp (Otyp))
 and then not (Is_Record_Type (Otyp) and then not Is_Constrained (Otyp))
   then
  return True;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index b8b752523c3c..4226fcc93777 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -1064,16 +1064,6 @@ package Exp_Util is
--  typically return Standard_Short_Integer. For fixed-point types, this
--  will return integer types of the corresponding size.
 
-   function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean;
-   --  Determines if the given type, Typ, may require a large temporary of the
-   --  kind that causes back-end trouble if stack checking is enabled. The
-   --  result is True only the size of the type is known at compile time and
-   --  large, where large is defined heuristically by the body of this routine.
-   --  The purpose of this routine is to help avoid generating troublesome
-   --  temporaries that interfere with stack checking mechanism. Note that the
-   --  caller has to check whether stack checking is actually enabled in order
-   --  to guide the expansion (typically of a function call).
-
procedure Move_To_Initialization_Statements (Decl, Stop : Node_Id);
--  Decl is an N_Object_Declaration node and Stop is a node past Decl in
--  the same list. Move all the nodes on the list between Decl and Stop

[gcc r15-10050] ada: exp_util.adb: prevent infinite loop in case of broken code

[Eric Botcazou via Gcc-cvs]

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

commit r15-10050-ge28f90fcc8d8eafcae7fe5bd3ea18cfc194e7d6b
Author: Ghjuvan Lacambre 
Date:   Wed Jul 2 09:11:03 2025 +0200

ada: exp_util.adb: prevent infinite loop in case of broken code

A recent commit modified exp_util.adb in order to fix the selection of
Finalize subprograms in the case of untagged objects.
This introduced regressions for GNATSAS in fixedbugs by causing
GNAT2SCIL to loop over the same type over and over in case of broken
code.
We fix this by simply checking that the loop is making progress, and if
it doesn't, assume that we're done.

gcc/ada/ChangeLog:

* exp_util.adb (Finalize_Address): Prevent infinite loop

Diff:
---
 gcc/ada/exp_util.adb | 9 +++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 90de6962a1bc..b3dbe98e02bd 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6081,12 +6081,17 @@ package body Exp_Util is
 
  else
 declare
-   Root : constant Entity_Id := Underlying_Type (Root_Type (Btyp));
+   Root  : constant Entity_Id :=
+ Underlying_Type (Root_Type (Btyp));
+   Prev_Utyp : Entity_Id := Empty;
 begin
if Is_Protected_Type (Root) then
   Utyp := Corresponding_Record_Type (Root);
else
-  while No (TSS (Utyp, TSS_Finalize_Address)) loop
+  while No (TSS (Utyp, TSS_Finalize_Address))
+and then Utyp /= Prev_Utyp
+  loop
+ Prev_Utyp := Utyp;
  Utyp := Underlying_Type (Base_Type (Etype (Utyp)));
   end loop;
end if;

[gcc r15-10055] ada: Fix generation of Initialize and Adjust calls

[Eric Botcazou via Gcc-cvs]

https://gcc.gnu.org/g:381d0146e71fb8066d4058083b535848746feec3

commit r15-10055-g381d0146e71fb8066d4058083b535848746feec3
Author: Ronan Desplanques 
Date:   Wed Jul 9 10:19:00 2025 +0200

ada: Fix generation of Initialize and Adjust calls

Before this patch, Make_Init_Call and Make_Adjust_Call made the
assumption that if the type they were called with was untagged and a
derived type, it was the untagged private view of a tagged type. That
assumption made it possible to inspect the root type's primitives to
handle the case where the underlying type was implicitly generated by
the compiler without all inherited primitives.

The introduction of the Finalizable aspect broke that assumption, so
this patch adds a new field to type entities that make the generated
full view stand out, and updates Make_Init_Call and Make_Adjust_Call to
only jump to the root type when they're passed one of those generated
types.

Make_Final_Call and Finalize_Address are two other subprograms that
perform the same test on the types they're passed. They did not suffer
from the same bug as Make_Init_Call and Make_Adjust_Call because of an
earlier, more ad hoc fix, but this patch switches them over to the newly
introduced mechanism for the sake of consistency.

gcc/ada/ChangeLog:

* gen_il-fields.ads (Is_Implicit_Full_View): New field.
* gen_il-gen-gen_entities.adb (Type_Kind): Use new field.
* einfo.ads (Is_Implicit_Full_View): Document new field.
* exp_ch7.adb (Make_Adjust_Call, Make_Init_Call, Make_Final_Call): 
Use
new field.
* exp_util.adb (Finalize_Address): Likewise.
* sem_ch3.adb (Copy_And_Build): Set new field.

Diff:
---
 gcc/ada/einfo.ads   |  4 
 gcc/ada/exp_ch7.adb | 24 +---
 gcc/ada/exp_util.adb| 23 ++-
 gcc/ada/gen_il-fields.ads   |  1 +
 gcc/ada/gen_il-gen-gen_entities.adb |  1 +
 gcc/ada/sem_ch3.adb | 20 +++-
 6 files changed, 36 insertions(+), 37 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7c05e532aea7..e3fcb13b649c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2781,6 +2781,10 @@ package Einfo is
 --   identifiers in standard library packages, and to implement the
 --   restriction No_Implementation_Identifiers.
 
+--Is_Implicit_Full_View
+--   Defined in types. Set on types that the compiler generates to act as
+--   full views of types that are derivations of private types.
+
 --Is_Imported
 --   Defined in all entities. Set if the entity is imported. For now we
 --   only allow the import of exceptions, functions, procedures, packages,
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 0f534af8a32f..ea7af3e449c2 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -5598,7 +5598,10 @@ package body Exp_Ch7 is
 
   --  Deal with untagged derivation of private views
 
-  if Present (Utyp) and then Is_Untagged_Derivation (Typ) then
+  if Present (Utyp)
+and then Is_Untagged_Derivation (Typ)
+and then Is_Implicit_Full_View (Utyp)
+  then
  Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
  Ref  := Unchecked_Convert_To (Utyp, Ref);
  Set_Assignment_OK (Ref);
@@ -7906,16 +7909,12 @@ package body Exp_Ch7 is
   if Is_Untagged_Derivation (Typ) then
  if Is_Protected_Type (Typ) then
 Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
+ elsif Is_Implicit_Full_View (Utyp) then
+Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
 
- else
-declare
-   Root : constant Entity_Id :=
- Underlying_Type (Root_Type (Base_Type (Typ)));
-begin
-   if Is_Protected_Type (Root) then
-  Utyp := Corresponding_Record_Type (Root);
-   end if;
-end;
+if Is_Protected_Type (Utyp) then
+   Utyp := Corresponding_Record_Type (Utyp);
+end if;
  end if;
 
  Ref := Unchecked_Convert_To (Utyp, Ref);
@@ -8480,7 +8479,10 @@ package body Exp_Ch7 is
 
   --  Deal with untagged derivation of private views
 
-  if Is_Untagged_Derivation (Typ) and then not Is_Conc then
+  if Is_Untagged_Derivation (Typ)
+and then not Is_Conc
+and then Is_Implicit_Full_View (Utyp)
+  then
  Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
  Ref  := Unchecked_Convert_To (Utyp, Ref);
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3dcf98001eca..5f644ef2503c 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6079,23 +6079,12 @@ package body Exp_Util is
  if Is_Protected_Type (Btyp) then
 Utyp := Correspond

[gcc r15-10051] ada: Fix wrong indirect access to bit-packed array in iterated loop

[Eric Botcazou via Gcc-cvs]

https://gcc.gnu.org/g:633f73c006f94e13dea2a0d5a5423f632c25c38f

commit r15-10051-g633f73c006f94e13dea2a0d5a5423f632c25c38f
Author: Eric Botcazou 
Date:   Wed Jul 2 15:25:55 2025 +0200

ada: Fix wrong indirect access to bit-packed array in iterated loop

This comes from a missing expansion of the bit-packed array reference in
the loop, because the actual subtype created for the dereference lacks a
Packed_Array_Impl_Type as it is ultimately created by the Preanalyze_Range
call present in Analyze_Loop_Statement.

gcc/ada/ChangeLog:

* sem_util.adb (Get_Actual_Subtype): Only create a new subtype when
the expander is active.  Remove a useless test of type inequality,
as well as a useless call to Set_Has_Delayed_Freeze on the subtype.

Diff:
---
 gcc/ada/sem_util.adb | 60 ++--
 1 file changed, 21 insertions(+), 39 deletions(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 7757e04b2a1f..3fced544fb5f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -9990,16 +9990,19 @@ package body Sem_Util is
and then not Has_Unknown_Discriminants (Utyp)
and then not (Ekind (Utyp) = E_String_Literal_Subtype)
   then
- --  Nothing to do if in spec expression (why not???)
+ --  If the type has no discriminants, there is no subtype to build,
+ --  even if the underlying type is discriminated.
 
- if In_Spec_Expression then
+ if Is_Private_Type (Typ) and then not Has_Discriminants (Typ) then
 return Typ;
 
- elsif Is_Private_Type (Typ) and then not Has_Discriminants (Typ) then
-
---  If the type has no discriminants, there is no subtype to
---  build, even if the underlying type is discriminated.
+ --  If we are performing preanalysis on a conjured-up copy of a name
+ --  (see calls to Preanalyze_Range in sem_ch5.adb) then we don't want
+ --  to freeze Atyp, now or ever. In this case, the tree we eventually
+ --  pass to the back end should contain no references to Atyp (and a
+ --  freeze node would contain such a reference).
 
+ elsif not Expander_Active then
 return Typ;
 
  --  Else build the actual subtype
@@ -10015,42 +10018,21 @@ package body Sem_Util is
 
 Atyp := Defining_Identifier (Decl);
 
---  If Build_Actual_Subtype generated a new declaration then use it
-
-if Atyp /= Typ then
-
-   --  The actual subtype is an Itype, so analyze the declaration,
-   --  but do not attach it to the tree, to get the type defined.
-
-   Set_Parent (Decl, N);
-   Set_Is_Itype (Atyp);
-   Analyze (Decl, Suppress => All_Checks);
-   Set_Associated_Node_For_Itype (Atyp, N);
-   if Expander_Active then
-  Set_Has_Delayed_Freeze (Atyp, False);
-
-  --  We need to freeze the actual subtype immediately. This is
-  --  needed because otherwise this Itype will not get frozen
-  --  at all; it is always safe to freeze on creation because
-  --  any associated types must be frozen at this point.
+--  The actual subtype is an Itype, so analyze the declaration
+--  after attaching it to the tree, to get the type defined.
 
-  --  On the other hand, if we are performing preanalysis on
-  --  a conjured-up copy of a name (see calls to
-  --  Preanalyze_Range in sem_ch5.adb) then we don't want
-  --  to freeze Atyp, now or ever. In this case, the tree
-  --  we eventually pass to the back end should contain no
-  --  references to Atyp (and a freeze node would contain
-  --  such a reference). That's why Expander_Active is tested.
+Set_Parent (Decl, N);
+Set_Is_Itype (Atyp);
+Analyze (Decl, Suppress => All_Checks);
+Set_Associated_Node_For_Itype (Atyp, N);
 
-  Freeze_Itype (Atyp, N);
-   end if;
-   return Atyp;
-
---  Otherwise we did not build a declaration, so return original
+--  We need to freeze the actual subtype immediately. This is
+--  needed because otherwise this Itype will not get frozen
+--  at all; it is always safe to freeze on creation because
+--  any associated types must be frozen at this point.
 
-else
-   return Typ;
-end if;
+Freeze_Itype (Atyp, N);
+return Atyp;
  end if;
 
   --  For all remaining cases, the actual subtype is the same as

[gcc r16-2422] tree-optimization/121202 - fix vector stmt placement

[Richard Biener via Gcc-cvs]

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

commit r16-2422-gbdfb5cc5aa6959a6959fc0cf98da08db89c81032
Author: Richard Biener 
Date:   Tue Jul 22 13:02:03 2025 +0200

tree-optimization/121202 - fix vector stmt placement

When we have a vector shift with a scalar the shift operand can be
external - in that case we should not use the shift operand def
as hint where to place the vector shift instruction.  The ICE
in the PR is because stmt dominance queries only work inside of
the vector region.  But we should also never place stmts outside
of it.

PR tree-optimization/121202
* tree-vect-slp.cc (vect_schedule_slp_node): Do not take
an out-of-region stmt as "last".

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

Diff:
---
 gcc/testsuite/gcc.dg/pr121202.c | 11 +++
 gcc/tree-vect-slp.cc|  6 +-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/gcc/testsuite/gcc.dg/pr121202.c b/gcc/testsuite/gcc.dg/pr121202.c
new file mode 100644
index ..30ecf4a5e01a
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr121202.c
@@ -0,0 +1,11 @@
+/* { dg-do compile } */
+/* { dg-options "-O3 -fno-tree-copy-prop" } */
+
+int a, b, c;
+int e(int f, int g) { return f >> g; }
+int h(int f) { return a > 1 ? 0 : f << a; }
+int main() {
+  while (c--)
+b = e(h(1), a);
+  return 0;
+}
diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc
index 7ad56b9a848a..7776b2f1d8e6 100644
--- a/gcc/tree-vect-slp.cc
+++ b/gcc/tree-vect-slp.cc
@@ -11370,7 +11370,11 @@ vect_schedule_slp_node (vec_info *vinfo,
  && !SSA_NAME_IS_DEFAULT_DEF (def))
{
  gimple *stmt = SSA_NAME_DEF_STMT (def);
- if (!last_stmt)
+ if (gimple_uid (stmt) == -1u)
+   /* If the stmt is not inside the region do not
+  use it as possible insertion point.  */
+   ;
+ else if (!last_stmt)
last_stmt = stmt;
  else if (vect_stmt_dominates_stmt_p (last_stmt, stmt))
last_stmt = stmt;

[gcc r15-10043] Add 'libgomp.c++/target-flex-[...].C' test cases

[Thomas Schwinge via Gcc-cvs]

https://gcc.gnu.org/g:259451b07145c4920c866a246d158c13d6996057

commit r15-10043-g259451b07145c4920c866a246d158c13d6996057
Author: Waffl3x 
Date:   Mon May 26 02:38:27 2025 -0600

Add 'libgomp.c++/target-flex-[...].C' test cases

libgomp/ChangeLog:

* testsuite/libgomp.c++/target-flex-10.C: New test.
* testsuite/libgomp.c++/target-flex-100.C: New test.
* testsuite/libgomp.c++/target-flex-101.C: New test.
* testsuite/libgomp.c++/target-flex-11.C: New test.
* testsuite/libgomp.c++/target-flex-12.C: New test.
* testsuite/libgomp.c++/target-flex-2000.C: New test.
* testsuite/libgomp.c++/target-flex-2001.C: New test.
* testsuite/libgomp.c++/target-flex-2002.C: New test.
* testsuite/libgomp.c++/target-flex-2003.C: New test.
* testsuite/libgomp.c++/target-flex-30.C: New test.
* testsuite/libgomp.c++/target-flex-300.C: New test.
* testsuite/libgomp.c++/target-flex-31.C: New test.
* testsuite/libgomp.c++/target-flex-32.C: New test.
* testsuite/libgomp.c++/target-flex-33.C: New test.
* testsuite/libgomp.c++/target-flex-41.C: New test.
* testsuite/libgomp.c++/target-flex-60.C: New test.
* testsuite/libgomp.c++/target-flex-61.C: New test.
* testsuite/libgomp.c++/target-flex-62.C: New test.
* testsuite/libgomp.c++/target-flex-70.C: New test.
* testsuite/libgomp.c++/target-flex-80.C: New test.
* testsuite/libgomp.c++/target-flex-81.C: New test.
* testsuite/libgomp.c++/target-flex-90.C: New test.
* testsuite/libgomp.c++/target-flex-common.h: New test.

Co-authored-by: Thomas Schwinge 
(cherry picked from commit 28a5bc2d4f7ae345234a15e22fd65cfad851cf04)

Diff:
---
 libgomp/testsuite/libgomp.c++/target-flex-10.C | 215 ++
 libgomp/testsuite/libgomp.c++/target-flex-100.C| 210 ++
 libgomp/testsuite/libgomp.c++/target-flex-101.C| 136 
 libgomp/testsuite/libgomp.c++/target-flex-11.C | 444 +
 libgomp/testsuite/libgomp.c++/target-flex-12.C | 736 +
 libgomp/testsuite/libgomp.c++/target-flex-2000.C   |  32 +
 libgomp/testsuite/libgomp.c++/target-flex-2001.C   |  61 ++
 libgomp/testsuite/libgomp.c++/target-flex-2002.C   |  97 +++
 libgomp/testsuite/libgomp.c++/target-flex-2003.C   | 176 +
 libgomp/testsuite/libgomp.c++/target-flex-30.C |  51 ++
 libgomp/testsuite/libgomp.c++/target-flex-300.C|  49 ++
 libgomp/testsuite/libgomp.c++/target-flex-31.C |  80 +++
 libgomp/testsuite/libgomp.c++/target-flex-32.C |  50 ++
 libgomp/testsuite/libgomp.c++/target-flex-33.C |  52 ++
 libgomp/testsuite/libgomp.c++/target-flex-41.C |  94 +++
 libgomp/testsuite/libgomp.c++/target-flex-60.C |  46 ++
 libgomp/testsuite/libgomp.c++/target-flex-61.C |  54 ++
 libgomp/testsuite/libgomp.c++/target-flex-62.C |  50 ++
 libgomp/testsuite/libgomp.c++/target-flex-70.C |  26 +
 libgomp/testsuite/libgomp.c++/target-flex-80.C |  49 ++
 libgomp/testsuite/libgomp.c++/target-flex-81.C |  75 +++
 libgomp/testsuite/libgomp.c++/target-flex-90.C | 107 +++
 libgomp/testsuite/libgomp.c++/target-flex-common.h |  40 ++
 23 files changed, 2930 insertions(+)

diff --git a/libgomp/testsuite/libgomp.c++/target-flex-10.C 
b/libgomp/testsuite/libgomp.c++/target-flex-10.C
new file mode 100644
index ..8fa9af7e4140
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/target-flex-10.C
@@ -0,0 +1,215 @@
+/* Basic container usage.  */
+
+#include 
+#include 
+#include 
+#include 
+#include 
+#if __cplusplus >= 201103L
+#include 
+#include 
+#include 
+#include 
+#endif
+
+bool vector_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::vector vector;
+  ok = vector.empty();
+}
+  return ok;
+}
+
+bool deque_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::deque deque;
+  ok = deque.empty();
+}
+  return ok;
+}
+
+bool list_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::list list;
+  ok = list.empty();
+}
+  return ok;
+}
+
+bool map_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::map map;
+  ok = map.empty();
+}
+  return ok;
+}
+
+bool set_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::set set;
+  ok = set.empty();
+}
+  return ok;
+}
+
+bool multimap_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::multimap multimap;
+  ok = multimap.empty();
+}
+  return ok;
+}
+
+bool multiset_test()
+{
+  bool ok;
+  #pragma omp target map(from: ok)
+{
+  std::multiset multiset;
+  ok = multiset.empty();
+}
+  return ok;
+}
+
+#if __cplusplus >= 201103L
+
+bool array_test()
+{
+  static constexpr std::size_t array_size = 42;
+  bool ok;
+  #pra

[gcc r15-10045] libgomp: Add testcases for concurrent access to standard C++ containers on offload targets

[Thomas Schwinge via Gcc-cvs]

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

commit r15-10045-ga7c5f7ac5e7f7cede5d5c33c44d58cb28a79
Author: Kwok Cheung Yeung 
Date:   Thu May 8 20:41:16 2025 +0100

libgomp: Add testcases for concurrent access to standard C++ containers on 
offload targets

libgomp/

* testsuite/libgomp.c++/target-std__array-concurrent.C: New.
* testsuite/libgomp.c++/target-std__bitset-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__deque-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__flat_map-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__flat_multimap-concurrent.C: 
Likewise.
* testsuite/libgomp.c++/target-std__flat_multiset-concurrent.C: 
Likewise.
* testsuite/libgomp.c++/target-std__flat_set-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__forward_list-concurrent.C: 
Likewise.
* testsuite/libgomp.c++/target-std__list-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__map-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__multimap-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__multiset-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__set-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__span-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__unordered_map-concurrent.C: 
Likewise.
* 
testsuite/libgomp.c++/target-std__unordered_multimap-concurrent.C: Likewise.
* 
testsuite/libgomp.c++/target-std__unordered_multiset-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__unordered_set-concurrent.C: 
Likewise.
* testsuite/libgomp.c++/target-std__valarray-concurrent.C: Likewise.
* testsuite/libgomp.c++/target-std__vector-concurrent.C: Likewise.

Co-authored-by: Thomas Schwinge 
(cherry picked from commit a811d1d72261da58196ccec253fd2bdb10e999db)

Diff:
---
 .../libgomp.c++/target-std__array-concurrent.C | 60 
 .../libgomp.c++/target-std__bitset-concurrent.C| 67 ++
 .../libgomp.c++/target-std__deque-concurrent.C | 62 +
 .../libgomp.c++/target-std__flat_map-concurrent.C  | 71 +++
 .../target-std__flat_multimap-concurrent.C | 70 +++
 .../target-std__flat_multiset-concurrent.C | 60 
 .../libgomp.c++/target-std__flat_set-concurrent.C  | 67 ++
 .../target-std__forward_list-concurrent.C  | 81 ++
 .../libgomp.c++/target-std__list-concurrent.C  | 81 ++
 .../libgomp.c++/target-std__map-concurrent.C   | 66 ++
 .../libgomp.c++/target-std__multimap-concurrent.C  | 64 +
 .../libgomp.c++/target-std__multiset-concurrent.C  | 60 
 .../libgomp.c++/target-std__set-concurrent.C   | 66 ++
 .../libgomp.c++/target-std__span-concurrent.C  | 62 +
 .../target-std__unordered_map-concurrent.C | 66 ++
 .../target-std__unordered_multimap-concurrent.C| 65 +
 .../target-std__unordered_multiset-concurrent.C| 59 
 .../target-std__unordered_set-concurrent.C | 66 ++
 .../libgomp.c++/target-std__valarray-concurrent.C  | 64 +
 .../libgomp.c++/target-std__vector-concurrent.C| 61 
 20 files changed, 1318 insertions(+)

diff --git a/libgomp/testsuite/libgomp.c++/target-std__array-concurrent.C 
b/libgomp/testsuite/libgomp.c++/target-std__array-concurrent.C
new file mode 100644
index ..e97bfe60a615
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/target-std__array-concurrent.C
@@ -0,0 +1,60 @@
+// { dg-do run }
+// { dg-additional-options -DMEM_SHARED { target offload_device_shared_as } }
+
+#include 
+#include 
+#include 
+#include 
+
+#define N 5
+
+void init (int data[])
+{
+  for (int i = 0; i < N; ++i)
+data[i] = rand ();
+}
+
+#pragma omp declare target
+bool validate (const std::array &arr, int data[])
+{
+  for (int i = 0; i < N; ++i)
+if (arr[i] != data[i] * data[i])
+  return false;
+  return true;
+}
+#pragma omp end declare target
+
+int main (void)
+{
+  int data[N];
+  bool ok;
+  std::array arr;
+
+  srand (time (NULL));
+  init (data);
+
+  #pragma omp target data map (to: data[:N]) map (alloc: arr)
+{
+  #pragma omp target
+   {
+#ifndef MEM_SHARED
+ new (&arr) std::array ();
+#endif
+ std::copy (data, data + N, arr.begin ());
+   }
+
+  #pragma omp target teams distribute parallel for
+   for (int i = 0; i < N; ++i)
+ arr[i] *= arr[i];
+
+  #pragma omp target map (from: ok)
+   {
+ ok = validate (arr, data);
+#ifndef MEM_SHARED
+ arr.~array ();
+#endif

[gcc r15-10042] Defuse 'RESULT_DECL' check in 'pass_nrv' (for offloading compilation) [PR119835]

[Thomas Schwinge via Gcc-cvs]

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

commit r15-10042-ge4dbeb01fc816a8fca9d9dcb3fd66ce6e6137fa2
Author: Thomas Schwinge 
Date:   Wed May 28 18:40:31 2025 +0200

Defuse 'RESULT_DECL' check in 'pass_nrv' (for offloading compilation) 
[PR119835]

... to avoid running into ICEs per PR119835, until that's resolved properly.

PR middle-end/119835
gcc/
* tree-nrv.cc (pass_nrv::execute): Defuse 'RESULT_DECL' check.
libgomp/
* testsuite/libgomp.oacc-c-c++-common/abi-struct-1.c:
'#pragma GCC optimize "-fno-inline"'.
* testsuite/libgomp.c-c++-common/target-abi-struct-1.c: New.
* testsuite/libgomp.c-c++-common/target-abi-struct-1-O0.c: Adjust.

Co-authored-by: Richard Biener 
(cherry picked from commit 543f7e1d59f0b6628e0de6610ad5e1cf7150090b)

Diff:
---
 gcc/tree-nrv.cc   | 19 ---
 .../libgomp.c-c++-common/target-abi-struct-1-O0.c |  2 +-
 .../libgomp.c-c++-common/target-abi-struct-1.c|  1 +
 .../libgomp.oacc-c-c++-common/abi-struct-1.c  |  6 +-
 4 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/gcc/tree-nrv.cc b/gcc/tree-nrv.cc
index 180ce39de4c5..3be97afb319e 100644
--- a/gcc/tree-nrv.cc
+++ b/gcc/tree-nrv.cc
@@ -167,16 +167,21 @@ pass_nrv::execute (function *fun)
   for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi))
{
  gimple *stmt = gsi_stmt (gsi);
- tree ret_val;
 
  if (greturn *return_stmt = dyn_cast  (stmt))
{
- /* In a function with an aggregate return value, the
-gimplifier has changed all non-empty RETURN_EXPRs to
-return the RESULT_DECL.  */
- ret_val = gimple_return_retval (return_stmt);
- if (ret_val)
-   gcc_assert (ret_val == result);
+ /* We cannot perform NRV optimizations in a function with an
+aggregate return value if there is a return that does not
+return RESULT_DECL.  We used to assert this scenario doesn't
+happen: the gimplifier has changed all non-empty RETURN_EXPRs
+to return the RESULT_DECL.  However, per PR119835 we may run
+into this scenario for offloading compilation, and therefore
+gracefully bail out.  */
+ if (tree ret_val = gimple_return_retval (return_stmt))
+   {
+ if (ret_val != result)
+   return 0;
+   }
}
  else if (gimple_has_lhs (stmt)
   && gimple_get_lhs (stmt) == result)
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1-O0.c 
b/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1-O0.c
index 35ec75d648d3..9bf949a1f066 100644
--- a/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1-O0.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1-O0.c
@@ -1,3 +1,3 @@
 /* { dg-additional-options -O0 } */
 
-#include "../libgomp.oacc-c-c++-common/abi-struct-1.c"
+#include "target-abi-struct-1.c"
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1.c 
b/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1.c
new file mode 100644
index ..d9268af55cfe
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-abi-struct-1.c
@@ -0,0 +1 @@
+#include "../libgomp.oacc-c-c++-common/abi-struct-1.c"
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/abi-struct-1.c 
b/libgomp/testsuite/libgomp.oacc-c-c++-common/abi-struct-1.c
index 80786555fe21..4b541711f363 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/abi-struct-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/abi-struct-1.c
@@ -1,6 +1,10 @@
 /* Inspired by 'gcc.target/nvptx/abi-struct-arg.c', 
'gcc.target/nvptx/abi-struct-ret.c'.  */
 
-/* See also '../libgomp.c-c++-common/target-abi-struct-1-O0.c'.  */
+/* See also '../libgomp.c-c++-common/target-abi-struct-1.c'.  */
+
+/* To exercise PR119835 (if optimizations enabled): disable inlining, so that
+   GIMPLE passes still see the functions that return aggregate types.  */
+#pragma GCC optimize "-fno-inline"
 
 typedef struct {} empty;  /* See 'gcc/doc/extend.texi', "Empty Structures".  */
 typedef struct {char a;} schar;

[gcc r15-10049] OpenMP: Fix implicit 'declare target' for

[Thomas Schwinge via Gcc-cvs]

https://gcc.gnu.org/g:9023bcd0d68c1ba7faebc9edb6db34537b2a7966

commit r15-10049-g9023bcd0d68c1ba7faebc9edb6db34537b2a7966
Author: Tobias Burnus 
Date:   Tue Jun 17 11:33:09 2025 +0200

OpenMP: Fix implicit 'declare target' for 

libstdc++-v3/include/std/ostream contains:

  namespace std _GLIBCXX_VISIBILITY(default)
  {
...
template
  inline basic_ostream<_CharT, _Traits>&
  endl(basic_ostream<_CharT, _Traits>& __os)
  { return flush(__os.put(__os.widen('\n'))); }
  ...
  #include 

and the latter, libstdc++-v3/include/bits/ostream.tcc, has:
// Inhibit implicit instantiations for required instantiations,
// which are defined via explicit instantiations elsewhere.
  #if _GLIBCXX_EXTERN_TEMPLATE
extern template class basic_ostream;
extern template ostream& endl(ostream&);

Before this commit, omp_discover_declare_target_tgt_fn_r marked 'endl'
as (implicitly) declare target - but not the calls in it due to the
'extern' (DECL_EXTERNAL).

Thanks to inlining and as 'endl' is (therefore) not used and, hence,
discarded by the linker; hencet, it works with -O0 and -O1. However,
as the (unused) function still exits, IPA CP (enabled by -O2) will try
to do constant-value propagation and fails as the definition of 'widen'
is not available.

Solution is to still walk 'endl' despite being an 'extern(al)' decl;
this has been restricted for now to DECL_DECLARED_INLINE_P.

gcc/ChangeLog:

* omp-offload.cc (omp_discover_declare_target_tgt_fn_r): Also
walk external functions that are declare inline (and have a
DECL_SAVED_TREE).

libgomp/ChangeLog:

* testsuite/libgomp.c++/declare_target-2.C: New test.

(cherry picked from commit ea43b99537591b1103da3961c61f1cbfae968859)

Diff:
---
 gcc/omp-offload.cc   |  3 ++-
 libgomp/testsuite/libgomp.c++/declare_target-2.C | 25 
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/gcc/omp-offload.cc b/gcc/omp-offload.cc
index da2b54b76485..d88edb29a0e8 100644
--- a/gcc/omp-offload.cc
+++ b/gcc/omp-offload.cc
@@ -261,7 +261,8 @@ omp_discover_declare_target_tgt_fn_r (tree *tp, int 
*walk_subtrees, void *data)
   DECL_ATTRIBUTES (decl)))
return NULL_TREE;
 
-  if (!DECL_EXTERNAL (decl) && DECL_SAVED_TREE (decl))
+  if (DECL_SAVED_TREE (decl)
+ && (!DECL_EXTERNAL (decl) || DECL_DECLARED_INLINE_P (decl)))
((vec *) data)->safe_push (decl);
   DECL_ATTRIBUTES (decl) = tree_cons (id, NULL_TREE,
  DECL_ATTRIBUTES (decl));
diff --git a/libgomp/testsuite/libgomp.c++/declare_target-2.C 
b/libgomp/testsuite/libgomp.c++/declare_target-2.C
new file mode 100644
index ..ab94a5568881
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare_target-2.C
@@ -0,0 +1,25 @@
+// { dg-do link }
+
+// Actually not needed: -fipa-cp is default with -O2:
+// { dg-additional-options "-O2 -fipa-cp" }
+
+// The code failed because 'std::endl' becoḿes implicitly 'declare target'
+// but not the 'widen' function it calls.  While the linker had no issues
+// (endl is never called, either because it is inlined or optimized away),
+// the IPA-CP (enabled by -O2 and higher) failed as the definition for
+// 'widen' did not exist on the offload side.
+
+#include 
+
+void func (int m)
+{
+  if (m < 0)
+std::cout << "should not happen" << std::endl;
+}
+
+
+int main()
+{
+  #pragma omp target
+func (1);
+}

[gcc r15-10035] nvptx: Support '-mptx=5.0'

[Thomas Schwinge via Gcc-cvs]

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

commit r15-10035-g2b105cb91a67b4343828f258df17d5b1c1a52143
Author: Thomas Schwinge 
Date:   Wed May 7 15:37:17 2025 +0200

nvptx: Support '-mptx=5.0'

gcc/
* config/nvptx/nvptx-opts.h (enum ptx_version): Add
'PTX_VERSION_5_0'.
* config/nvptx/nvptx.cc (ptx_version_to_string)
(ptx_version_to_number): Adjust.
* config/nvptx/nvptx.h (TARGET_PTX_5_0): New.
* config/nvptx/nvptx.opt (Enum(ptx_version)): Add 'EnumValue'
'5.0' for 'PTX_VERSION_5_0'.
* doc/invoke.texi (Nvidia PTX Options): Document '-mptx=5.0'.
gcc/testsuite/
* gcc.target/nvptx/mptx=5.0.c: New.

(cherry picked from commit 97616687149f115e0ab946b9a05a9f8c1e47429e)

Diff:
---
 gcc/config/nvptx/nvptx-opts.h |  1 +
 gcc/config/nvptx/nvptx.cc |  4 
 gcc/config/nvptx/nvptx.h  |  1 +
 gcc/config/nvptx/nvptx.opt|  3 +++
 gcc/doc/invoke.texi   |  1 +
 gcc/testsuite/gcc.target/nvptx/mptx=5.0.c | 19 +++
 6 files changed, 29 insertions(+)

diff --git a/gcc/config/nvptx/nvptx-opts.h b/gcc/config/nvptx/nvptx-opts.h
index d8867017892b..07bcd32d55c0 100644
--- a/gcc/config/nvptx/nvptx-opts.h
+++ b/gcc/config/nvptx/nvptx-opts.h
@@ -40,6 +40,7 @@ enum ptx_version
   PTX_VERSION_3_1,
   PTX_VERSION_4_1,
   PTX_VERSION_4_2,
+  PTX_VERSION_5_0,
   PTX_VERSION_6_0,
   PTX_VERSION_6_3,
   PTX_VERSION_7_0,
diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc
index f8939715dee2..d5827074f65a 100644
--- a/gcc/config/nvptx/nvptx.cc
+++ b/gcc/config/nvptx/nvptx.cc
@@ -268,6 +268,8 @@ ptx_version_to_string (enum ptx_version v)
   return "4.1";
 case PTX_VERSION_4_2:
   return "4.2";
+case PTX_VERSION_5_0:
+  return "5.0";
 case PTX_VERSION_6_0:
   return "6.0";
 case PTX_VERSION_6_3:
@@ -294,6 +296,8 @@ ptx_version_to_number (enum ptx_version v, bool major_p)
   return major_p ? 4 : 1;
 case PTX_VERSION_4_2:
   return major_p ? 4 : 2;
+case PTX_VERSION_5_0:
+  return major_p ? 5 : 0;
 case PTX_VERSION_6_0:
   return major_p ? 6 : 0;
 case PTX_VERSION_6_3:
diff --git a/gcc/config/nvptx/nvptx.h b/gcc/config/nvptx/nvptx.h
index 35ef4bdbd5e6..a2bb2fb50ff8 100644
--- a/gcc/config/nvptx/nvptx.h
+++ b/gcc/config/nvptx/nvptx.h
@@ -101,6 +101,7 @@
PTX ISA Version 3.1.  */
 #define TARGET_PTX_4_1 (ptx_version_option >= PTX_VERSION_4_1)
 #define TARGET_PTX_4_2 (ptx_version_option >= PTX_VERSION_4_2)
+#define TARGET_PTX_5_0 (ptx_version_option >= PTX_VERSION_5_0)
 #define TARGET_PTX_6_0 (ptx_version_option >= PTX_VERSION_6_0)
 #define TARGET_PTX_6_3 (ptx_version_option >= PTX_VERSION_6_3)
 #define TARGET_PTX_7_0 (ptx_version_option >= PTX_VERSION_7_0)
diff --git a/gcc/config/nvptx/nvptx.opt b/gcc/config/nvptx/nvptx.opt
index ce9fbc7312e0..d53a7271873c 100644
--- a/gcc/config/nvptx/nvptx.opt
+++ b/gcc/config/nvptx/nvptx.opt
@@ -133,6 +133,9 @@ Enum(ptx_version) String(4.1) Value(PTX_VERSION_4_1)
 EnumValue
 Enum(ptx_version) String(4.2) Value(PTX_VERSION_4_2)
 
+EnumValue
+Enum(ptx_version) String(5.0) Value(PTX_VERSION_5_0)
+
 EnumValue
 Enum(ptx_version) String(6.0) Value(PTX_VERSION_6_0)
 
diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi
index dae5e2f8b880..33adf6fd64ce 100644
--- a/gcc/doc/invoke.texi
+++ b/gcc/doc/invoke.texi
@@ -30685,6 +30685,7 @@ Generate code for the specified PTX ISA version.
 Valid version strings are
 @samp{3.1},
 @samp{4.1}, @samp{4.2},
+@samp{5.0},
 @samp{6.0}, @samp{6.3},
 @samp{7.0}, @samp{7.3}, and @samp{7.8}.
 The default PTX ISA version is the one that added support for the
diff --git a/gcc/testsuite/gcc.target/nvptx/mptx=5.0.c 
b/gcc/testsuite/gcc.target/nvptx/mptx=5.0.c
new file mode 100644
index ..5d6163e6ba72
--- /dev/null
+++ b/gcc/testsuite/gcc.target/nvptx/mptx=5.0.c
@@ -0,0 +1,19 @@
+/* { dg-do assemble } */
+/* { dg-options {-march=sm_30 -mptx=5.0} } */
+/* { dg-additional-options -save-temps } */
+/* { dg-final { scan-assembler-times {(?n)^\.version   5\.0$} 1 } } */
+/* { dg-final { scan-assembler-times {(?n)^\.targetsm_30$} 1 } } */
+
+#if __PTX_ISA_VERSION_MAJOR__ != 5
+#error wrong value for __PTX_ISA_VERSION_MAJOR__
+#endif
+
+#if __PTX_ISA_VERSION_MINOR__ != 0
+#error wrong value for __PTX_ISA_VERSION_MINOR__
+#endif
+
+#if __PTX_SM__ != 300
+#error wrong value for __PTX_SM__
+#endif
+
+int dummy;

[gcc r15-10048] Avoid SIGSEGV in nvptx 'mkoffload' for voluminous PTX code

[Thomas Schwinge via Gcc-cvs]

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

commit r15-10048-gdd10f193a877a45c16682b4b9ee58bdc281859ff
Author: Thomas Schwinge 
Date:   Mon May 26 13:31:54 2025 +0200

Avoid SIGSEGV in nvptx 'mkoffload' for voluminous PTX code

In commit 50be486dff4ea2676ed022e9524ef190b92ae2b1
"nvptx: libgomp+mkoffload.cc: Prepare for reverse offload fn lookup", some
additional tracking of the PTX code was added, and this assumes that
potentially every single character of PTX code needs to be tracked as a new
chunk of PTX code.  That's problematic if we're dealing with voluminous PTX
code (for example, non-trivial C++ code), and the 'file_idx' 'alloca'tion 
then
causes stack overflow.  For example:

FAIL: libgomp.c++/target-std__valarray-1.C (test for excess errors)
UNRESOLVED: libgomp.c++/target-std__valarray-1.C compilation failed to 
produce executable

lto-wrapper: fatal error: 
[...]/build-gcc/gcc//accel/nvptx-none/mkoffload terminated with signal 11 
[Segmentation fault], core dumped

gcc/
* config/nvptx/mkoffload.cc (process): Use an 'auto_vec' for
'file_idx'.

(cherry picked from commit 01044e0ee27093a3990996578b15f6ab69ed3395)

Diff:
---
 gcc/config/nvptx/mkoffload.cc | 12 +---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/gcc/config/nvptx/mkoffload.cc b/gcc/config/nvptx/mkoffload.cc
index e7ec0ef4f6ac..bb3f0fcee6bd 100644
--- a/gcc/config/nvptx/mkoffload.cc
+++ b/gcc/config/nvptx/mkoffload.cc
@@ -260,8 +260,10 @@ process (FILE *in, FILE *out, uint32_t omp_requires)
   unsigned ix;
   const char *sm_ver = NULL, *version = NULL;
   const char *sm_ver2 = NULL, *version2 = NULL;
-  size_t file_cnt = 0;
-  size_t *file_idx = XALLOCAVEC (size_t, len);
+  /* To reduce the number of reallocations for 'file_idx', guess 'file_cnt'
+ (very roughly...), based on 'len'.  */
+  const size_t file_cnt_guessed = 13 + len / 27720;
+  auto_vec file_idx (file_cnt_guessed);
 
   fprintf (out, "#include \n\n");
 
@@ -269,9 +271,10 @@ process (FILE *in, FILE *out, uint32_t omp_requires)
  terminated by a NUL.  */
   for (size_t i = 0; i != len;)
 {
+  file_idx.safe_push (i);
+
   char c;
   bool output_fn_ptr = false;
-  file_idx[file_cnt++] = i;
 
   fprintf (out, "static const char ptx_code_%u[] =\n\t\"", obj_count++);
   while ((c = input[i++]))
@@ -349,6 +352,9 @@ process (FILE *in, FILE *out, uint32_t omp_requires)
}
 }
 
+  const size_t file_cnt = file_idx.length ();
+  gcc_checking_assert (file_cnt == obj_count);
+
   /* Create function-pointer array, required for reverse
  offload function-pointer lookup.  */

[gcc r16-2424] libstdc++: Make testsuite_iterators constexpr and expand inplace_vector tests [PR119137]

[Tomasz Kaminski via Gcc-cvs]

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

commit r16-2424-gf59cb28d53b62aa080da60617109440b303ceb2b
Author: Tomasz Kamiński 
Date:   Tue Jul 22 09:44:24 2025 +0200

libstdc++: Make testsuite_iterators constexpr and expand inplace_vector 
tests [PR119137]

All functions in testsuite_iterators.h are now marked constexpr,
targeting the earliest possible standard. Most functions use C++14 due
to multi-statement bodies, with exceptions:

* BoundsContainer and some constructors are C++11 compatible.
* OutputContainer is C++20 due to operator new/delete usage.

Before C++23, each constexpr templated function requires a constexpr
-suitable instantiation. Functions delegating to _GLIBCXX14_CONSTEXPR
must also be _GLIBCXX14_CONSTEXPR; e.g., forward_iterator_wrapper's
constructor calling input_iterator_wrapper's constructor, or
operator-> calling operator*.

For classes defined C++20 or later (e.g., test_range), constexpr is
applied unconditionally.

PR libstdc++/119137

libstdc++-v3/ChangeLog:

* testsuite/23_containers/inplace_vector/cons/from_range.cc: Run
iterators and range test at compile-time.
* testsuite/23_containers/inplace_vector/modifiers/assign.cc:
Likewise.
* testsuite/23_containers/inplace_vector/modifiers/multi_insert.cc:
Likewise.
* testsuite/util/testsuite_iterators.h (__gnu_test::BoundsContainer)
(__gnu_test::OutputContainer, __gnu_test::WritableObject)
(__gnu_test::output_iterator_wrapper, 
__gnu_test::input_iterator_wrapper)
(__gnu_test::forward_iterator_wrapper)
(__gnu_test::bidirectional_iterator_wrapper)
(__gnu_test::random_access_iterator_wrapper)
(__gnu_test::test_container): Add appropriate _GLIBCXXNN_CONSTEXPR
macros to member functions.
(__gnu_test::contiguous_iterator_wrapper)
(__gnu_test::input_iterator_wrapper_rval)
(__gnu_test::test_range, __gnu_test::test_range_nocopy)
(__gnu_test::test_sized_range_sized_sent)
(__gnu_test::test_sized_range): Add constexpr specifier to member
functions.

Diff:
---
 .../inplace_vector/cons/from_range.cc  |  33 ++--
 .../inplace_vector/modifiers/assign.cc |  43 +++--
 .../inplace_vector/modifiers/multi_insert.cc   |  47 +++---
 libstdc++-v3/testsuite/util/testsuite_iterators.h  | 173 +++--
 4 files changed, 179 insertions(+), 117 deletions(-)

diff --git 
a/libstdc++-v3/testsuite/23_containers/inplace_vector/cons/from_range.cc 
b/libstdc++-v3/testsuite/23_containers/inplace_vector/cons/from_range.cc
index 5fa8a5de312f..4a2f193e4a58 100644
--- a/libstdc++-v3/testsuite/23_containers/inplace_vector/cons/from_range.cc
+++ b/libstdc++-v3/testsuite/23_containers/inplace_vector/cons/from_range.cc
@@ -70,7 +70,7 @@ do_test_it()
 #endif
 }
 
-bool
+constexpr bool
 test_iterators()
 {
   using namespace __gnu_test;
@@ -131,7 +131,7 @@ do_test_r()
 #endif
 }
 
-bool
+constexpr bool
 test_ranges()
 {
   using namespace __gnu_test;
@@ -152,9 +152,9 @@ test_ranges()
 
   // Not lvalue-convertible to int
   struct C {
-C(int v) : val(v) { }
-operator int() && { return val; }
-bool operator==(int b) const { return b == val; }
+constexpr C(int v) : val(v) { }
+constexpr operator int() && { return val; }
+constexpr bool operator==(int b) const { return b == val; }
 int val;
   };
   using rvalue_input_range = test_range;
@@ -163,22 +163,15 @@ test_ranges()
   return true;
 }
 
-constexpr bool
-test_constexpr()
-{
-  // XXX: this doesn't test the non-forward_range code paths are constexpr.
-  std::initializer_list il{1, 2, 3, 4};
-  std::inplace_vector v(il.begin(), il.end());
-  eq(v, il);
-
-  do_test_r>();
-  return true;
-}
-
 int main()
 {
-  test_iterators();
-  test_ranges();
-  static_assert( test_constexpr() );
+  auto test_all = [] {
+test_iterators();
+test_ranges();
+return true;
+  };
+
+  test_all();
+  static_assert( test_all() );
 }
 
diff --git 
a/libstdc++-v3/testsuite/23_containers/inplace_vector/modifiers/assign.cc 
b/libstdc++-v3/testsuite/23_containers/inplace_vector/modifiers/assign.cc
index 91132be550ed..65b505e7f371 100644
--- a/libstdc++-v3/testsuite/23_containers/inplace_vector/modifiers/assign.cc
+++ b/libstdc++-v3/testsuite/23_containers/inplace_vector/modifiers/assign.cc
@@ -204,14 +204,10 @@ template
 constexpr void
 test_assign_empty()
 {
-  // TODO make test iterators consteval
-  if !consteval
-  {
-using namespace __gnu_test;
-test_assign_empty_it();
-test_assign_empty_it();
-test_assign_empty_it();
-  }
+  using namespace __gnu_test;
+  test_assign_empty_it();
+  test_assign_empty_it();
+  test_assign_empty_it();
 
   test_assign_empty_other;
 }
@@ -339,23 +335,20 @@ constexpr void
 test

[gcc] Deleted branch 'mikael/heads/refactor_descriptor_v08' in namespace 'refs/users'

[Mikael Morin via Gcc-cvs]

The branch 'mikael/heads/refactor_descriptor_v08' in namespace 'refs/users' was 
deleted.
It previously pointed to:

 29e382e1a33f... Extraction gfc_set_gfc_from_cfi

Diff:

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

  29e382e... Extraction gfc_set_gfc_from_cfi
  30a03e8... Refactoring gfc_conv_descriptor_sm_get
  ad9f0cb... Extraction gfc_conv_shift_subarray_descriptor
  779f46b... Factorisation set descriptor with shape
  98bf18e... Factorisation gfc_set_contiguous_descriptor
  ca181c1... Factorisation gfc_conv_shift_descriptor
  5c919d5... Extraction gfc_set_descriptor
  9ccab8e... Extraction gfc_copy_descriptor
  8b58d11... Extraction gfc_conv_shift_descriptor
  c6a34fd... Extraction gfc_conv_remap_descriptor
  55698e2... Extraction gfc_copy_sequence_descriptor
  535a44b... Extraction fonction gfc_nullify_descriptor
  07ebb64... Appel méthode shift descriptor dans gfc_trans_pointer_assi
  c121c97... Déplacement shift descriptor vers gfc_conv_array_parameter
  d8ba732... Suppression set_dtype_for_unallocated
  42b0900... Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_nu
  5c581cf... Extraction gfc_init_absent_descriptor
  be7b8b0... Extraction gfc_init_static_descriptor
  ee977c6... Extraction gfc_build_default_class_descriptor
  1a2b158... Suppression initialisation span pour les pointeurs
  523363d... Introduction gfc_init_descriptor_result
  a507baa... Modif gfc_init_descriptor_variable
  2dd8973... Introduction gfc_symbol_attr
  ac326e1... Extraction gfc_init_descriptor_variable
  b7b4a23... Ajout locations setters
  889dea5... Refactoring getters & setters
  dea29b4... Interdiction non-lvalue as lhs
  7354fc4... Ajout non_lvalue getters.
  9167d2a... Utilisation gfc_conv_descriptor_token_set
  68da492... Suppression gfc_conv_descriptor_dimension compil' OK
  5f685a9... Suppression gfc_conv_descriptor_attribute compil' OK
  92c52ab... Suppression gfc_conv_descriptor_type compil' OK
  9d5b012... Suppression gfc_conv_descriptor_rank compil' OK
  39c988d... Suppression gfc_conv_descriptor_version compil' OK
  90c50ac... Suppression gfc_conv_descriptor_elem_len compil' OK
  5e83783... Suppression gfc_conv_descriptor_dtype compil' OK
  dc774b9... Utilisation gfc_conv_descriptor_offset_{g,s}et
  421d080... Suppression gfc_conv_descriptor_data_addr
  40050dc... Utilisation gfc_conv_descriptor_data_set
  5191455... Déplacement fonctions descripteur vers fichier séparé
  0d69c05... fortran: Factor array descriptor references
  6566bd8... Sauvegarde/restoration cfun
  d6d43da... Prise en charge affichage TARGET_MEM_REF
  1d05ed4... gimple-simulate: Add a gimple IR interpreter/simulator

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_type compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:92c52aba353b417e031170df3204bb25e8fc69cb

commit 92c52aba353b417e031170df3204bb25e8fc69cb
Author: Mikael Morin 
Date:   Sun Jun 29 14:11:50 2025 +0200

Suppression gfc_conv_descriptor_type compil' OK

Correction régression PR97046

Suppression non_lvalue type_get

Ajout location set_type

Diff:
---
 gcc/fortran/trans-decl.cc   | 23 -
 gcc/fortran/trans-descriptor.cc | 71 +++--
 gcc/fortran/trans-descriptor.h  |  5 ++-
 gcc/fortran/trans-expr.cc   |  2 +-
 4 files changed, 80 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 5ed1a1b6fbd3..2996dd72e6aa 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7283,25 +7283,20 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID);
+  tmp2 = gfc_conv_descriptor_type_set (gfc_desc, 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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_DERIVED);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  tmp, tmp2);
   /* if (CFI_type_Character) BT_CHARACTER else  < tmp2 >  */
@@ -7310,8 +7305,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, 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 >  */
@@ -7323,16 +7317,14 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  tmp, 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));
+  tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_COMPLEX);
   tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
  tmp, tmp2);
   /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real)
@@ -7350,8 +7342,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
 CFI_type_Real));
   cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_attribute compil' OK

[Mikael Morin via Gcc-cvs]

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

commit 5f685a977d20209ae4b8f54ec7844e2736a57842
Author: Mikael Morin 
Date:   Sun Jun 29 14:15:55 2025 +0200

Suppression gfc_conv_descriptor_attribute compil' OK

Diff:
---
 gcc/fortran/trans-descriptor.cc | 16 
 gcc/fortran/trans-descriptor.h  |  1 -
 2 files changed, 17 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 34a635cc90ca..2a59f7dfd13f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -393,22 +393,6 @@ gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree 
desc, tree value)
 }
 
 
-tree
-gfc_conv_descriptor_attribute (tree desc)
-{
-  tree tmp;
-  tree dtype;
-
-  dtype = get_descriptor_dtype (desc);
-  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
-  GFC_DTYPE_ATTRIBUTE);
-  gcc_assert (tmp!= NULL_TREE
- && TREE_TYPE (tmp) == short_integer_type_node);
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-
 static tree
 get_descriptor_type (tree desc)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 96f66b004ecb..69cc4f3e2ac6 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -48,7 +48,6 @@ tree gfc_get_cfi_dim_extent (tree desc, tree idx);
 tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
-tree gfc_conv_descriptor_attribute (tree desc);
 tree gfc_get_descriptor_dimension (tree desc);
 tree gfc_conv_descriptor_dimension (tree desc, tree dim);
 tree gfc_conv_descriptor_token (tree desc);

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_data_set

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:40050dcd731b5350bfc133413aac793af7be40ad

commit 40050dcd731b5350bfc133413aac793af7be40ad
Author: Mikael Morin 
Date:   Wed Feb 12 10:47:31 2025 +0100

Utilisation gfc_conv_descriptor_data_set

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 403aa56bef02..9db5a50cbd4f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5143,10 +5143,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 2242c81f5620..f67c69e60f44 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1741,7 +1741,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
 {
@@ -1755,7 +1755,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_v08)] Suppression gfc_conv_descriptor_dtype compil' OK

[Mikael Morin via Gcc-cvs]

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

commit 5e83783ce1baa086327f25204faac9c53e96a955
Author: Mikael Morin 
Date:   Sat Jun 28 23:09:22 2025 +0200

Suppression gfc_conv_descriptor_dtype compil' OK

Suppression non_lvalue dtype_get

Ajout location descriptor_dtype_set

Suppression variable inutilisée

Suppression retour à la ligne inutile dtype_set

Diff:
---
 gcc/fortran/trans-array.cc  | 98 +
 gcc/fortran/trans-decl.cc   |  6 ++-
 gcc/fortran/trans-descriptor.cc | 30 ++---
 gcc/fortran/trans-descriptor.h  |  4 +-
 gcc/fortran/trans-expr.cc   | 36 +++
 gcc/fortran/trans-intrinsic.cc  | 11 ++---
 gcc/fortran/trans-stmt.cc   |  5 +--
 7 files changed, 92 insertions(+), 98 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 185de0886feb..23e3a64d04c8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1186,9 +1186,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
   if (rank_changer)
{
  /* Take the dtype from the class expression.  */
- dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (pre, tmp, dtype);
+ tree class_descr = gfc_class_data_get (class_expr);
+ dtype = gfc_conv_descriptor_dtype_get (class_descr);
+ gfc_conv_descriptor_dtype_set (pre, desc, dtype);
+
 
  /* These transformational functions change the rank.  */
  tmp = gfc_conv_descriptor_rank (desc);
@@ -1210,8 +1211,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
   else
 {
   /* Fill in the array dtype.  */
-  tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  gfc_conv_descriptor_dtype_set (pre, desc,
+gfc_get_dtype (TREE_TYPE (desc)));
 }
 
   info->descriptor = desc;
@@ -5806,8 +5807,8 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   && VAR_P (expr->ts.u.cl->backend_decl))
 {
   type = gfc_typenode_for_spec (&expr->ts);
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+  gfc_conv_descriptor_dtype_set (pblock, descriptor,
+gfc_get_dtype_rank_type (rank, type));
 }
   else if (expr->ts.type == BT_CHARACTER
   && expr->ts.deferred
@@ -5828,14 +5829,12 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
 TREE_OPERAND (descriptor, 0), tmp, NULL_TREE);
   tmp = fold_convert (gfc_charlen_type_node, tmp);
   type = gfc_get_character_type_len (expr->ts.kind, tmp);
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+  gfc_conv_descriptor_dtype_set (pblock, descriptor,
+gfc_get_dtype_rank_type (rank, type));
 }
   else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
-{
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
-}
+gfc_conv_descriptor_dtype_set (pblock, descriptor,
+  gfc_conv_descriptor_dtype_get (expr3_desc));
   else if (expr->ts.type == BT_CLASS && !explicit_ts
   && expr3 && expr3->ts.type != BT_CLASS
   && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
@@ -5845,10 +5844,7 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
  fold_convert (TREE_TYPE (tmp), expr3_elem_size));
 }
   else
-{
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
-}
+gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
 
   or_expr = logical_false_node;
 
@@ -8241,7 +8237,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
  the offsets because all elements are within the array data.  */
 
   /* Set the dtype.  */
-  tmp = gfc_conv_descriptor_dtype (parm);
   if (se->unlimited_polymorphic)
dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
   else if (expr->ts.type == BT_ASSUMED)
@@ -8251,11 +8246,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
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);
+ dtype = gfc_conv_descriptor_dtype_get (tmp2);
}
   else
dtype = gfc_get_dtype (parmtype);
-  gfc_add_modif

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_elem_len compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:90c50ac950c154988e5ae206698f9689b778b4c0

commit 90c50ac950c154988e5ae206698f9689b778b4c0
Author: Mikael Morin 
Date:   Sun Jun 29 12:40:53 2025 +0200

Suppression gfc_conv_descriptor_elem_len compil' OK

Correction ICE class_allocate_21

Suppression non_lvalue elem_len_get

Ajout location elem_len_set

Suppression retour à la ligne inutile elem_len_set

Diff:
---
 gcc/fortran/trans-array.cc  |  8 ++--
 gcc/fortran/trans-decl.cc   | 10 +-
 gcc/fortran/trans-descriptor.cc | 18 --
 gcc/fortran/trans-descriptor.h  |  3 ++-
 gcc/fortran/trans-expr.cc   |  6 +++---
 gcc/fortran/trans-intrinsic.cc  |  2 +-
 gcc/fortran/trans-openmp.cc |  6 +++---
 7 files changed, 32 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 23e3a64d04c8..7218df21885e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5838,11 +5838,7 @@ gfc_array_init_size (tree descriptor, int rank, int 
corank, tree * poffset,
   else if (expr->ts.type == BT_CLASS && !explicit_ts
   && expr3 && expr3->ts.type != BT_CLASS
   && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
-{
-  tmp = gfc_conv_descriptor_elem_len (descriptor);
-  gfc_add_modify (pblock, tmp,
- fold_convert (TREE_TYPE (tmp), expr3_elem_size));
-}
+gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size);
   else
 gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
 
@@ -11202,7 +11198,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
 {
   /* Unfortunately, the lhs vptr is set too early in many cases.
 Play it safe by using the descriptor element length.  */
-  tmp = gfc_conv_descriptor_elem_len (desc);
+  tmp = gfc_conv_descriptor_elem_len_get (desc);
   elemsize1 = fold_convert (gfc_array_index_type, tmp);
 }
   else
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 42d317962a97..c52ad953f399 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7276,8 +7276,8 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   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));
+  gfc_conv_descriptor_elem_len_set (&block, 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),
@@ -7507,7 +7507,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   /* memcpy (lhs + idx*elem_len, rhs + shift, elem_len)  */
   tree elem_len;
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
-   elem_len = gfc_conv_descriptor_elem_len (gfc_desc);
+   elem_len = gfc_conv_descriptor_elem_len_get (gfc_desc);
   else
elem_len = gfc_get_cfi_desc_elem_len (cfi);
   lhs = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
@@ -7545,7 +7545,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
   /* if do_copy_inout:  gfc->dspan = gfc->dtype.elem_len
  We use gfc instead of cfi on the RHS as this might be a constant.  */
   tmp = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_elem_len (gfc_desc));
+ gfc_conv_descriptor_elem_len_get (gfc_desc));
   if (!do_copy_inout)
 {
   /* gfc->dspan = ((cfi->dim[0].sm % gfc->elem_len)
@@ -7749,7 +7749,7 @@ done:
  /* memcpy (lhs + shift, rhs + idx*elem_len, elem_len) */
  tree elem_len;
  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
-   elem_len = gfc_conv_descriptor_elem_len (gfc_desc);
+   elem_len = gfc_conv_descriptor_elem_len_get (gfc_desc);
  else
elem_len = gfc_get_cfi_desc_elem_len (cfi);
  rhs = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 34a71cfda5d4..ea4817d1cc16 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -316,8 +316,8 @@ gfc_conv_descriptor_version (tree desc)
 
 /* Return the element length from the descriptor dtype field.  */
 
-tree
-gfc_conv_descriptor_elem_len (tree desc)
+static tree
+get_descriptor_elem_len (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -331,6 +331,20 @@ gfc_conv_descriptor_elem_len (tree desc)
  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_elem_len_get (tree desc)
+{
+  return get_descriptor_elem_len (desc);
+}
+
+void
+gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t l

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_rank compil' OK

[Mikael Morin via Gcc-cvs]

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

commit 9d5b0124b6d74d0e49633ee354b75c3968f32b76
Author: Mikael Morin 
Date:   Sun Jun 29 14:07:23 2025 +0200

Suppression gfc_conv_descriptor_rank compil' OK

Suppression non_lvalue rank_get

Ajout location rank_set

Diff:
---
 gcc/fortran/trans-array.cc  | 16 ++--
 gcc/fortran/trans-decl.cc   |  2 +-
 gcc/fortran/trans-descriptor.cc | 24 ++--
 gcc/fortran/trans-descriptor.h  |  4 +++-
 gcc/fortran/trans-expr.cc   | 24 +++-
 gcc/fortran/trans-intrinsic.cc  | 10 +-
 gcc/fortran/trans-openmp.cc |  2 +-
 gcc/fortran/trans-stmt.cc   |  2 +-
 8 files changed, 46 insertions(+), 38 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4ba32e6d7fe4..b34c8c7bff01 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1192,9 +1192,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, 
stmtblock_t * post, gfc_ss * ss,
 
 
  /* These transformational functions change the rank.  */
- tmp = gfc_conv_descriptor_rank (desc);
- gfc_add_modify (pre, tmp,
- build_int_cst (TREE_TYPE (tmp), ss->loop->dimen));
+ gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen);
  fcn_ss->info->class_container = NULL_TREE;
}
 
@@ -4831,7 +4829,7 @@ done:
  && (gfc_option.allow_std & GFC_STD_F202Y)))
  gcc_assert (se.pre.head == NULL_TREE
  && se.post.head == NULL_TREE);
-   rank = gfc_conv_descriptor_rank (se.expr);
+   rank = gfc_conv_descriptor_rank_get (se.expr);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
   gfc_array_index_type,
   fold_convert (gfc_array_index_type,
@@ -8428,7 +8426,7 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, 
gfc_expr *expr, tree dim)
   enum gfc_array_kind akind = GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc));
   if (expr == NULL || expr->rank < 0)
 rank = fold_convert (signed_char_type_node,
-gfc_conv_descriptor_rank (desc));
+gfc_conv_descriptor_rank_get (desc));
   else
 rank = build_int_cst (signed_char_type_node, expr->rank);
 
@@ -8833,8 +8831,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
  tree tmp2 = gfc_conv_descriptor_dtype_get (se->expr);
  gfc_conv_descriptor_dtype_set (&block, arr, tmp2);
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
+ gfc_conv_descriptor_rank_set (&block, arr, 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);
@@ -9118,7 +9115,7 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int 
rank)
   tree nelems;
   tree tmp;
   if (rank < 0)
-idx = gfc_conv_descriptor_rank (decl);
+idx = gfc_conv_descriptor_rank_get (decl);
   else
 idx = gfc_rank_cst[rank - 1];
   nelems = gfc_conv_descriptor_ubound_get (decl, idx);
@@ -9328,8 +9325,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, 
tree src, tree type,
   else
 {
   /* Set the rank or unitialized memory access may be reported.  */
-  tmp = gfc_conv_descriptor_rank (dest);
-  gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), 
rank));
+  gfc_conv_descriptor_rank_set (&globalblock, dest, rank);
 
   if (rank)
nelems = gfc_full_array_size (&globalblock, src, rank);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index c52ad953f399..5ed1a1b6fbd3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7361,7 +7361,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t 
*finally,
 {
   /* Set gfc->dtype.rank, if assumed-rank.  */
   rank = gfc_get_cfi_desc_rank (cfi);
-  gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank);
+  gfc_conv_descriptor_rank_set (&block, gfc_desc, rank);
 }
   else if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
 /* In that case, the CFI rank and the declared rank can differ.  */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6932becb3f0f..6b59699c652a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -284,8 +284,8 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
 }
 
 
-tree
-gfc_conv_descriptor_rank (tree desc)
+static tree
+get_descriptor_rank (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -298,6 +298,26 @@ 

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_data_addr

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:421d080b5909191c00ebffd11c6029ae09cd0275

commit 421d080b5909191c00ebffd11c6029ae09cd0275
Author: Mikael Morin 
Date:   Sat Jun 28 22:02:40 2025 +0200

Suppression gfc_conv_descriptor_data_addr

Diff:
---
 gcc/fortran/trans-decl.cc   |  5 ++---
 gcc/fortran/trans-descriptor.cc | 10 --
 gcc/fortran/trans-descriptor.h  |  1 -
 3 files changed, 2 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 9db5a50cbd4f..3d648b6a31a3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5135,8 +5135,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
  se.descriptor_only = 1;
  gfc_conv_expr (&se, e);
  descriptor = se.expr;
- se.expr = gfc_conv_descriptor_data_addr (se.expr);
- se.expr = build_fold_indirect_ref_loc (input_location, 
se.expr);
+ se.expr = gfc_conv_descriptor_data_get (se.expr);
}
  gfc_free_expr (e);
 
@@ -5340,7 +5339,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
continue;
   /* 'omp allocate( {purpose: allocator, value: align},
{purpose: init-stmtlist, value: cleanup-stmtlist},
-   {purpose: size-var, value: last-size-expr}}
+   {purpose: size-var, value: last-size-expr} )
  where init-stmt/cleanup-stmt is the STATEMENT list to find the
  try-final block; last-size-expr is to find the location after
  which to add the code and 'size-var' is for the proper size, cf.
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e8748aad7dcc..4660130c4464 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -215,16 +215,6 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree 
desc, tree 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)
-{
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
-  return gfc_build_addr_expr (NULL_TREE, field);
-}
-
 tree
 gfc_conv_descriptor_offset (tree desc)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 1dd9d3ed4f73..ade63bf19751 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -48,7 +48,6 @@ tree gfc_get_cfi_dim_extent (tree desc, tree idx);
 tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
-tree gfc_conv_descriptor_data_addr (tree desc);
 tree gfc_conv_descriptor_dtype (tree desc);
 tree gfc_conv_descriptor_rank (tree desc);
 tree gfc_conv_descriptor_version (tree desc);

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_offset_{g, s}et

[Mikael Morin via Gcc-cvs]

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

commit dc774b94602f01249536d888945e8ca85291c6e7
Author: Mikael Morin 
Date:   Thu Jun 19 18:04:56 2025 +0200

Utilisation gfc_conv_descriptor_offset_{g,s}et

Correction pr43808

Correction gfc_conv_descriptor_offset

Utilisation gfc_conv_descriptor_offset_set

Suppression retour à la ligne inutile offset_set

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 31ed8546488b..185de0886feb 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8996,9 +8996,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
  new_field = gfc_conv_descriptor_dtype (new_desc);
  gfc_add_modify (&se->pre, new_field, old_field);
 
- old_field = gfc_conv_descriptor_offset (old_desc);
- new_field = gfc_conv_descriptor_offset (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
+ old_field = gfc_conv_descriptor_offset_get (old_desc);
+ gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field);
 
  for (int i = 0; i < expr->rank; i++)
{
@@ -11168,8 +11167,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
  gfc_index_zero_node);
}
 
-  tmp = gfc_conv_descriptor_offset (desc);
-  gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
+  gfc_conv_descriptor_offset_set (&loop_pre_block, desc,
+ gfc_index_zero_node);
 
   tmp = fold_build2_loc (input_location, EQ_EXPR,
 logical_type_node, array1,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4660130c4464..88bbacd08e30 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -215,8 +215,8 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree 
desc, tree value)
 }
 
 
-tree
-gfc_conv_descriptor_offset (tree desc)
+static tree
+get_descriptor_offset (tree desc)
 {
   tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
   gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
@@ -226,14 +226,13 @@ gfc_conv_descriptor_offset (tree desc)
 tree
 gfc_conv_descriptor_offset_get (tree desc)
 {
-  return gfc_conv_descriptor_offset (desc);
+  return get_descriptor_offset (desc);
 }
 
 void
-gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
-   tree value)
+gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
 {
-  tree t = gfc_conv_descriptor_offset (desc);
+  tree t = get_descriptor_offset (desc);
   gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
 }
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index ade63bf19751..36365ff32ae0 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -57,7 +57,6 @@ tree gfc_conv_descriptor_type (tree desc);
 tree gfc_get_descriptor_dimension (tree desc);
 tree gfc_conv_descriptor_dimension (tree desc, tree dim);
 tree gfc_conv_descriptor_token (tree desc);
-tree gfc_conv_descriptor_offset (tree desc);
 
 tree gfc_conv_descriptor_data_get (tree desc);
 tree gfc_conv_descriptor_offset_get (tree desc);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6e380db29bcc..81861f59ea74 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9592,8 +9592,8 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component 
* cm,
 
   /* Shift the lbound and ubound of temporaries to being unity,
  rather than zero, based. Always calculate the offset.  */
+  gfc_conv_descriptor_offset_set (&block, dest, gfc_index_zero_node);
   offset = gfc_conv_descriptor_offset_get (dest);
-  gfc_add_modify (&block, offset, gfc_index_zero_node);
   tmp2 =gfc_create_var (gfc_array_index_type, NULL);
 
   for (n = 0; n < expr->rank; n++)

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_version compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:39c988d7fc97c71f45b322af0eb489685a85349d

commit 39c988d7fc97c71f45b322af0eb489685a85349d
Author: Mikael Morin 
Date:   Sun Jun 29 12:58:32 2025 +0200

Suppression gfc_conv_descriptor_version compil' OK

Suppression non_lvalue version_get

Ajout location version_set

Suppression mise à la ligne version_set

Diff:
---
 gcc/fortran/trans-array.cc  | 23 +--
 gcc/fortran/trans-descriptor.cc | 19 +--
 gcc/fortran/trans-descriptor.h  |  3 ++-
 gcc/fortran/trans.cc|  5 ++---
 4 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7218df21885e..4ba32e6d7fe4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6368,10 +6368,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
 build_tree_list (NULL_TREE, alloc),
 DECL_ATTRIBUTES (omp_alt_alloc));
   omp_alt_alloc = build_call_expr (omp_alt_alloc, 3, align, sz, alloc);
-  succ_add_expr = fold_build2_loc (input_location, MODIFY_EXPR,
-  void_type_node,
-  gfc_conv_descriptor_version (se->expr),
+  stmtblock_t tmp_block;
+  gfc_init_block (&tmp_block);
+  gfc_conv_descriptor_version_set (&tmp_block, se->expr,
   build_int_cst (integer_type_node, 1));
+  succ_add_expr = gfc_finish_block (&tmp_block);
 }
 
   /* The allocatable variant takes the old pointer as first argument.  */
@@ -10501,10 +10502,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
{
  tree cd, t;
  if (c->attr.pdt_array)
-   cd = fold_build2_loc (input_location, EQ_EXPR,
- boolean_type_node,
- gfc_conv_descriptor_version (comp),
- build_int_cst (integer_type_node, 1));
+   {
+ tree version = gfc_conv_descriptor_version_get (comp);
+ cd = fold_build2_loc (input_location, EQ_EXPR,
+   boolean_type_node, version,
+   build_int_cst (integer_type_node, 
1));
+   }
  else
cd = gfc_omp_call_is_alloc (tmp);
  t = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
@@ -10514,8 +10517,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  gfc_init_block (&tblock);
  gfc_add_expr_to_block (&tblock, t);
  if (c->attr.pdt_array)
-   gfc_add_modify (&tblock, gfc_conv_descriptor_version (comp),
-   integer_zero_node);
+   gfc_conv_descriptor_version_set (&tblock, comp,
+integer_zero_node);
  tmp = build3_loc (input_location, COND_EXPR, void_type_node,
cd, gfc_finish_block (&tblock),
gfc_call_free (tmp));
@@ -11566,7 +11569,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
{
  tree cond, omp_tmp;
  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- gfc_conv_descriptor_version (desc),
+ gfc_conv_descriptor_version_get (desc),
  build_int_cst (integer_type_node, 1));
  omp_tmp = builtin_decl_explicit (BUILT_IN_GOMP_REALLOC);
  omp_tmp = build_call_expr_loc (input_location, omp_tmp, 4,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index ea4817d1cc16..6932becb3f0f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -299,8 +299,8 @@ gfc_conv_descriptor_rank (tree desc)
 }
 
 
-tree
-gfc_conv_descriptor_version (tree desc)
+static tree
+get_descriptor_version (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -313,6 +313,21 @@ gfc_conv_descriptor_version (tree desc)
  dtype, tmp, NULL_TREE);
 }
 
+tree
+gfc_conv_descriptor_version_get (tree desc)
+{
+  return get_descriptor_version (desc);
+}
+
+void
+gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t loc = input_location;
+  tree t = get_descriptor_version (desc);
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
 
 /* Return the element length from the descriptor dtype field.  */
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 8cd65b46f5fa..e5300bf0704e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-de

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] fortran: Factor array descriptor references

[Mikael Morin via Gcc-cvs]

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

commit 0d69c054403723908b6ea5175dec94d2f38f8fd4
Author: Mikael Morin 
Date:   Wed Jul 9 21:18:18 2025 +0200

fortran: Factor array descriptor references

Regression tested on x86_64-pc-linux-gnu.
OK for master?

-- >8 --

Save subexpressions of array descriptor references to variables, so that
all the expressions using the descriptor as base object benefit from a
simplified reference using the variables.

This limits the size of the expressions generated in the original tree
dump, easing analysis of the code involving those expressions.
This is especially helpful with chains of array references where each
array in the chain uses a descriptor.

After optimizations, the effect of the change shouldn't be visible in
the vast majority of cases.  In rare cases it seems to permit a couple
more jump threadings.

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_conv_ss_descriptor): Move the descriptor
expression initialisation...
(set_factored_descriptor_value): ... to this new function.
Before initialisation, walk the reference expression passed as
argument and save some of its subexpressions to a variable.
(substitute_t): New struct.
(maybe_substitute_expr): New function.
(substitute_subexpr_in_expr): New function.

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 fffa6db639b6..8cabfa99649b 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3622,7 +3622,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, 
int base)
   /* Also the data pointer.  */
   tmp = gfc_conv_array_data (se.expr);
   /* If this is a variable or address or a class array, use it directly.
- Otherwise we must evaluate it now to avoid breaking dependency
+Otherwise we must evaluate it now to avoid breaking dependency
 analysis by pulling the expressions for elemental array indices
 inside the loop.  */
   if (save_descriptor_data (se.expr, tmp) && !ss->is_alloc_lhs)

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement fonctions descripteur vers fichier séparé

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:519145540dd7aa59f6c95571a8f45363e6906cba

commit 519145540dd7aa59f6c95571a8f45363e6906cba
Author: Mikael Morin 
Date:   Wed Jun 18 17:31:23 2025 +0200

Déplacement fonctions descripteur vers fichier séparé

Suppression déclarations trans-array.h

Inclusion trans-descriptor.h

Correction en-têtes

Suppression declaration gfc_array_data_ptr_type

Ajout commentaires

Diff:
---
 gcc/fortran/Make-lang.in|   7 +-
 gcc/fortran/trans-array.cc  | 509 +
 gcc/fortran/trans-array.h   |  35 ---
 gcc/fortran/trans-decl.cc   |   1 +
 gcc/fortran/trans-descriptor.cc | 547 
 gcc/fortran/trans-descriptor.h  |  87 +++
 gcc/fortran/trans-expr.cc   |   1 +
 gcc/fortran/trans-intrinsic.cc  |   1 +
 gcc/fortran/trans-io.cc |   1 +
 gcc/fortran/trans-openmp.cc |   1 +
 gcc/fortran/trans-stmt.cc   |   1 +
 gcc/fortran/trans.cc|   1 +
 12 files changed, 647 insertions(+), 545 deletions(-)

diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 5b2f921bf2ef..2ddb0366e9dc 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -63,9 +63,10 @@ F95_PARSER_OBJS = fortran/arith.o fortran/array.o 
fortran/bbt.o \
 F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \
 fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
 fortran/trans.o fortran/trans-array.o fortran/trans-common.o \
-fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \
-fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
-fortran/trans-stmt.o fortran/trans-types.o fortran/frontend-passes.o
+fortran/trans-const.o fortran/trans-decl.o fortran/trans-descriptor.o \
+fortran/trans-expr.o fortran/trans-intrinsic.o fortran/trans-io.o \
+fortran/trans-openmp.o fortran/trans-stmt.o fortran/trans-types.o \
+fortran/frontend-passes.o
 
 fortran_OBJS = $(F95_OBJS) fortran/gfortranspec.o
 
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8cabfa99649b..31ed8546488b 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 "trans-descriptor.h"
 
 static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
 
@@ -106,466 +107,6 @@ gfc_array_dataptr_type (tree desc)
   return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
 }
 
-/* Build expressions to access members of the CFI descriptor.  */
-#define CFI_FIELD_BASE_ADDR 0
-#define CFI_FIELD_ELEM_LEN 1
-#define CFI_FIELD_VERSION 2
-#define CFI_FIELD_RANK 3
-#define CFI_FIELD_ATTRIBUTE 4
-#define CFI_FIELD_TYPE 5
-#define CFI_FIELD_DIM 6
-
-#define CFI_DIM_FIELD_LOWER_BOUND 0
-#define CFI_DIM_FIELD_EXTENT 1
-#define CFI_DIM_FIELD_SM 2
-
-static tree
-gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
-{
-  tree type = TREE_TYPE (desc);
-  gcc_assert (TREE_CODE (type) == RECORD_TYPE
- && TYPE_FIELDS (type)
- && (strcmp ("base_addr",
-IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type
- == 0));
-  tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
-  gcc_assert (field != NULL_TREE);
-
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- desc, field, NULL_TREE);
-}
-
-tree
-gfc_get_cfi_desc_base_addr (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
-}
-
-tree
-gfc_get_cfi_desc_elem_len (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
-}
-
-tree
-gfc_get_cfi_desc_version (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
-}
-
-tree
-gfc_get_cfi_desc_rank (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
-}
-
-tree
-gfc_get_cfi_desc_type (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
-}
-
-tree
-gfc_get_cfi_desc_attribute (tree desc)
-{
-  return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
-}
-
-static tree
-gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
-{
-  tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
-  tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
-  tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
-  gcc_assert (field != NULL_TREE);
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- tmp, field, NULL_TREE);
-}
-
-tree
-gfc_get_cfi_dim_lbound (tree desc, tree idx)
-{
-  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
-}
-
-tree
-gfc_get_cfi_dim_extent (tree desc, tree idx)
-{
-  return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
-}
-
-tree
-gfc_get_cfi_dim_sm (tree desc, tree i

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

[Mikael Morin via Gcc-cvs]

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

 9ffecd32fdcd... Extraction gfc_set_gfc_from_cfi

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Sauvegarde/restoration cfun

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:6566bd8e3fd99f7a73036233a697c152abfcd27e

commit 6566bd8e3fd99f7a73036233a697c152abfcd27e
Author: Mikael Morin 
Date:   Tue Jul 8 13:13:25 2025 +0200

Sauvegarde/restoration cfun

Correction bootstrap

Correction bootstrap

Correction bootstrap

Diff:
---
 gcc/gimple-simulate.cc | 8 
 1 file changed, 8 insertions(+)

diff --git a/gcc/gimple-simulate.cc b/gcc/gimple-simulate.cc
index a85e6f63cc92..09491076e95d 100644
--- a/gcc/gimple-simulate.cc
+++ b/gcc/gimple-simulate.cc
@@ -4720,7 +4720,9 @@ simul_scope_evaluate_tests ()
   DECL_CONTEXT (result) = func;
   DECL_RESULT (func) = result;
 
+  push_cfun (nullptr);
   init_lowered_empty_function (func, true, profile_count::one ());
+  pop_cfun ();
 
   tree def_var = create_var (integer_type_node, "def_var");
   DECL_CONTEXT (def_var) = func;
@@ -6482,8 +6484,10 @@ simul_scope_simulate_call_tests ()
   DECL_CONTEXT (result) = my_int_func;
   DECL_RESULT (my_int_func) = result;
 
+  push_cfun (nullptr);
   basic_block bb = init_lowered_empty_function (my_int_func, true,
profile_count::one ());
+  pop_cfun ();
   gimple_stmt_iterator gsi = gsi_last_bb (bb);
   greturn *ret_stmt = gimple_build_return (cst6);
   gsi_insert_after (&gsi, ret_stmt, GSI_CONTINUE_LINKING);
@@ -6534,8 +6538,10 @@ simul_scope_simulate_call_tests ()
   DECL_ARGUMENTS (int_func_with_arg) = arg;
   layout_decl (arg, 0);
 
+  push_cfun (nullptr);
   basic_block bb2 = init_lowered_empty_function (int_func_with_arg, true,
 profile_count::one ());
+  pop_cfun ();
   gimple_stmt_iterator gsi2 = gsi_last_bb (bb2);
   greturn *ret_stmt2 = gimple_build_return (arg);
   gsi_insert_after (&gsi2, ret_stmt2, GSI_CONTINUE_LINKING);
@@ -6618,7 +6624,9 @@ simul_scope_simulate_call_tests ()
   DECL_CONTEXT (void_result) = simple_func;
   DECL_RESULT (simple_func) = void_result;
 
+  push_cfun (nullptr);
   init_lowered_empty_function (simple_func, true, profile_count::one ());
+  pop_cfun ();
 
   gcall * simple_call = gimple_build_call (simple_func, 0);

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Prise en charge affichage TARGET_MEM_REF

[Mikael Morin via Gcc-cvs]

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

commit d6d43da9cf6c777a249c164a6df692bc5be68e32
Author: Mikael Morin 
Date:   Mon Jul 7 08:52:38 2025 +0200

Prise en charge affichage TARGET_MEM_REF

Diff:
---
 gcc/gimple-simulate.cc| 87 ---
 gcc/selftest-run-tests.cc |  2 ++
 gcc/selftest.h|  1 +
 3 files changed, 86 insertions(+), 4 deletions(-)

diff --git a/gcc/gimple-simulate.cc b/gcc/gimple-simulate.cc
index aa29b68b748c..a85e6f63cc92 100644
--- a/gcc/gimple-simulate.cc
+++ b/gcc/gimple-simulate.cc
@@ -903,6 +903,9 @@ static tree
 find_mem_ref_replacement (simul_scope & context, tree data_ref,
  unsigned offset, unsigned min_size)
 {
+  gcc_assert (TREE_CODE (data_ref) == MEM_REF
+ || TREE_CODE (data_ref) == TARGET_MEM_REF);
+
   tree ptr = TREE_OPERAND (data_ref, 0);
   data_value ptr_val = context.evaluate (ptr);
   if (ptr_val.classify () != VAL_ADDRESS)
@@ -923,12 +926,30 @@ find_mem_ref_replacement (simul_scope & context, tree 
data_ref,
 {
   tree access_offset = TREE_OPERAND (data_ref, 1);
   gcc_assert (TREE_CONSTANT (access_offset));
-  gcc_assert (tree_fits_shwi_p (access_offset));
-  HOST_WIDE_INT shwi_offset = tree_to_shwi (access_offset);
-  gcc_assert (offset < UINT_MAX - shwi_offset);
-  HOST_WIDE_INT remaining_offset = shwi_offset * CHAR_BIT
+  gcc_assert (tree_fits_uhwi_p (access_offset));
+  HOST_WIDE_INT uhwi_offset = tree_to_uhwi (access_offset);
+  gcc_assert (offset < UINT_MAX - uhwi_offset);
+  HOST_WIDE_INT remaining_offset = uhwi_offset * CHAR_BIT
   + offset + ptr_address->offset;
 
+  if (TREE_CODE (data_ref) == TARGET_MEM_REF)
+   {
+ tree idx = TREE_OPERAND (data_ref, 2);
+ data_value idx_val = context.evaluate (idx);
+ gcc_assert (idx_val.classify () == VAL_KNOWN);
+ wide_int wi_idx = idx_val.get_known ();
+
+ tree step = TREE_OPERAND (data_ref, 3);
+ data_value step_val = context.evaluate (step);
+ gcc_assert (step_val.classify () == VAL_KNOWN);
+ wide_int wi_step = step_val.get_known ();
+
+ wi_idx *= wi_step;
+ gcc_assert (wi::fits_uhwi_p (wi_idx));
+ HOST_WIDE_INT idx_offset = wi_idx.to_uhwi ();
+ remaining_offset += idx_offset * CHAR_BIT;
+   }
+
   return pick_subref_at (var_ref, remaining_offset, nullptr, min_size);
 }
 }
@@ -957,6 +978,7 @@ context_printer::print_first_data_ref_part (simul_scope & 
context,
   switch (TREE_CODE (data_ref))
 {
 case MEM_REF:
+case TARGET_MEM_REF:
   {
tree mem_replacement = find_mem_ref_replacement (context, data_ref,
 offset, min_size);
@@ -4432,6 +4454,63 @@ context_printer_print_value_update_tests ()
   printer9.print_value_update (ctx9, ref9, val9_addr_i);
   const char *str9 = pp_formatted_text (&pp9);
   ASSERT_STREQ (str9, "# v17c[8B:+8B] = &i\n");
+
+
+  heap_memory mem10;
+  context_printer printer10;
+  pretty_printer & pp10 = printer10.pp;
+  pp_buffer (&pp10)->m_flush_p = false;
+
+  tree a11c_10 = build_array_type_nelts (char_type_node, 11);
+  tree v11c_10 = create_var (a11c_10, "v11c");
+  tree p_10 = create_var (ptr_type_node, "p");
+  tree i_10 = create_var (size_type_node, "i");
+
+  vec decls10{};
+  decls10.safe_push (v11c_10);
+  decls10.safe_push (p_10);
+  decls10.safe_push (i_10);
+
+  context_builder builder10;
+  builder10.add_decls (&decls10);
+  simul_scope ctx10 = builder10.build (mem10, printer10);
+
+  data_storage *strg10_v11 = ctx10.find_reachable_var (v11c_10);
+  gcc_assert (strg10_v11 != nullptr);
+  storage_address addr10_v11 (strg10_v11->get_ref (), 0);
+
+  data_value val10_addr_v11 (ptr_type_node);
+  val10_addr_v11.set_address (addr10_v11);
+
+  data_storage *strg10_p = ctx10.find_reachable_var (p_10);
+  gcc_assert (strg10_p != nullptr);
+  strg10_p->set (val10_addr_v11);
+
+  data_value val10_cst_2 (size_type_node);
+  wide_int cst2_10 = wi::uhwi (2, TYPE_PRECISION (size_type_node));
+  val10_cst_2.set_known (cst2_10);
+
+  data_storage *strg10_i = ctx10.find_reachable_var (i_10);
+  gcc_assert (strg10_i != nullptr);
+  strg10_i->set (val10_cst_2);
+
+  tree int_ptr_10 = build_pointer_type (integer_type_node);
+
+  tree ref10 = build5 (TARGET_MEM_REF, integer_type_node, p_10,
+  build_int_cst (int_ptr_10, -4), i_10,
+  build_int_cst (size_type_node, 4), NULL_TREE);
+
+  data_value val10_cst_13 (integer_type_node);
+  wide_int wi10_13 = wi::shwi (13, TYPE_PRECISION (integer_type_node));
+  val10_cst_13.set_known (wi10_13);
+
+  printer10.print_value_update (ctx10, ref10, val10_cst_13);
+  const char *str10 = pp_formatted_text (&pp10);
+  ASSERT_STREQ (str10,
+   "# v11c[4] = 13\n"
+   "# v11c[5] = 0\n"
+   "# v11c[6] = 0\n"
+  

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Ajout non_lvalue getters.

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:7354fc47f9e73a5826a3b2034c1562b192684eea

commit 7354fc47f9e73a5826a3b2034c1562b192684eea
Author: Mikael Morin 
Date:   Thu Jun 19 17:22:05 2025 +0200

Ajout non_lvalue getters.

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

Correction dump coarray_poly_8

Ajout non_lvalue dtype_get

This reverts commit 753122549b057ad97ad6f98e5baa26c81706c9d9.

Ajout non_lvalue elem_len_get

This reverts commit b06c027e636068042a85adc5e5675ac8c48eb26c.

Ajout non_lvalue version_get

This reverts commit 708a228bd25a37b2d9590efe44a7f42b3eab46ed.

Ajout non_lvalue rank_get

This reverts commit e0fe5e4c8610e6dc14297a697287742a0c56386d.

Ajout non_lvalue type_get

This reverts commit 2c3a1a854faf2d271ade37615d1c5d32b07cf897.

Ajout non_lvalue dimension_get

This reverts commit 5e36be306d1faf013d4493ed302de8701f9815f9.

Correction motif intrinsic_size_3

Correction motifs dumps coarray_lib_this_image_{1,2}

Correction format dump bind_c_array_params_2

Correction motif dump PR93963

Correction motif dump coarray_lock_7

Correction motifs dump gomp/depend-5

Correction motifs dump gomp/depend-4

Correction motifs dump gomp/depend-6

Mise à jour formats dump bind-c-contiguous-2

Correction motifs dump array_reference_3

Correction motifs dump coarray_lock_7

Annulation partielle

Diff:
---
 gcc/fortran/trans-descriptor.cc| 50 +-
 gcc/testsuite/gfortran.dg/PR93963.f90  |  2 +-
 gcc/testsuite/gfortran.dg/array_reference_3.f90| 10 ++---
 gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90  | 12 +++---
 .../gfortran.dg/bind_c_array_params_2.f90  |  4 +-
 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  |  6 +--
 .../gfortran.dg/coarray_lib_this_image_1.f90   |  2 +-
 .../gfortran.dg/coarray_lib_this_image_2.f90   |  2 +-
 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   | 16 +++
 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 +-
 gcc/testsuite/gfortran.dg/gomp/depend-4.f90| 24 +--
 gcc/testsuite/gfortran.dg/gomp/depend-5.f90| 12 +++---
 gcc/testsuite/gfortran.dg/gomp/depend-6.f90| 24 +--
 gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 |  2 +-
 26 files changed, 120 insertions(+), 112 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 0ac1660d21ad..3d7cbeb7f43a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -196,6 +196,13 @@ gfc_get_descriptor_field (tree desc, unsigned field_idx)
  desc, field, NULL_TREE);
 }
 
+
+static tree
+get_descriptor_data (tree desc)
+{
+  return gfc_get_descriptor_field (desc, DATA_FIELD);
+}
+
 /* This provides READ-ONLY access to the data field.  The field itself
doesn't have the proper type.  */
 
@@ -203,11 +210,12 @@ tree
 gfc_conv_descriptor_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_descriptor_data (desc);
+  tree target_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+  tree t = fold_convert (target_type, field);
+  return non_lvalue_loc (input_location, t);
 }
 
 /* This provides WRITE access to the data field.
@@ -237,7 +245,7 @@ get_descriptor_offset (tree desc)
 tree
 gfc_con

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Introduction gfc_symbol_attr

[Mikael Morin via Gcc-cvs]

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

commit 2dd89733d88fcb6252ec0421368b6095e0f4b621
Author: Mikael Morin 
Date:   Thu Jul 17 16:38:25 2025 +0200

Introduction gfc_symbol_attr

Ajout déclaration gfc_symbol_attr

Diff:
---
 gcc/fortran/gfortran.h |  1 +
 gcc/fortran/primary.cc | 86 --
 2 files changed, 56 insertions(+), 31 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d85095c4da91..2ed8be344d69 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4131,6 +4131,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 f0e1fef6812e..6f69130d2f81 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2909,43 +2909,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;
-  bool has_substring_ref = false;
-
-  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)
 {
   dimension = CLASS_DATA (sym)->attr.dimension;
@@ -2981,6 +2952,59 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
target = 0;
 }
 
+  attr.dimension = dimension;
+  attr.codimension = codimension;
+  attr.pointer = pointer;
+  attr.allocatable = allocatable;
+  attr.target = target;
+
+  return attr;
+}
+
+
+/* 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)
+{
+  int dimension, codimension, pointer, allocatable, target, optional;
+  symbol_attribute attr;
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  gfc_component *comp;
+  bool has_inquiry_part;
+  bool has_substring_ref = false;
+
+  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 = gfc_symbol_attr (sym);
+
+  optional = attr.optional;
+  dimension = attr.dimension;
+  codimension = attr.codimension;
+  pointer = attr.pointer;
+  allocatable = attr.allocatable;
+  target = attr.target;
+
   if (ts != NULL && expr->ts.type == BT_UNKNOWN)
 *ts = sym->ts;

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Refactoring getters & setters

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:889dea56374fb92762fe5b9e8dee7c2c404ebb1e

commit 889dea56374fb92762fe5b9e8dee7c2c404ebb1e
Author: Mikael Morin 
Date:   Tue Jul 1 22:10:35 2025 +0200

Refactoring getters & setters

Nettoyage refactoring

Correction refactoring

Diff:
---
 gcc/fortran/trans-descriptor.cc | 125 ++--
 1 file changed, 43 insertions(+), 82 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 3d7cbeb7f43a..20484abd39a0 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -174,33 +174,39 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
 
 
 static tree
-get_type_field (tree type, unsigned field_idx)
+get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
 {
   tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
-  gcc_assert (field != NULL_TREE);
+  gcc_assert (field != NULL_TREE
+ && (field_type == NULL_TREE
+ || TREE_TYPE (field) == field_type));
 
   return field;
 }
 
-
 static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
+get_ref_comp (tree ref, unsigned field_idx, tree type = NULL_TREE)
 {
-  tree type = TREE_TYPE (desc);
-  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-
-  tree field = get_type_field (type, field_idx);
-  gcc_assert (field != NULL_TREE);
+  tree field = get_type_field (TREE_TYPE (ref), field_idx, type);
 
   return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- desc, field, NULL_TREE);
+ ref, field, NULL_TREE);
+}
+
+
+static tree
+get_descr_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+{
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+
+  return get_ref_comp (desc, field_idx, type);
 }
 
 
 static tree
 get_descriptor_data (tree desc)
 {
-  return gfc_get_descriptor_field (desc, DATA_FIELD);
+  return get_descr_comp (desc, DATA_FIELD);
 }
 
 /* This provides READ-ONLY access to the data field.  The field itself
@@ -229,7 +235,7 @@ gfc_conv_descriptor_data_get (tree desc)
 void
 gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
 {
-  tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+  tree field = get_descriptor_data (desc);
   gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
 }
 
@@ -237,9 +243,7 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree 
desc, tree value)
 static tree
 get_descriptor_offset (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
-  gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
-  return field;
+  return get_descr_comp (desc, OFFSET_FIELD, gfc_array_index_type);
 }
 
 tree
@@ -259,9 +263,7 @@ gfc_conv_descriptor_offset_set (stmtblock_t *block, tree 
desc, tree value)
 static tree
 get_descriptor_dtype (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
-  gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
-  return field;
+  return get_descr_comp (desc, DTYPE_FIELD, get_dtype_type_node ());
 }
 
 tree
@@ -283,9 +285,7 @@ gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree 
desc, tree value)
 static tree
 gfc_conv_descriptor_span (tree desc)
 {
-  tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
-  gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
-  return field;
+  return get_descr_comp (desc, SPAN_FIELD, gfc_array_index_type);
 }
 
 tree
@@ -295,26 +295,24 @@ gfc_conv_descriptor_span_get (tree desc)
 }
 
 void
-gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
-   tree value)
+gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
 {
   tree t = gfc_conv_descriptor_span (desc);
   gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
 }
 
 
+static tree
+get_dtype_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+{ 
+  tree dtype_ref = get_descriptor_dtype (desc);
+  return get_ref_comp (dtype_ref, field_idx, type);
+}
+
 static tree
 get_descriptor_rank (tree desc)
 {
-  tree tmp;
-  tree dtype;
-
-  dtype = get_descriptor_dtype (desc);
-  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
-  gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == signed_char_type_node);
-  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
+  return get_dtype_comp (desc, GFC_DTYPE_RANK, signed_char_type_node);
 }
 
 tree
@@ -341,15 +339,7 @@ gfc_conv_descriptor_rank_set (stmtblock_t *block, tree 
desc, int value)
 static tree
 get_descriptor_version (tree desc)
 {
-  tree tmp;
-  tree dtype;
-
-  dtype = get_descriptor_dtype (desc);
-  tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
-  gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == integer_type_node);
-  return fold_build3_loc (input_location, COMPONENT_R

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Ajout locations setters

[Mikael Morin via Gcc-cvs]

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

commit b7b4a236eb3efe3197aebe0604b3c37a8eb4c7b9
Author: Mikael Morin 
Date:   Tue Jul 1 22:20:34 2025 +0200

Ajout locations setters

Diff:
---
 gcc/fortran/trans-descriptor.cc | 28 
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 20484abd39a0..e5f0076ab855 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -218,10 +218,10 @@ gfc_conv_descriptor_data_get (tree desc)
   tree type = TREE_TYPE (desc);
   gcc_assert (TREE_CODE (type) != REFERENCE_TYPE);
 
+  location_t loc = input_location;
   tree field = get_descriptor_data (desc);
   tree target_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
-  tree t = fold_convert (target_type, field);
-  return non_lvalue_loc (input_location, t);
+  return non_lvalue_loc (loc, fold_convert_loc (loc, target_type, field));
 }
 
 /* This provides WRITE access to the data field.
@@ -235,8 +235,10 @@ gfc_conv_descriptor_data_get (tree desc)
 void
 gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
 {
+  location_t loc = input_location;
   tree field = get_descriptor_data (desc);
-  gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
+  gfc_add_modify_loc (loc, block, field,
+ fold_convert_loc (loc, TREE_TYPE (field), value));
 }
 
 
@@ -255,8 +257,10 @@ gfc_conv_descriptor_offset_get (tree desc)
 void
 gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_offset (desc);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 
@@ -297,8 +301,10 @@ gfc_conv_descriptor_span_get (tree desc)
 void
 gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
 {
+  location_t loc = input_location;
   tree t = gfc_conv_descriptor_span (desc);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 
@@ -543,8 +549,10 @@ void
 gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
tree dim, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_stride (desc, dim);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 static tree
@@ -563,8 +571,10 @@ void
 gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
tree dim, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_lbound (desc, dim);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }
 
 static tree
@@ -583,8 +593,10 @@ void
 gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
tree dim, tree value)
 {
+  location_t loc = input_location;
   tree t = get_descriptor_ubound (desc, dim);
-  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
 }

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_dimension compil' OK

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:68da492392029a8f6ff01bbcfa3dfabc5d4706b6

commit 68da492392029a8f6ff01bbcfa3dfabc5d4706b6
Author: Mikael Morin 
Date:   Sun Jun 29 14:28:16 2025 +0200

Suppression gfc_conv_descriptor_dimension compil' OK

Suppression non_lvalue dimension_get

ajout location dimension_set

Diff:
---
 gcc/fortran/trans-array.cc  | 10 +-
 gcc/fortran/trans-descriptor.cc | 35 ---
 gcc/fortran/trans-descriptor.h  |  5 -
 3 files changed, 41 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b34c8c7bff01..02d6c68b45c5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8989,11 +8989,11 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
 
  for (int i = 0; i < expr->rank; i++)
{
- old_field = gfc_conv_descriptor_dimension (old_desc,
-   gfc_rank_cst[get_array_ref_dim_for_loop_dim (ss, i)]);
- new_field = gfc_conv_descriptor_dimension (new_desc,
-   gfc_rank_cst[i]);
- gfc_add_modify (&se->pre, new_field, old_field);
+ int idx = get_array_ref_dim_for_loop_dim (ss, i);
+ old_field = gfc_conv_descriptor_dimension_get (old_desc, idx);
+ gfc_conv_descriptor_dimension_set (&se->pre, new_desc, i,
+old_field);
+ 
}
 
  if (flag_coarray == GFC_FCOARRAY_LIB
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 2a59f7dfd13f..43cfce6f4411 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -469,8 +469,8 @@ gfc_get_descriptor_dimension (tree desc)
 }
 
 
-tree
-gfc_conv_descriptor_dimension (tree desc, tree dim)
+static tree
+get_descriptor_dimension (tree desc, tree dim)
 {
   tree tmp;
 
@@ -479,6 +479,35 @@ gfc_conv_descriptor_dimension (tree desc, tree dim)
   return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
 }
 
+tree
+gfc_conv_descriptor_dimension_get (tree desc, tree dim)
+{
+  return get_descriptor_dimension (desc, dim);
+}
+
+tree
+gfc_conv_descriptor_dimension_get (tree desc, int dim)
+{
+  return gfc_conv_descriptor_dimension_get (desc, gfc_rank_cst[dim]);
+}
+
+void
+gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, tree dim,
+  tree value)
+{
+  location_t loc = input_location;
+  tree t = get_descriptor_dimension (desc, dim);
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+void
+gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, int dim,
+  tree value)
+{
+  gfc_conv_descriptor_dimension_set (block, desc, gfc_rank_cst[dim], value);
+}
+
 
 tree
 gfc_conv_descriptor_token (tree desc)
@@ -494,7 +523,7 @@ gfc_conv_descriptor_token (tree desc)
 static tree
 gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
 {
-  tree tmp = gfc_conv_descriptor_dimension (desc, dim);
+  tree tmp = get_descriptor_dimension (desc, dim);
   tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
   gcc_assert (field != NULL_TREE);
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 69cc4f3e2ac6..0547157bf2af 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -49,7 +49,6 @@ tree gfc_get_cfi_dim_sm (tree desc, tree idx);
 
 
 tree gfc_get_descriptor_dimension (tree desc);
-tree gfc_conv_descriptor_dimension (tree desc, tree dim);
 tree gfc_conv_descriptor_token (tree desc);
 
 tree gfc_conv_descriptor_data_get (tree desc);
@@ -61,6 +60,8 @@ tree gfc_conv_descriptor_rank_get (tree desc);
 tree gfc_conv_descriptor_type_get (tree desc);
 tree gfc_conv_descriptor_span_get (tree desc);
 
+tree gfc_conv_descriptor_dimension_get (tree desc, tree dim);
+tree gfc_conv_descriptor_dimension_get (tree desc, int dim);
 tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
 tree gfc_conv_descriptor_lbound_get (tree desc, tree dim);
 tree gfc_conv_descriptor_ubound_get (tree desc, tree dim);
@@ -77,6 +78,8 @@ void gfc_conv_descriptor_type_set (stmtblock_t *block, tree 
desc, tree value);
 tree gfc_conv_descriptor_type_set (tree desc, tree value);
 tree gfc_conv_descriptor_type_set (tree desc, int value);
 void gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value);
+void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, tree 
dim, tree value);
+void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, int 
dim, tree value);
 void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void g

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_token_set

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:9167d2a88480777dc3dbe70d667bddfc4f179d8a

commit 9167d2a88480777dc3dbe70d667bddfc4f179d8a
Author: Mikael Morin 
Date:   Tue Jul 15 17:17:33 2025 +0200

Utilisation gfc_conv_descriptor_token_set

Diff:
---
 gcc/fortran/trans-array.cc  | 12 +---
 gcc/fortran/trans-descriptor.cc | 10 ++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc   | 12 +---
 gcc/fortran/trans-intrinsic.cc  |  3 +--
 5 files changed, 22 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 02d6c68b45c5..acf643f6adbd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8365,7 +8365,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
  tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
}
 
- gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp);
+ gfc_conv_descriptor_token_set (&loop.pre, parm, tmp);
}
   desc = parm;
 }
@@ -8974,7 +8974,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
}
  else if (!ctree)
{
- tree old_field, new_field;
+ tree old_field;
 
  /* The original descriptor has transposed dims so we can't reuse
 it directly; we have to create a new one.  */
@@ -9002,8 +9002,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
 == GFC_ARRAY_ALLOCATABLE)
{
  old_field = gfc_conv_descriptor_token (old_desc);
- new_field = gfc_conv_descriptor_token (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
+ gfc_conv_descriptor_token_set (&se->pre, new_desc,
+old_field);
}
 
  gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
@@ -11839,9 +11839,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
 image.  This may happen, for example, with the caf_mpi
 implementation.  */
  TREE_STATIC (descriptor) = 1;
- tmp = gfc_conv_descriptor_token (descriptor);
- gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
-   null_pointer_node));
+ gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
 }
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 43cfce6f4411..0ac1660d21ad 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -520,6 +520,16 @@ gfc_conv_descriptor_token (tree desc)
   return field;
 }
 
+void
+gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t loc = input_location;
+  tree t = gfc_conv_descriptor_token (desc);
+  gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+
 static tree
 gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0547157bf2af..3f602219c284 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -83,6 +83,7 @@ void gfc_conv_descriptor_dimension_set (stmtblock_t *block, 
tree desc, int dim,
 void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
+void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
 
 tree gfc_build_null_descriptor (tree type);
 
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dc4503a07352..2e35c6f6ec32 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -828,7 +828,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_symbol *fsym,
   if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
   gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
-  gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+  gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
 }
 
   if (optional)
@@ -9848,8 +9848,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * 
cm,
{
  gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
  if (cm->attr.codimension && flag_coarray == GFC_FCOARRAY_LIB)
-   gfc_add_modify (&block, gfc_conv_descriptor_token (dest),
-   null_pointer_node);
+   gfc_conv_descriptor_token_set (&block, dest, null_pointer_node);
}
   else if (cm->attr.allocatable || cm->attr.pdt_array)
{
@@ -11607,10 +11606,9 @@ gfc_trans_scalar

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Modif gfc_init_descriptor_variable

[Mikael Morin via Gcc-cvs]

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

commit a507baafc413d1317a71fba98d82c2f062aebd21
Author: Mikael Morin 
Date:   Sat Jul 19 15:55:19 2025 +0200

Modif gfc_init_descriptor_variable

Diff:
---
 gcc/fortran/trans-descriptor.cc | 20 +---
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f89ad587f62f..cc25347551a6 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -673,22 +673,28 @@ gfc_get_descriptor_offsets_for_info (const_tree 
desc_type, tree *data_off,
 void
 gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
 {
+  symbol_attribute attr = gfc_symbol_attr (sym);
+
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
  pointers when -fcheck=pointer is specified.  */
-  if (sym->attr.allocatable
-  || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+  if (attr.allocatable
+  || (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
 {
   gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
-  if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+  if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
 }
 
   tree etype;
 
-  gcc_assert (sym->as && sym->as->rank>=0);
+  gfc_array_spec *as;
+  if (sym->ts.type == BT_CLASS)
+as = CLASS_DATA (sym)->as;
+  else
+as = sym->as;
+
+  gcc_assert (as && as->rank >= 0);
   etype = gfc_get_element_type (TREE_TYPE (descr));
   gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (sym->as->rank,
- etype));
+gfc_get_dtype_rank_type (as->rank, etype));
 }
-

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

[Mikael Morin via Gcc-cvs]

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

commit dea29b45050970dbbf3ba793907ed504f9852c2d
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 fbf47dd9b60a..b36579e7c7a6 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -7248,6 +7248,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_v08)] Extraction gfc_init_descriptor_variable

[Mikael Morin via Gcc-cvs]

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

commit ac326e1c48c940b410122ba6219a7fc1782cb376
Author: Mikael Morin 
Date:   Tue Jul 15 18:28:30 2025 +0200

Extraction gfc_init_descriptor_variable

Correction nom block

Correction libgomp.fortran/allocators-1.f90

Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable

Diff:
---
 gcc/fortran/trans-array.cc | 18 ++--
 gcc/fortran/trans-descriptor.cc| 24 ++
 gcc/fortran/trans-descriptor.h |  4 ++--
 libgomp/testsuite/libgomp.fortran/allocators-1.f90 |  4 ++--
 4 files changed, 30 insertions(+), 20 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index acf643f6adbd..4cb21a42c1a8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11828,10 +11828,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
  pointers when -fcheck=pointer is specified.  */
   if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save
-  && (sym->attr.allocatable
- || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER
+  && (sym->attr.allocatable || sym->attr.pointer))
 {
-  gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
   if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
{
  /* Declare the variable static so its array descriptor stays present
@@ -11839,22 +11837,10 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
 image.  This may happen, for example, with the caf_mpi
 implementation.  */
  TREE_STATIC (descriptor) = 1;
- gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
+  gfc_init_descriptor_variable (&init, sym, descriptor);
 }
 
-  /* Set initial TKR for pointers and allocatables */
-  if (GFC_DESCRIPTOR_TYPE_P (type)
-  && (sym->attr.pointer || sym->attr.allocatable))
-{
-  tree etype;
-
-  gcc_assert (sym->as && sym->as->rank>=0);
-  etype = gfc_get_element_type (type);
-  gfc_conv_descriptor_dtype_set (&init, descriptor,
-gfc_get_dtype_rank_type (sym->as->rank,
- etype));
-}
   input_location = loc;
   gfc_init_block (&cleanup);
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5f0076ab855..f89ad587f62f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -668,3 +668,27 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 #undef STRIDE_SUBFIELD
 #undef LBOUND_SUBFIELD
 #undef UBOUND_SUBFIELD
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+  /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
+ pointers when -fcheck=pointer is specified.  */
+  if (sym->attr.allocatable
+  || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+{
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+  if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+   gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
+}
+
+  tree etype;
+
+  gcc_assert (sym->as && sym->as->rank>=0);
+  etype = gfc_get_element_type (TREE_TYPE (descr));
+  gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type (sym->as->rank,
+ etype));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 3f602219c284..6058f54fc5fd 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -22,9 +22,7 @@ along with GCC; see the file COPYING3.  If not see
 /* 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 *, 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_null_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -94,4 +92,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 tree *stride_suboff, tree *lower_suboff,
 tree *upper_suboff);
 
+void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
+
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/libgomp/testsuite/lib

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

[Mikael Morin via Gcc-cvs]

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

commit c121c97eabfaeb580e8511f08face642c8cbc21e
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  | 61 -
 gcc/fortran/trans-array.h   |  2 +-
 gcc/fortran/trans-descriptor.cc | 47 +++
 gcc/fortran/trans-descriptor.h  |  2 ++
 gcc/fortran/trans-expr.cc   | 20 +-
 5 files changed, 75 insertions(+), 57 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d79cc8ea3a40..832e8fae8a36 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -107,40 +107,31 @@ gfc_array_dataptr_type (tree desc)
   return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
 }
 
-/* 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 bool
+keep_descriptor_lower_bound (gfc_expr *e)
 {
-  tree offs, 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]);
+  gfc_ref *ref;
 
-  /* Get difference (new - old) by which to shift stuff.  */
-  diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- new_lbound, lbound);
+  /* 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;
+  }
 
-  /* 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);
-  offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- offs, offs_diff);
-  gfc_conv_descriptor_offset_set (block, desc, offs);
+  /* 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;
 
-  /* Finally set lbound to value we want.  */
-  gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+  return true;
 }
 
 
@@ -8565,7 +8556,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;
@@ -8802,13 +8793,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))
+   gfc_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 ae46bcf283ff..d8f3364a2122 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -154,7 +154,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 *,

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

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:07ebb649314ba924be4f6d4b0e1171a9c998552b

commit 07ebb649314ba924be4f6d4b0e1171a9c998552b
Author: Mikael Morin 
Date:   Wed Jul 16 15:07:58 2025 +0200

Appel méthode shift descriptor dans gfc_trans_pointer_assignment

Diff:
---
 gcc/fortran/trans-descriptor.cc | 92 +
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc   | 28 +
 3 files changed, 95 insertions(+), 26 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f323453a2bae..aad233cc7f1a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -880,3 +880,95 @@ gfc_conv_shift_descriptor (stmtblock_t* block, tree desc, 
int rank)
  gfc_index_one_node);
 }
 
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+  gfc_expr * const (lbound[GFC_MAX_DIMENSIONS]))
+{
+  /* Apply a shift of the lbound when supplied.  */
+  for (int dim = 0; dim < rank; ++dim)
+{
+  gfc_expr *lb_expr = lbound[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,
+  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-descriptor.h b/gcc/fortran/trans-descriptor.h
index 9f5851b1def0..f8492c23d793 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -100,5 +100,6 @@ void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
 void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, tree, tree);
 void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 36274e50a07b..13632495ca19 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11336,32 +11336,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, 
gfc_expr * expr2)
}
}
  else
-   {
- /* Bounds remapping.  Just shift the lower bounds.  */
-
- gcc_assert (expr1->rank == expr2->rank);
-
- for (dim = 0; dim < remap->u.ar.dimen; ++dim)
-   {
- gfc_se lbound_se;
-
- gcc_assert (!remap->u.ar.end[dim]);
- gfc_init_se (&lbound_se, NULL);
- if (remap->u.ar.start[dim])
-   {
- gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]);
- gfc_add_block_to_block (&block, &lbound_se.pre);
-   }
- else
-   /* This remap arises from a target that is not a whole
-  array. The start expressions will be NULL but we need
-  the lbounds to be one.  */
-   lbound_se.expr = gfc_index_one_node;
- gfc_conv_shift_descriptor_lbound (&block, desc,
-   dim, lbound_se.expr);
- gfc_add_block_t

[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction fonction gfc_nullify_descriptor

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:535a44bfb6a5ec84e42f46f874e21b6a5cfdb3bd

commit 535a44bfb6a5ec84e42f46f874e21b6a5cfdb3bd
Author: Mikael Morin 
Date:   Wed Jul 16 16:49:28 2025 +0200

Extraction fonction gfc_nullify_descriptor

Diff:
---
 gcc/fortran/trans-descriptor.cc | 6 ++
 gcc/fortran/trans-descriptor.h  | 5 -
 gcc/fortran/trans-expr.cc   | 2 +-
 3 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index aad233cc7f1a..64fed46c7ab2 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -972,3 +972,9 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
   conv_shift_descriptor (block, desc, as);
 }
  
+
+void
+gfc_nullify_descriptor (stmtblock_t *block, tree descr)
+{
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node); 
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index f8492c23d793..18b1f0109d3a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -19,7 +19,6 @@ along with GCC; see the file COPYING3.  If not see
 #ifndef GFC_TRANS_DESCRIPTOR_H
 #define GFC_TRANS_DESCRIPTOR_H
 
-tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
 void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *, 
gfc_expr *, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -93,7 +92,9 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
 void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
+tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
 void gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, 
tree, tree);
+void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
 void gfc_init_static_descriptor (tree descr);
 void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
 void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
@@ -101,5 +102,7 @@ void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, 
tree, tree);
 void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
 void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
+/* Build a null array descriptor constructor.  */
+void gfc_nullify_descriptor (stmtblock_t *block, tree);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 13632495ca19..03747e7a5beb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11061,7 +11061,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, 
gfc_expr * expr2)
   if (expr2->expr_type == EXPR_NULL)
{
  /* Just set the data pointer to null.  */
- gfc_conv_descriptor_data_set (&lse.pre, lse.expr, null_pointer_node);
+ gfc_nullify_descriptor (&lse.pre, lse.expr);
}
   else if (rank_remap)
{