From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 be2115a9086..3755d9e53de 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -765,6 +765,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 --
--------------------
@@ -880,13 +883,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
@@ -894,6 +897,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);
@@ -1160,6 +1169,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
--
2.43.0
