This patch adds code to retrieve the index type of a string literal. Since
string literals do not use attribute First_Index, the proper index type is
obtained from their low bound. No changes in compiler behavior.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-04-26 Hristian Kirtchev <kirtc...@adacore.com>
* einfo.adb, einfo.ads: Remove synthesized attribute
Proper_First_Index along with its associations in various nodes.
(Proper_First_Index): Removed.
* sem_ch4.adb (Analyze_Slice): Alphabetize constants. Add new
local variable Index_Type. The index type of a string literal
subtype is that of the stored low bound.
* sem_eval (Get_Static_Length): Remove the use of Proper_First_Index.
* sem_res.adb (Resolve_Slice): Alphabetize constants. Add
new local variable Index_Type. The index type of a
string literal subtype is that of the stored low bound.
(Set_String_Literal_Subtype): Code reformatting.
Index: einfo.adb
===================================================================
--- einfo.adb (revision 186866)
+++ einfo.adb (working copy)
@@ -6456,26 +6456,6 @@
and then Present (Prival_Link (Id)));
end Is_Prival;
- ------------------------
- -- Proper_First_Index --
- ------------------------
-
- function Proper_First_Index (Id : E) return E is
- Typ : Entity_Id;
-
- begin
- Typ := Id;
-
- -- The First_Index field is always empty for string literals, use the
- -- base type instead.
-
- if Ekind (Typ) = E_String_Literal_Subtype then
- Typ := Base_Type (Typ);
- end if;
-
- return First_Index (Typ);
- end Proper_First_Index;
-
----------------------------
-- Is_Protected_Component --
----------------------------
Index: einfo.ads
===================================================================
--- einfo.ads (revision 186866)
+++ einfo.ads (working copy)
@@ -3393,11 +3393,6 @@
-- in the shadow entity, it points to the proper location in which to
-- restore the private view saved in the shadow.
--- Proper_First_Index (synthesized)
--- Applies to array types and subtypes. Returns the First_Index of the
--- type unless it is a string literal. In that case, the First_Index is
--- obtained from the base type.
-
-- Protected_Formal (Node22)
-- Present in formal parameters (in, in out and out parameters). Used
-- only for formals of protected operations. References corresponding
@@ -5031,7 +5026,6 @@
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)
- -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_Block
@@ -5694,7 +5688,6 @@
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)
- -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_String_Literal_Subtype
@@ -5702,7 +5695,6 @@
-- String_Literal_Length (Uint16)
-- First_Index (Node17) (always Empty)
-- Packed_Array_Type (Node23)
- -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_Subprogram_Body
@@ -6540,7 +6532,6 @@
function Number_Formals (Id : E) return Pos;
function Parameter_Mode (Id : E) return Formal_Kind;
function Primitive_Operations (Id : E) return L;
- function Proper_First_Index (Id : E) return E;
function Root_Type (Id : E) return E;
function Safe_Emax_Value (Id : E) return U;
function Safe_First_Value (Id : E) return R;
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 186860)
+++ sem_res.adb (working copy)
@@ -8880,10 +8880,10 @@
-------------------
procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id) is
+ Drange : constant Node_Id := Discrete_Range (N);
Name : constant Node_Id := Prefix (N);
- Drange : constant Node_Id := Discrete_Range (N);
Array_Type : Entity_Id := Empty;
- Index : Node_Id;
+ Index_Type : Entity_Id;
begin
if Is_Overloaded (Name) then
@@ -9003,9 +9003,14 @@
-- necessary. Else resolve the bounds, and apply needed checks.
if not Is_Entity_Name (Drange) then
- Index := Proper_First_Index (Array_Type);
- Resolve (Drange, Base_Type (Etype (Index)));
+ if Ekind (Array_Type) = E_String_Literal_Subtype then
+ Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+ else
+ Index_Type := Etype (First_Index (Array_Type));
+ end if;
+ Resolve (Drange, Base_Type (Index_Type));
+
if Nkind (Drange) = N_Range then
-- Ensure that side effects in the bounds are properly handled
@@ -9026,7 +9031,7 @@
and then Entity (Selector_Name (Prefix (N))) =
RTE_Record_Component (RE_Prims_Ptr))
then
- Apply_Range_Check (Drange, Etype (Index));
+ Apply_Range_Check (Drange, Index_Type);
end if;
end if;
end if;
@@ -10119,26 +10124,24 @@
Set_Is_Constrained (Subtype_Id);
Set_Etype (N, Subtype_Id);
- if Is_OK_Static_Expression (Low_Bound) then
-
-- The low bound is set from the low bound of the corresponding index
-- type. Note that we do not store the high bound in the string literal
-- subtype, but it can be deduced if necessary from the length and the
-- low bound.
+ if Is_OK_Static_Expression (Low_Bound) then
Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);
+ -- If the lower bound is not static we create a range for the string
+ -- literal, using the index type and the known length of the literal.
+ -- The index type is not necessarily Positive, so the upper bound is
+ -- computed as T'Val (T'Pos (Low_Bound) + L - 1).
+
else
- -- If the lower bound is not static we create a range for the string
- -- literal, using the index type and the known length of the literal.
- -- The index type is not necessarily Positive, so the upper bound is
- -- computed as T'Val (T'Pos (Low_Bound) + L - 1)
-
declare
- Index_List : constant List_Id := New_List;
- Index_Type : constant Entity_Id := Etype (First_Index (Typ));
-
- High_Bound : constant Node_Id :=
+ Index_List : constant List_Id := New_List;
+ Index_Type : constant Entity_Id := Etype (First_Index (Typ));
+ High_Bound : constant Node_Id :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Val,
Prefix =>
@@ -10157,9 +10160,9 @@
String_Length (Strval (N)) - 1))));
Array_Subtype : Entity_Id;
- Index_Subtype : Entity_Id;
Drange : Node_Id;
Index : Node_Id;
+ Index_Subtype : Entity_Id;
begin
if Is_Integer_Type (Index_Type) then
@@ -10214,7 +10217,7 @@
Rewrite (N,
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Array_Subtype, Loc),
- Expression => Relocate_Node (N)));
+ Expression => Relocate_Node (N)));
Set_Etype (N, Array_Subtype);
end;
end if;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 186860)
+++ sem_ch4.adb (working copy)
@@ -4440,9 +4440,10 @@
-------------------
procedure Analyze_Slice (N : Node_Id) is
+ D : constant Node_Id := Discrete_Range (N);
P : constant Node_Id := Prefix (N);
- D : constant Node_Id := Discrete_Range (N);
Array_Type : Entity_Id;
+ Index_Type : Entity_Id;
procedure Analyze_Overloaded_Slice;
-- If the prefix is overloaded, select those interpretations that
@@ -4513,13 +4514,18 @@
Error_Msg_N
("type is not one-dimensional array in slice prefix", N);
- elsif not
- Has_Compatible_Type (D, Etype (Proper_First_Index (Array_Type)))
- then
- Wrong_Type (D, Etype (Proper_First_Index (Array_Type)));
+ else
+ if Ekind (Array_Type) = E_String_Literal_Subtype then
+ Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+ else
+ Index_Type := Etype (First_Index (Array_Type));
+ end if;
- else
- Set_Etype (N, Array_Type);
+ if not Has_Compatible_Type (D, Index_Type) then
+ Wrong_Type (D, Index_Type);
+ else
+ Set_Etype (N, Array_Type);
+ end if;
end if;
end if;
end Analyze_Slice;
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 186860)
+++ sem_eval.adb (working copy)
@@ -554,7 +554,7 @@
if Attribute_Name (N) = Name_First then
return String_Literal_Low_Bound (Xtyp);
- else -- Attribute_Name (N) = Name_Last
+ else
return Make_Integer_Literal (Sloc (N),
Intval => Intval (String_Literal_Low_Bound (Xtyp))
+ String_Literal_Length (Xtyp));
@@ -2747,7 +2747,7 @@
-- General case
- T := Etype (Proper_First_Index (Etype (Op)));
+ T := Etype (First_Index (Etype (Op)));
-- The simple case, both bounds are known at compile time
