Follow-up of previous changes to detect ALFA subset. Deals here with array
types, which should have static bounds and have index/component types in ALFA.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-03 Yannick Moy <m...@adacore.com>
* cstand.adb (Create_Standard): select Universal_Integer as an ALFA type
* sem_ch3.adb (Array_Type_Declaration): detect array types in ALFA
* sem_util.adb, sem_util.ads (Has_Static_Array_Bounds): new function to
detect that an array has static bounds.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 177252)
+++ sem_ch3.adb (working copy)
@@ -4639,6 +4639,7 @@
Nb_Index : Nat;
P : constant Node_Id := Parent (Def);
Priv : Entity_Id;
+ T_In_ALFA : Boolean := True;
begin
if Nkind (Def) = N_Constrained_Array_Definition then
@@ -4665,6 +4666,12 @@
Check_SPARK_Restriction ("subtype mark required", Index);
end if;
+ if Present (Etype (Index))
+ and then not Is_In_ALFA (Etype (Index))
+ then
+ T_In_ALFA := False;
+ end if;
+
-- Add a subtype declaration for each index of private array type
-- declaration whose etype is also private. For example:
@@ -4740,10 +4747,18 @@
Check_SPARK_Restriction ("subtype mark required", Component_Typ);
end if;
+ if Present (Element_Type)
+ and then not Is_In_ALFA (Element_Type)
+ then
+ T_In_ALFA := False;
+ end if;
+
-- Ada 2005 (AI-230): Access Definition case
else pragma Assert (Present (Access_Definition (Component_Def)));
+ T_In_ALFA := False;
+
-- Indicate that the anonymous access type is created by the
-- array type declaration.
@@ -4820,6 +4835,12 @@
(Implicit_Base, Finalize_Storage_Only
(Element_Type));
+ -- Final check for static bounds on array
+
+ if not Has_Static_Array_Bounds (T) then
+ T_In_ALFA := False;
+ end if;
+
-- Unconstrained array case
else
@@ -4844,6 +4865,7 @@
Set_Component_Type (Base_Type (T), Element_Type);
Set_Packed_Array_Type (T, Empty);
+ Set_Is_In_ALFA (T, T_In_ALFA);
if Aliased_Present (Component_Definition (Def)) then
Check_SPARK_Restriction
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 177190)
+++ sem_util.adb (working copy)
@@ -5550,6 +5550,69 @@
end if;
end Has_Private_Component;
+ -----------------------------
+ -- Has_Static_Array_Bounds --
+ -----------------------------
+
+ function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean is
+ Ndims : constant Nat := Number_Dimensions (Typ);
+
+ Index : Node_Id;
+ Low : Node_Id;
+ High : Node_Id;
+
+ begin
+ -- Unconstrained types do not have static bounds
+
+ if not Is_Constrained (Typ) then
+ return False;
+ end if;
+
+ -- First treat specially string literals, as the lower bound and length
+ -- of string literals are not stored like those of arrays.
+
+ -- A string literal always has static bounds
+
+ if Ekind (Typ) = E_String_Literal_Subtype then
+ return True;
+ end if;
+
+ -- Treat all dimensions in turn
+
+ Index := First_Index (Typ);
+ for Indx in 1 .. Ndims loop
+
+ -- In case of an erroneous index which is not a discrete type, return
+ -- that the type is not static.
+
+ if not Is_Discrete_Type (Etype (Index))
+ or else Etype (Index) = Any_Type
+ then
+ return False;
+ end if;
+
+ Get_Index_Bounds (Index, Low, High);
+
+ if Error_Posted (Low) or else Error_Posted (High) then
+ return False;
+ end if;
+
+ if Is_OK_Static_Expression (Low)
+ and then Is_OK_Static_Expression (High)
+ then
+ null;
+ else
+ return False;
+ end if;
+
+ Next (Index);
+ end loop;
+
+ -- If we fall through the loop, all indexes matched
+
+ return True;
+ end Has_Static_Array_Bounds;
+
----------------
-- Has_Stream --
----------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 177234)
+++ sem_util.ads (working copy)
@@ -624,6 +624,9 @@
-- Check if a type has a (sub)component of a private type that has not
-- yet received a full declaration.
+ function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
+ -- Return whether an array type has static bounds
+
function Has_Stream (T : Entity_Id) return Boolean;
-- Tests if type T is derived from Ada.Streams.Root_Stream_Type, or in the
-- case of a composite type, has a component for which this predicate is
Index: cstand.adb
===================================================================
--- cstand.adb (revision 177174)
+++ cstand.adb (working copy)
@@ -1334,6 +1334,7 @@
Set_Scope (Universal_Integer, Standard_Standard);
Build_Signed_Integer_Type
(Universal_Integer, Standard_Long_Long_Integer_Size);
+ Set_Is_In_ALFA (Universal_Integer);
Universal_Real := New_Standard_Entity;
Decl := New_Node (N_Full_Type_Declaration, Stloc);
