https://gcc.gnu.org/g:e6e1d889b5603a617cbc7fca7d0f5b2751b2d489
commit r15-9924-ge6e1d889b5603a617cbc7fca7d0f5b2751b2d489
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Thu Jun 19 22:17:09 2025 +0200
ada: Fix inefficient Unchecked_Conversion to large array type
We fail to use the implementation permission given by RM 13.9(12) because
the array type does not have the Size_Known_At_Compile_Time flag set.
gcc/ada/ChangeLog:
* freeze.adb (Check_Compile_Time_Size): Try harder to see whether
the bounds of array types are known at compile time.
Diff:
---
gcc/ada/freeze.adb | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++----
1 file changed, 78 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index eb751e14944a..00895cd1aae6 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -764,6 +764,9 @@ package body Freeze is
-- in fact constrained by non-static discriminant values. Could be made
-- more precise ???
+ function Value_Known (Exp : Node_Id) return Boolean;
+ -- Return True if the value of expression Exp is known at compile time
+
--------------------
-- Set_Small_Size --
--------------------
@@ -879,13 +882,13 @@ package body Freeze is
High := Type_High_Bound (Etype (Index));
end if;
- if not Compile_Time_Known_Value (Low)
- or else not Compile_Time_Known_Value (High)
- or else Etype (Index) = Any_Type
- then
+ if Etype (Index) = Any_Type then
return False;
- else
+ elsif Compile_Time_Known_Value (Low)
+ and then Compile_Time_Known_Value (High)
+ then
+
Dim := Expr_Value (High) - Expr_Value (Low) + 1;
if Dim > Uint_0 then
@@ -893,6 +896,12 @@ package body Freeze is
else
Size := Uint_0;
end if;
+
+ elsif Value_Known (Low) and then Value_Known (High) then
+ Size := Uint_0;
+
+ else
+ return False;
end if;
Next_Index (Index);
@@ -1159,6 +1168,70 @@ package body Freeze is
return True;
end Static_Discriminated_Components;
+ -----------------
+ -- Value_Known --
+ -----------------
+
+ function Value_Known (Exp : Node_Id) return Boolean is
+ begin
+ -- This is the immediate case
+
+ if Compile_Time_Known_Value (Exp) then
+ return True;
+ end if;
+
+ -- The value may be known only to the back end, the typical example
+ -- being the alignment or the various sizes of composite types; in
+ -- the latter case, we may mutually recurse with Size_Known.
+
+ case Nkind (Exp) is
+ when N_Attribute_Reference =>
+ declare
+ P : constant Node_Id := Prefix (Exp);
+
+ begin
+ if not Is_Entity_Name (P)
+ or else not Is_Type (Entity (P))
+ then
+ return False;
+ end if;
+
+ case Get_Attribute_Id (Attribute_Name (Exp)) is
+ when Attribute_Alignment =>
+ return True;
+
+ when Attribute_Component_Size =>
+ return Size_Known (Component_Type (Entity (P)));
+
+ when Attribute_Object_Size
+ | Attribute_Size
+ | Attribute_Value_Size
+ =>
+ return Size_Known (Entity (P));
+
+ when others =>
+ return False;
+ end case;
+ end;
+
+ when N_Binary_Op =>
+ return Value_Known (Left_Opnd (Exp))
+ and then Value_Known (Right_Opnd (Exp));
+
+ when N_Qualified_Expression
+ | N_Type_Conversion
+ | N_Unchecked_Type_Conversion
+ =>
+ return Value_Known (Expression (Exp));
+
+ when N_Unary_Op =>
+ return Value_Known (Right_Opnd (Exp));
+
+ when others =>
+ return False;
+ end case;
+ end Value_Known;
+
-- Start of processing for Check_Compile_Time_Size
begin
