This changes the expansion to use a single criterion in order to determine
whether a temporary should be created when processing an N_Case_Expression
or an N_If_Expression or an N_Expression_With_Actions node. This will get
rid of large temporaries created for the last two nodes and also avoids an
indirection with small arrays for the first node.
The layout machinery is enhanced to compute the size(s) of array types in
more cases, which requires an adjustment to the handling of Component_Size
clauses on array types.
Tested on x86-64/Linux, applied on the mainline.
2026-09-22 Eric Botcazou <[email protected]>
* exp_ch4.adb (Is_Copy_Type): New global predicate.
(Expand_N_Case_Expression.Is_Copy_Type): Delete.
(Expand_N_Expression_With_Actions.Is_Copy_Type): Likewise.
(Expand_N_If_Expression.Is_Copy_Type): Likewise.
* layout.adb (Layout_Type): Compute the size(s) of a 1-dimensional
array type in more cases.
* sem_attr.adb (Analyze_Access_Attribute): Add guard.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause)
<Component_Size>: Reset the size(s) if the clause is not confirming.
* sem_eval.adb (Compile_Time_Known_Bounds): Bail out if an error has
been posted on the range node.
* sem_res.adb (Valid_Conversion): Return early on N_Raise_xxx_Error.
--
Eric Botcazoudiff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 57424bbe811..6d81fcefd26 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -197,6 +197,10 @@ package body Exp_Ch4 is
-- associated storage pool is derived from Checked_Pool, generate a
-- call to the 'Dereference' primitive operation.
+ function Is_Copy_Type (Typ : Entity_Id) return Boolean;
+ -- Return True if we can copy objects of this type when expanding an EWA
+ -- or a conditional expression.
+
function Make_Array_Comparison_Op
(Typ : Entity_Id;
Nod : Node_Id) return Node_Id;
@@ -5141,21 +5145,6 @@ package body Exp_Ch4 is
Scop : constant Entity_Id := Current_Scope;
Typ : constant Entity_Id := Etype (N);
- function Is_Copy_Type (Typ : Entity_Id) return Boolean;
- -- Return True if we can copy objects of this type when expanding a case
- -- expression.
-
- ------------------
- -- Is_Copy_Type --
- ------------------
-
- function Is_Copy_Type (Typ : Entity_Id) return Boolean is
- begin
- return Is_Elementary_Type (Underlying_Type (Typ));
- end Is_Copy_Type;
-
- -- Local variables
-
Acts : List_Id;
Alt : Node_Id;
Case_Stmt : Node_Id;
@@ -5597,37 +5586,6 @@ package body Exp_Ch4 is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
- function Is_Copy_Type (Typ : Entity_Id) return Boolean;
- -- Return True if we can copy objects of this type when expanding the
- -- node. The function must return False for limited types for semantic
- -- reasons, and more generally should do so for all by-reference types.
- -- Of course the run-time performance of the copy operation should also
- -- be taken into account, but the expansion of conditional expressions
- -- may choose to create EWA nodes instead of conditional statements to
- -- deal with the actions, in which case these EWA nodes also need to be
- -- preserved for semantic reasons. In practice, this means that the
- -- subset of types accepted by this Is_Copy_Type predicate must contain
- -- the union of the subsets of types accepted by its homonyms in the
- -- Expand_N_Case_Expression and Expand_N_If_Expression procedures, in
- -- other words must return True when at least one of them returns true.
- -- This implementation is that of Expand_N_If_Expression.Is_Copy_Type,
- -- which already accepts a superset of the types accepted by its twin
- -- Expand_N_Case_Expression.Is_Copy_Type predicate.
-
- ------------------
- -- Is_Copy_Type --
- ------------------
-
- function Is_Copy_Type (Typ : Entity_Id) return Boolean is
- Utyp : constant Entity_Id := Underlying_Type (Typ);
-
- begin
- return Is_Definite_Subtype (Utyp)
- and then not Is_By_Reference_Type (Utyp);
- end Is_Copy_Type;
-
- -- Local variables
-
Temp_Decl : Node_Id;
Temp_Id : Entity_Id;
Temp_Ref : Node_Id;
@@ -5763,27 +5721,11 @@ package body Exp_Ch4 is
-- accessibility level temp associated with the saooaaat also needs
-- to be updated as part of the assignment).
- function Is_Copy_Type (Typ : Entity_Id) return Boolean;
- -- Return True if we can copy objects of this type when expanding an if
- -- expression.
-
function OK_For_Single_Subtype (T1, T2 : Entity_Id) return Boolean;
-- Return true if it is acceptable to use a single subtype for two
-- dependent expressions of subtype T1 and T2 respectively, which are
-- unidimensional arrays whose index bounds are known at compile time.
- ------------------
- -- Is_Copy_Type --
- ------------------
-
- function Is_Copy_Type (Typ : Entity_Id) return Boolean is
- Utyp : constant Entity_Id := Underlying_Type (Typ);
-
- begin
- return Is_Definite_Subtype (Utyp)
- and then not Is_By_Reference_Type (Utyp);
- end Is_Copy_Type;
-
---------------------------
-- OK_For_Single_Subtype --
---------------------------
@@ -13841,6 +13783,44 @@ package body Exp_Ch4 is
N_Op_Minus | N_Op_Multiply | N_Op_Subtract;
end Integer_Promotion_Possible;
+ ------------------
+ -- Is_Copy_Type --
+ ------------------
+
+ function Is_Copy_Type (Typ : Entity_Id) return Boolean is
+ begin
+ -- Objects of a by-copy type can always be copied
+
+ if Is_By_Copy_Type (Typ) then
+ return True;
+
+ -- Objects of a by-reference type can never be (easily) copied
+
+ elsif Is_By_Reference_Type (Typ) then
+ return False;
+
+ -- For other objects, we consider that we can copy them if they
+ -- are small enough, the main case being small arrays of scalars.
+
+ else
+ declare
+ Utyp : constant Entity_Id := Underlying_Type (Typ);
+
+ begin
+ -- If the Object_Size is not set in the source code, then it
+ -- cannot be much larger than the Value_Size in the end.
+
+ if Known_Esize (Utyp) then
+ return Esize (Utyp) <= System_Max_Integer_Size;
+ elsif Known_RM_Size (Utyp) then
+ return RM_Size (Utyp) <= System_Max_Integer_Size;
+ else
+ return False;
+ end if;
+ end;
+ end if;
+ end Is_Copy_Type;
+
------------------------------
-- Make_Array_Comparison_Op --
------------------------------
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index db5d69507fc..51e68fbc7d6 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -497,28 +497,24 @@ package body Layout is
Set_Alignment (E, Alignment (Component_Type (E)));
end if;
- -- If packing was requested, the one-dimensional array is constrained
- -- with static bounds, the component size was set explicitly, and
- -- the alignment is known, we can set (if not set explicitly) the
- -- RM_Size and the Esize of the array type, as RM_Size is equal to
- -- (arr'length * arr'component_size) and Esize is the same value
- -- rounded to the next multiple of arr'alignment. This is not
- -- applicable to packed arrays that are implemented specially
- -- in GNAT, i.e. when Packed_Array_Impl_Type is set.
+ -- For a constrained 1-dimensional array type with known bounds and
+ -- known component size, we can set (if not already set) the RM_Size
+ -- and, if the alignment is additionally known, also the Esize of the
+ -- type, as RM_Size is equal to (Arr'Length * Arr'Component_Size) and
+ -- Esize is the same value rounded up to a multiple of Arr'Alignment.
+ -- But this is not applicable to packed arrays that are implemented
+ -- specially by GNAT, i.e. when Packed_Array_Impl_Type is set.
if Is_Array_Type (E)
- and then Present (First_Index (E)) -- Skip types in error
- and then Number_Dimensions (E) = 1
- and then No (Packed_Array_Impl_Type (E))
- and then Has_Pragma_Pack (E)
and then Is_Constrained (E)
+ and then Number_Dimensions (E) = 1
and then Compile_Time_Known_Bounds (E)
and then Known_Component_Size (E)
- and then Known_Alignment (E)
+ and then No (Packed_Array_Impl_Type (E))
then
declare
- Abits : constant Int := UI_To_Int (Alignment (E)) * SSU;
- Lo, Hi : Node_Id;
+ Hi : Node_Id;
+ Lo : Node_Id;
Siz : Uint;
begin
@@ -531,8 +527,9 @@ package body Layout is
if Compile_Time_Known_Value (Lo)
and then Compile_Time_Known_Value (Hi)
then
- Siz := (Expr_Value (Hi) - Expr_Value (Lo) + 1)
- * Component_Size (E);
+ Siz :=
+ UI_Max (Expr_Value (Hi) - Expr_Value (Lo) + 1, 0)
+ * Component_Size (E);
-- Do not overwrite a different value of 'Size specified
-- explicitly by the user. In that case, also do not set
@@ -541,9 +538,14 @@ package body Layout is
if not Known_RM_Size (E) or else RM_Size (E) = Siz then
Set_RM_Size (E, Siz);
- if not Known_Esize (E) then
- Siz := ((Siz + (Abits - 1)) / Abits) * Abits;
- Set_Esize (E, Siz);
+ if not Known_Esize (E) and then Known_Alignment (E) then
+ declare
+ Abits : constant Int :=
+ UI_To_Int (Alignment (E)) * SSU;
+ begin
+ Siz := ((Siz + (Abits - 1)) / Abits) * Abits;
+ Set_Esize (E, Siz);
+ end;
end if;
end if;
end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4d145c44e14..d711b45f13c 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -914,20 +914,23 @@ package body Sem_Attr is
("prefix of % attribute cannot be enumeration literal");
end if;
- -- Preserve relevant elaboration-related attributes of the context
- -- which are no longer available or very expensive to recompute once
- -- analysis, resolution, and expansion are over.
+ if Nkind (N) not in N_Raise_xxx_Error then
- Mark_Elaboration_Attributes
- (N_Id => N,
- Checks => True,
- Modes => True,
- Warnings => True);
+ -- Preserve relevant elaboration-related attributes of the context
+ -- which are no longer available or very expensive to recompute
+ -- once analysis, resolution, and expansion are over.
- -- Save the scenario for later examination by the ABE Processing
- -- phase.
+ Mark_Elaboration_Attributes
+ (N_Id => N,
+ Checks => True,
+ Modes => True,
+ Warnings => True);
- Record_Elaboration_Scenario (N);
+ -- Save the scenario for later examination by the ABE Processing
+ -- phase.
+
+ Record_Elaboration_Scenario (N);
+ end if;
-- Case of access to subprogram
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 853659b6ab0..b95368fd3db 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7350,6 +7350,25 @@ package body Sem_Ch13 is
Set_Biased (New_Ctyp, N, "component size clause");
end if;
+ -- If a different component size has been inherited and
+ -- no clause size has been given, then reset the size.
+
+ if Known_Component_Size (Btype)
+ and then Component_Size (Btype) /= Csize
+ then
+ if Known_RM_Size (U_Ent)
+ and then not Has_Size_Clause (U_Ent)
+ then
+ Set_RM_Size (U_Ent, No_Uint);
+ end if;
+
+ if Known_Esize (U_Ent)
+ and then not Has_Object_Size_Clause (U_Ent)
+ then
+ Set_Esize (U_Ent, No_Uint);
+ end if;
+ end if;
+
Set_Component_Size (Btype, Csize);
-- Deal with warning on overridden size
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index ffbb444cfe1..cd46aef8e6f 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1791,6 +1791,12 @@ package body Sem_Eval is
return False;
end if;
+ -- Never look at junk bounds of a broken type
+
+ if Error_Posted (Scalar_Range (Typ)) then
+ return False;
+ end if;
+
-- Otherwise check bounds for compile-time-known
if not Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 1aea3db3ba2..e862a8b7e78 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -13925,6 +13925,12 @@ package body Sem_Res is
begin
Check_Parameterless_Call (Operand);
+ -- Prevent spurious errors coming from failed checks
+
+ if Nkind (Operand) in N_Raise_xxx_Error then
+ return True;
+ end if;
+
if Is_Overloaded (Operand)
and then Is_Ambiguous_Operand (Operand)
then
