OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* stand.ads: Minor reformatting.

2013-04-11  Matthew Heaney  <heaney@adacore.com>

	* a-convec.adb, a-coinve.adb, a-cobove.adb ("="): Increment lock
	counts before entering loop.
	(Find, Find_Index): Ditto.
	(Is_Sorted, Merge, Sort): Ditto.
	(Reverse_Find, Reverse_Find_Index): Ditto.

From-SVN: r197765
This commit is contained in:
Arnaud Charlet 2013-04-11 12:41:49 +02:00
parent c8d636509a
commit 2602b64e3a
5 changed files with 1027 additions and 519 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2013-04-11 Robert Dewar <dewar@adacore.com>
* stand.ads: Minor reformatting.
2013-04-11 Matthew Heaney <heaney@adacore.com>
* a-convec.adb, a-coinve.adb, a-cobove.adb ("="): Increment lock
counts before entering loop.
(Find, Find_Index): Ditto.
(Is_Sorted, Merge, Sort): Ditto.
(Reverse_Find, Reverse_Find_Index): Ditto.
2013-04-11 Robert Dewar <dewar@adacore.com>
* exp_ch11.ads, exp_ch11.adb (Expand_N_Raise_Expression): New procedure.

378
gcc/ada/a-cobove.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -112,8 +112,8 @@ package body Ada.Containers.Bounded_Vectors is
raise Constraint_Error with "new length is out of range";
end if;
-- It is now safe compute the length of the new vector, without fear of
-- overflow.
-- It is now safe to compute the length of the new vector, without fear
-- of overflow.
N := LN + RN;
@ -122,6 +122,7 @@ package body Ada.Containers.Bounded_Vectors is
-- Count_Type'Base as the type for intermediate values.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We perform a two-part test. First we determine whether the
-- computed Last value lies in the base range of the type, and then
-- determine whether it lies in the range of the index (sub)type.
@ -150,6 +151,7 @@ package body Ada.Containers.Bounded_Vectors is
end if;
elsif Index_Type'First <= 0 then
-- Here we can compute Last directly, in the normal way. We know that
-- No_Index is less than 0, so there is no danger of overflow when
-- adding the (positive) value of length.
@ -280,6 +282,14 @@ package body Ada.Containers.Bounded_Vectors is
---------
overriding function "=" (Left, Right : Vector) return Boolean is
BL : Natural renames Left'Unrestricted_Access.Busy;
LL : Natural renames Left'Unrestricted_Access.Lock;
BR : Natural renames Right'Unrestricted_Access.Busy;
LR : Natural renames Right'Unrestricted_Access.Lock;
Result : Boolean;
begin
if Left'Address = Right'Address then
return True;
@ -289,13 +299,40 @@ package body Ada.Containers.Bounded_Vectors is
return False;
end if;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
BL := BL + 1;
LL := LL + 1;
BR := BR + 1;
LR := LR + 1;
Result := True;
for J in Count_Type range 1 .. Left.Length loop
if Left.Elements (J) /= Right.Elements (J) then
return False;
Result := False;
exit;
end if;
end loop;
return True;
BL := BL - 1;
LL := LL - 1;
BR := BR - 1;
LR := LR - 1;
return Result;
exception
when others =>
BL := BL - 1;
LL := LL - 1;
BR := BR - 1;
LR := LR - 1;
raise;
end "=";
------------
@ -543,7 +580,6 @@ package body Ada.Containers.Bounded_Vectors is
if Count_Type'Base'Last >= Index_Type'Pos (Index_Type'Base'Last) then
Count2 := Count_Type'Base (Old_Last) - Count_Type'Base (Index) + 1;
else
Count2 := Count_Type'Base (Old_Last - Index + 1);
end if;
@ -567,7 +603,6 @@ package body Ada.Containers.Bounded_Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Off := Count_Type'Base (Index - Index_Type'First);
New_Last := Old_Last - Index_Type'Base (Count);
else
Off := Count_Type'Base (Index) - Count_Type'Base (Index_Type'First);
New_Last := Index_Type'Base (Count_Type'Base (Old_Last) - Count);
@ -579,7 +614,6 @@ package body Ada.Containers.Bounded_Vectors is
declare
EA : Elements_Array renames Container.Elements;
Idx : constant Count_Type := EA'First + Off;
begin
EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len);
Container.Last := New_Last;
@ -621,14 +655,14 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Count = 0 then
return;
end if;
if Count >= Length (Container) then
elsif Count >= Length (Container) then
Clear (Container);
return;
end if;
Delete (Container, Index_Type'First, Count);
else
Delete (Container, Index_Type'First, Count);
end if;
end Delete_First;
-----------------
@ -738,13 +772,42 @@ package body Ada.Containers.Bounded_Vectors is
end if;
end if;
for J in Position.Index .. Container.Last loop
if Container.Elements (To_Array_Index (J)) = Item then
return (Container'Unrestricted_Access, J);
end if;
end loop;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
return No_Element;
declare
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Index_Type'Base;
begin
B := B + 1;
L := L + 1;
Result := No_Index;
for J in Position.Index .. Container.Last loop
if Container.Elements (To_Array_Index (J)) = Item then
Result := J;
exit;
end if;
end loop;
B := B - 1;
L := L - 1;
if Result = No_Index then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Find;
----------------
@ -756,14 +819,36 @@ package body Ada.Containers.Bounded_Vectors is
Item : Element_Type;
Index : Index_Type := Index_Type'First) return Extended_Index
is
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Index_Type'Base;
begin
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
B := B + 1;
L := L + 1;
Result := No_Index;
for Indx in Index .. Container.Last loop
if Container.Elements (To_Array_Index (Indx)) = Item then
return Indx;
Result := Indx;
exit;
end if;
end loop;
return No_Index;
B := B - 1;
L := L - 1;
return Result;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end Find_Index;
-----------
@ -841,17 +926,40 @@ package body Ada.Containers.Bounded_Vectors is
return True;
end if;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
declare
EA : Elements_Array renames Container.Elements;
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Boolean;
begin
B := B + 1;
L := L + 1;
Result := True;
for J in 1 .. Container.Length - 1 loop
if EA (J + 1) < EA (J) then
return False;
Result := False;
exit;
end if;
end loop;
end;
return True;
B := B - 1;
L := L - 1;
return Result;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Is_Sorted;
-----------
@ -862,7 +970,6 @@ package body Ada.Containers.Bounded_Vectors is
I, J : Count_Type;
begin
-- The semantics of Merge changed slightly per AI05-0021. It was
-- originally the case that if Target and Source denoted the same
-- container object, then the GNAT implementation of Merge did
@ -893,21 +1000,35 @@ package body Ada.Containers.Bounded_Vectors is
I := Target.Length;
Target.Set_Length (I + Source.Length);
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
declare
TA : Elements_Array renames Target.Elements;
SA : Elements_Array renames Source.Elements;
TB : Natural renames Target.Busy;
TL : Natural renames Target.Lock;
SB : Natural renames Source.Busy;
SL : Natural renames Source.Lock;
begin
TB := TB + 1;
TL := TL + 1;
SB := SB + 1;
SL := SL + 1;
J := Target.Length;
while not Source.Is_Empty loop
pragma Assert (Source.Length <= 1
or else not (SA (Source.Length) <
SA (Source.Length - 1)));
or else not (SA (Source.Length) < SA (Source.Length - 1)));
if I = 0 then
TA (1 .. J) := SA (1 .. Source.Length);
Source.Last := No_Index;
return;
exit;
end if;
pragma Assert (I <= 1
@ -924,6 +1045,22 @@ package body Ada.Containers.Bounded_Vectors is
J := J - 1;
end loop;
TB := TB - 1;
TL := TL - 1;
SB := SB - 1;
SL := SL - 1;
exception
when others =>
TB := TB - 1;
TL := TL - 1;
SB := SB - 1;
SL := SL - 1;
raise;
end;
end Merge;
@ -960,7 +1097,28 @@ package body Ada.Containers.Bounded_Vectors is
"attempt to tamper with cursors (vector is busy)";
end if;
Sort (Container.Elements (1 .. Container.Length));
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
declare
B : Natural renames Container.Busy;
L : Natural renames Container.Lock;
begin
B := B + 1;
L := L + 1;
Sort (Container.Elements (1 .. Container.Length));
B := B - 1;
L := L - 1;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Sort;
end Generic_Sorting;
@ -1056,10 +1214,12 @@ package body Ada.Containers.Bounded_Vectors is
-- acceptable, then we compute the new last index from that.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We have to handle the case when there might be more values in the
-- range of Index_Type than in the range of Count_Type.
if Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is
-- less than 0, so it is safe to compute the following sum without
-- fear of overflow.
@ -1067,6 +1227,7 @@ package body Ada.Containers.Bounded_Vectors is
Index := No_Index + Index_Type'Base (Count_Type'Last);
if Index <= Index_Type'Last then
-- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the
-- maximum number of items that are allowed.
@ -1091,6 +1252,7 @@ package body Ada.Containers.Bounded_Vectors is
end if;
elsif Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is less
-- than 0, so it is safe to compute the following sum without fear of
-- overflow.
@ -1098,6 +1260,7 @@ package body Ada.Containers.Bounded_Vectors is
J := Count_Type'Base (No_Index) + Count_Type'Last;
if J <= Count_Type'Base (Index_Type'Last) then
-- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the maximum
-- number of items that are allowed.
@ -1151,6 +1314,7 @@ package body Ada.Containers.Bounded_Vectors is
J := To_Array_Index (Before);
if Before > Container.Last then
-- The new items are being appended to the vector, so no
-- sliding of existing elements is required.
@ -1508,10 +1672,12 @@ package body Ada.Containers.Bounded_Vectors is
-- acceptable, then we compute the new last index from that.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We have to handle the case when there might be more values in the
-- range of Index_Type than in the range of Count_Type.
if Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is
-- less than 0, so it is safe to compute the following sum without
-- fear of overflow.
@ -1519,6 +1685,7 @@ package body Ada.Containers.Bounded_Vectors is
Index := No_Index + Index_Type'Base (Count_Type'Last);
if Index <= Index_Type'Last then
-- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the
-- maximum number of items that are allowed.
@ -1543,6 +1710,7 @@ package body Ada.Containers.Bounded_Vectors is
end if;
elsif Index_Type'First <= 0 then
-- We know that No_Index (the same as Index_Type'First - 1) is less
-- than 0, so it is safe to compute the following sum without fear of
-- overflow.
@ -1550,6 +1718,7 @@ package body Ada.Containers.Bounded_Vectors is
J := Count_Type'Base (No_Index) + Count_Type'Last;
if J <= Count_Type'Base (Index_Type'Last) then
-- We have determined that range of Index_Type has at least as
-- many values as in Count_Type, so Count_Type'Last is the maximum
-- number of items that are allowed.
@ -1608,6 +1777,7 @@ package body Ada.Containers.Bounded_Vectors is
-- unused storage for the new items.
if Before <= Container.Last then
-- The space is being inserted before some existing elements,
-- so we must slide the existing elements up to their new home.
@ -1927,36 +2097,30 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Index < Position.Container.Last then
elsif Position.Index < Position.Container.Last then
return (Position.Container, Position.Index + 1);
else
return No_Element;
end if;
return No_Element;
end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong vector";
else
return Next (Position);
end if;
return Next (Position);
end Next;
procedure Next (Position : in out Cursor) is
begin
if Position.Container = null then
return;
end if;
if Position.Index < Position.Container.Last then
elsif Position.Index < Position.Container.Last then
Position.Index := Position.Index + 1;
else
Position := No_Element;
@ -1992,9 +2156,7 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Position.Container = null then
return;
end if;
if Position.Index > Index_Type'First then
elsif Position.Index > Index_Type'First then
Position.Index := Position.Index - 1;
else
Position := No_Element;
@ -2005,27 +2167,23 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Index > Index_Type'First then
elsif Position.Index > Index_Type'First then
return (Position.Container, Position.Index - 1);
else
return No_Element;
end if;
return No_Element;
end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong vector";
else
return Previous (Position);
end if;
return Previous (Position);
end Previous;
-------------------
@ -2069,9 +2227,9 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
else
Query_Element (Position.Container.all, Position.Index, Process);
end if;
Query_Element (Position.Container.all, Position.Index, Process);
end Query_Element;
----------
@ -2146,9 +2304,9 @@ package body Ada.Containers.Bounded_Vectors is
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Position.Index);
J : constant Count_Type := To_Array_Index (Position.Index);
begin
return (Element => A (I)'Access);
return (Element => A (J)'Access);
end;
end Reference;
@ -2163,9 +2321,9 @@ package body Ada.Containers.Bounded_Vectors is
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Index);
J : constant Count_Type := To_Array_Index (Index);
begin
return (Element => A (I)'Access);
return (Element => A (J)'Access);
end;
end Reference;
@ -2181,14 +2339,12 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
if Container.Lock > 0 then
elsif Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
else
Container.Elements (To_Array_Index (Index)) := New_Item;
end if;
Container.Elements (To_Array_Index (Index)) := New_Item;
end Replace_Element;
procedure Replace_Element
@ -2199,22 +2355,20 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Container.Last then
elsif Position.Index > Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
if Container.Lock > 0 then
elsif Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
end if;
Container.Elements (To_Array_Index (Position.Index)) := New_Item;
else
Container.Elements (To_Array_Index (Position.Index)) := New_Item;
end if;
end Replace_Element;
----------------------
@ -2300,13 +2454,41 @@ package body Ada.Containers.Bounded_Vectors is
then Container.Last
else Position.Index);
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (To_Array_Index (Indx)) = Item then
return (Container'Unrestricted_Access, Indx);
end if;
end loop;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
return No_Element;
declare
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Index_Type'Base;
begin
B := B + 1;
L := L + 1;
Result := No_Index;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (To_Array_Index (Indx)) = Item then
Result := Indx;
exit;
end if;
end loop;
B := B - 1;
L := L - 1;
if Result = No_Index then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Reverse_Find;
------------------------
@ -2318,17 +2500,39 @@ package body Ada.Containers.Bounded_Vectors is
Item : Element_Type;
Index : Index_Type := Index_Type'Last) return Extended_Index
is
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Last : constant Index_Type'Base :=
Index_Type'Min (Container.Last, Index);
Result : Index_Type'Base;
begin
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
B := B + 1;
L := L + 1;
Result := No_Index;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements (To_Array_Index (Indx)) = Item then
return Indx;
Result := Indx;
exit;
end if;
end loop;
return No_Index;
B := B - 1;
L := L - 1;
return Result;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end Reverse_Find_Index;
---------------------
@ -2375,10 +2579,8 @@ package body Ada.Containers.Bounded_Vectors is
if Count >= 0 then
Container.Delete_Last (Count);
elsif Container.Last >= Index_Type'Last then
raise Constraint_Error with "vector is already at its maximum length";
else
Container.Insert_Space (Container.Last + 1, -Count);
end if;
@ -2451,11 +2653,11 @@ package body Ada.Containers.Bounded_Vectors is
-- hence we also know that
-- Index - Index_Type'First >= 0
-- The issue is that even though 0 is guaranteed to be a value
-- in the type Index_Type'Base, there's no guarantee that the
-- difference is a value in that type. To prevent overflow we
-- use the wider of Count_Type'Base and Index_Type'Base to
-- perform intermediate calculations.
-- The issue is that even though 0 is guaranteed to be a value in
-- the type Index_Type'Base, there's no guarantee that the difference
-- is a value in that type. To prevent overflow we use the wider
-- of Count_Type'Base and Index_Type'Base to perform intermediate
-- calculations.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Offset := Count_Type'Base (Index - Index_Type'First);

607
gcc/ada/a-coinve.adb
View File

File diff suppressed because it is too large Load Diff

519
gcc/ada/a-convec.adb
View File

@ -84,12 +84,10 @@ package body Ada.Containers.Vectors is
end if;
declare
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
new Elements_Type'(Right.Last, RE);
new Elements_Type'(Right.Last, RE);
begin
return (Controlled with Elements, Right.Last, 0, 0);
end;
@ -97,12 +95,10 @@ package body Ada.Containers.Vectors is
if RN = 0 then
declare
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access :=
new Elements_Type'(Left.Last, LE);
new Elements_Type'(Left.Last, LE);
begin
return (Controlled with Elements, Left.Last, 0, 0);
end;
@ -197,15 +193,12 @@ package body Ada.Containers.Vectors is
end if;
declare
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
new Elements_Type'(Last, LE & RE);
new Elements_Type'(Last, LE & RE);
begin
return (Controlled with Elements, Last, 0, 0);
end;
@ -247,14 +240,11 @@ package body Ada.Containers.Vectors is
end if;
declare
Last : constant Index_Type := Left.Last + 1;
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Last : constant Index_Type := Left.Last + 1;
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access :=
new Elements_Type'(Last => Last, EA => LE & Right);
new Elements_Type'(Last => Last, EA => LE & Right);
begin
return (Controlled with Elements, Last, 0, 0);
end;
@ -275,7 +265,6 @@ package body Ada.Containers.Vectors is
new Elements_Type'
(Last => Index_Type'First,
EA => (others => Left));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
end;
@ -346,6 +335,14 @@ package body Ada.Containers.Vectors is
---------
overriding function "=" (Left, Right : Vector) return Boolean is
BL : Natural renames Left'Unrestricted_Access.Busy;
LL : Natural renames Left'Unrestricted_Access.Lock;
BR : Natural renames Right'Unrestricted_Access.Busy;
LR : Natural renames Right'Unrestricted_Access.Lock;
Result : Boolean;
begin
if Left'Address = Right'Address then
return True;
@ -355,13 +352,40 @@ package body Ada.Containers.Vectors is
return False;
end if;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
BL := BL + 1;
LL := LL + 1;
BR := BR + 1;
LR := LR + 1;
Result := True;
for J in Index_Type range Index_Type'First .. Left.Last loop
if Left.Elements.EA (J) /= Right.Elements.EA (J) then
return False;
Result := False;
exit;
end if;
end loop;
return True;
BL := BL - 1;
LL := LL - 1;
BR := BR - 1;
LR := LR - 1;
return Result;
exception
when others =>
BL := BL - 1;
LL := LL - 1;
BR := BR - 1;
LR := LR - 1;
raise;
end "=";
------------
@ -418,16 +442,11 @@ package body Ada.Containers.Vectors is
begin
if Is_Empty (New_Item) then
return;
end if;
if Container.Last = Index_Type'Last then
elsif Container.Last = Index_Type'Last then
raise Constraint_Error with "vector is already at its maximum length";
else
Insert (Container, Container.Last + 1, New_Item);
end if;
Insert
(Container,
Container.Last + 1,
New_Item);
end Append;
procedure Append
@ -438,17 +457,11 @@ package body Ada.Containers.Vectors is
begin
if Count = 0 then
return;
end if;
if Container.Last = Index_Type'Last then
elsif Container.Last = Index_Type'Last then
raise Constraint_Error with "vector is already at its maximum length";
else
Insert (Container, Container.Last + 1, New_Item, Count);
end if;
Insert
(Container,
Container.Last + 1,
New_Item,
Count);
end Append;
------------
@ -459,10 +472,10 @@ package body Ada.Containers.Vectors is
begin
if Target'Address = Source'Address then
return;
else
Target.Clear;
Target.Append (Source);
end if;
Target.Clear;
Target.Append (Source);
end Assign;
--------------
@ -638,9 +651,9 @@ package body Ada.Containers.Vectors is
if Index > Old_Last then
if Index > Old_Last + 1 then
raise Constraint_Error with "Index is out of range (too large)";
else
return;
end if;
return;
end if;
-- Here and elsewhere we treat deleting 0 items from the container as a
@ -668,7 +681,6 @@ package body Ada.Containers.Vectors is
if Count_Type'Base'Last >= Index_Type'Pos (Index_Type'Base'Last) then
Count2 := Count_Type'Base (Old_Last) - Count_Type'Base (Index) + 1;
else
Count2 := Count_Type'Base (Old_Last - Index + 1);
end if;
@ -694,7 +706,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
New_Last := Old_Last - Index_Type'Base (Count);
J := Index + Index_Type'Base (Count);
else
New_Last := Index_Type'Base (Count_Type'Base (Old_Last) - Count);
J := Index_Type'Base (Count_Type'Base (Index) + Count);
@ -708,7 +719,6 @@ package body Ada.Containers.Vectors is
declare
EA : Elements_Array renames Container.Elements.EA;
begin
EA (Index .. New_Last) := EA (J .. Old_Last);
Container.Last := New_Last;
@ -725,18 +735,17 @@ package body Ada.Containers.Vectors is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Container.Last then
elsif Position.Index > Container.Last then
raise Program_Error with "Position index is out of range";
end if;
Delete (Container, Position.Index, Count);
Position := No_Element;
else
Delete (Container, Position.Index, Count);
Position := No_Element;
end if;
end Delete;
------------------
@ -750,14 +759,14 @@ package body Ada.Containers.Vectors is
begin
if Count = 0 then
return;
end if;
if Count >= Length (Container) then
elsif Count >= Length (Container) then
Clear (Container);
return;
end if;
Delete (Container, Index_Type'First, Count);
else
Delete (Container, Index_Type'First, Count);
end if;
end Delete_First;
-----------------
@ -823,9 +832,9 @@ package body Ada.Containers.Vectors is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return Container.Elements.EA (Index);
end if;
return Container.Elements.EA (Index);
end Element;
function Element (Position : Cursor) return Element_Type is
@ -850,11 +859,12 @@ package body Ada.Containers.Vectors is
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is busy)";
end if;
Container.Elements := null;
Container.Last := No_Index;
Free (X);
else
Container.Elements := null;
Container.Last := No_Index;
Free (X);
end if;
end Finalize;
procedure Finalize (Object : in out Iterator) is
@ -899,13 +909,42 @@ package body Ada.Containers.Vectors is
end if;
end if;
for J in Position.Index .. Container.Last loop
if Container.Elements.EA (J) = Item then
return (Container'Unrestricted_Access, J);
end if;
end loop;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
return No_Element;
declare
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Index_Type'Base;
begin
B := B + 1;
L := L + 1;
Result := No_Index;
for J in Position.Index .. Container.Last loop
if Container.Elements.EA (J) = Item then
Result := J;
exit;
end if;
end loop;
B := B - 1;
L := L - 1;
if Result = No_Index then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Find;
----------------
@ -917,14 +956,36 @@ package body Ada.Containers.Vectors is
Item : Element_Type;
Index : Index_Type := Index_Type'First) return Extended_Index
is
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Index_Type'Base;
begin
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
B := B + 1;
L := L + 1;
Result := No_Index;
for Indx in Index .. Container.Last loop
if Container.Elements.EA (Indx) = Item then
return Indx;
Result := Indx;
exit;
end if;
end loop;
return No_Index;
B := B - 1;
L := L - 1;
return Result;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end Find_Index;
-----------
@ -1002,17 +1063,40 @@ package body Ada.Containers.Vectors is
return True;
end if;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
declare
EA : Elements_Array renames Container.Elements.EA;
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Boolean;
begin
B := B + 1;
L := L + 1;
Result := True;
for J in Index_Type'First .. Container.Last - 1 loop
if EA (J + 1) < EA (J) then
return False;
Result := False;
exit;
end if;
end loop;
end;
return True;
B := B - 1;
L := L - 1;
return Result;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Is_Sorted;
-----------
@ -1053,23 +1137,38 @@ package body Ada.Containers.Vectors is
Target.Set_Length (Length (Target) + Length (Source));
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
declare
TA : Elements_Array renames Target.Elements.EA;
SA : Elements_Array renames Source.Elements.EA;
TB : Natural renames Target.Busy;
TL : Natural renames Target.Lock;
SB : Natural renames Source.Busy;
SL : Natural renames Source.Lock;
begin
TB := TB + 1;
TL := TL + 1;
SB := SB + 1;
SL := SL + 1;
J := Target.Last;
while Source.Last >= Index_Type'First loop
pragma Assert (Source.Last <= Index_Type'First
or else not (SA (Source.Last) <
SA (Source.Last - 1)));
or else not (SA (Source.Last) <
SA (Source.Last - 1)));
if I < Index_Type'First then
TA (Index_Type'First .. J) :=
SA (Index_Type'First .. Source.Last);
Source.Last := No_Index;
return;
exit;
end if;
pragma Assert (I <= Index_Type'First
@ -1086,6 +1185,22 @@ package body Ada.Containers.Vectors is
J := J - 1;
end loop;
TB := TB - 1;
TL := TL - 1;
SB := SB - 1;
SL := SL - 1;
exception
when others =>
TB := TB - 1;
TL := TL - 1;
SB := SB - 1;
SL := SL - 1;
raise;
end;
end Merge;
@ -1122,7 +1237,28 @@ package body Ada.Containers.Vectors is
"attempt to tamper with cursors (vector is busy)";
end if;
Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
declare
B : Natural renames Container.Busy;
L : Natural renames Container.Lock;
begin
B := B + 1;
L := L + 1;
Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
B := B - 1;
L := L - 1;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Sort;
end Generic_Sorting;
@ -1182,9 +1318,7 @@ package body Ada.Containers.Vectors is
-- deeper flaw in the caller's algorithm, so that case is treated as a
-- proper error.)
if Before > Container.Last
and then Before > Container.Last + 1
then
if Before > Container.Last and then Before > Container.Last + 1 then
raise Constraint_Error with
"Before index is out of range (too large)";
end if;
@ -1374,7 +1508,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Index := Before + Index_Type'Base (Count);
else
Index := Index_Type'Base (Count_Type'Base (Before) + Count);
end if;
@ -1402,9 +1535,9 @@ package body Ada.Containers.Vectors is
if New_Capacity > Count_Type'Last / 2 then
New_Capacity := Count_Type'Last;
exit;
else
New_Capacity := 2 * New_Capacity;
end if;
New_Capacity := 2 * New_Capacity;
end loop;
if New_Capacity > Max_Length then
@ -1421,7 +1554,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Dst_Last := No_Index + Index_Type'Base (New_Capacity);
else
Dst_Last :=
Index_Type'Base (Count_Type'Base (No_Index) + New_Capacity);
@ -1455,7 +1587,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Index := Before + Index_Type'Base (Count);
else
Index := Index_Type'Base (Count_Type'Base (Before) + Count);
end if;
@ -1475,6 +1606,7 @@ package body Ada.Containers.Vectors is
declare
X : Elements_Access := Container.Elements;
begin
-- We first isolate the old internal array, removing it from the
-- container and replacing it with the new internal array, before we
@ -1518,7 +1650,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
J := (Before - 1) + Index_Type'Base (N);
else
J := Index_Type'Base (Count_Type'Base (Before - 1) + N);
end if;
@ -1549,7 +1680,7 @@ package body Ada.Containers.Vectors is
Index_Type'First .. L;
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
Container.Elements.EA (Src_Index_Subtype);
K : Index_Type'Base;
@ -1562,7 +1693,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
K := L + Index_Type'Base (Src'Length);
else
K := Index_Type'Base (Count_Type'Base (L) + Src'Length);
end if;
@ -1594,7 +1724,7 @@ package body Ada.Containers.Vectors is
F .. Container.Last;
Src : Elements_Array renames
Container.Elements.EA (Src_Index_Subtype);
Container.Elements.EA (Src_Index_Subtype);
K : Index_Type'Base;
@ -1606,7 +1736,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
K := F - Index_Type'Base (Src'Length);
else
K := Index_Type'Base (Count_Type'Base (F) - Src'Length);
end if;
@ -1633,9 +1762,7 @@ package body Ada.Containers.Vectors is
return;
end if;
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
@ -1666,9 +1793,7 @@ package body Ada.Containers.Vectors is
end if;
if Is_Empty (New_Item) then
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
Position := No_Element;
else
Position := (Container'Unrestricted_Access, Before.Index);
@ -1677,9 +1802,7 @@ package body Ada.Containers.Vectors is
return;
end if;
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
@ -1715,9 +1838,7 @@ package body Ada.Containers.Vectors is
return;
end if;
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
@ -1749,9 +1870,7 @@ package body Ada.Containers.Vectors is
end if;
if Count = 0 then
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
Position := No_Element;
else
Position := (Container'Unrestricted_Access, Before.Index);
@ -1760,9 +1879,7 @@ package body Ada.Containers.Vectors is
return;
end if;
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
@ -1799,7 +1916,6 @@ package body Ada.Containers.Vectors is
is
New_Item : Element_Type; -- Default-initialized value
pragma Warnings (Off, New_Item);
begin
Insert (Container, Before, New_Item, Position, Count);
end Insert;
@ -1849,9 +1965,7 @@ package body Ada.Containers.Vectors is
-- deeper flaw in the caller's algorithm, so that case is treated as a
-- proper error.)
if Before > Container.Last
and then Before > Container.Last + 1
then
if Before > Container.Last and then Before > Container.Last + 1 then
raise Constraint_Error with
"Before index is out of range (too large)";
end if;
@ -1973,7 +2087,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
New_Last := No_Index + Index_Type'Base (New_Length);
else
New_Last := Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
end if;
@ -2081,7 +2194,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Dst_Last := No_Index + Index_Type'Base (New_Capacity);
else
Dst_Last :=
Index_Type'Base (Count_Type'Base (No_Index) + New_Capacity);
@ -2113,7 +2225,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
Index := Before + Index_Type'Base (Count);
else
Index := Index_Type'Base (Count_Type'Base (Before) + Count);
end if;
@ -2166,9 +2277,7 @@ package body Ada.Containers.Vectors is
end if;
if Count = 0 then
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
Position := No_Element;
else
Position := (Container'Unrestricted_Access, Before.Index);
@ -2177,9 +2286,7 @@ package body Ada.Containers.Vectors is
return;
end if;
if Before.Container = null
or else Before.Index > Container.Last
then
if Before.Container = null or else Before.Index > Container.Last then
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
@ -2250,9 +2357,9 @@ package body Ada.Containers.Vectors is
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
(Limited_Controlled with
Container => V,
Index => No_Index)
(Limited_Controlled with
Container => V,
Index => No_Index)
do
B := B + 1;
end return;
@ -2303,9 +2410,9 @@ package body Ada.Containers.Vectors is
-- is a forward or reverse iteration.
return It : constant Iterator :=
(Limited_Controlled with
Container => V,
Index => Start.Index)
(Limited_Controlled with
Container => V,
Index => Start.Index)
do
B := B + 1;
end return;
@ -2455,14 +2562,12 @@ package body Ada.Containers.Vectors is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong vector";
else
return Next (Position);
end if;
return Next (Position);
end Next;
procedure Next (Position : in out Cursor) is
@ -2491,10 +2596,7 @@ package body Ada.Containers.Vectors is
Count : Count_Type := 1)
is
begin
Insert (Container,
Index_Type'First,
New_Item,
Count);
Insert (Container, Index_Type'First, New_Item, Count);
end Prepend;
--------------
@ -2516,14 +2618,12 @@ package body Ada.Containers.Vectors is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong vector";
else
return Previous (Position);
end if;
return Previous (Position);
end Previous;
procedure Previous (Position : in out Cursor) is
@ -2578,9 +2678,9 @@ package body Ada.Containers.Vectors is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
else
Query_Element (Position.Container.all, Position.Index, Process);
end if;
Query_Element (Position.Container.all, Position.Index, Process);
end Query_Element;
----------
@ -2677,6 +2777,7 @@ package body Ada.Containers.Vectors is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
declare
C : Vector renames Container'Unrestricted_Access.all;
@ -2706,14 +2807,12 @@ package body Ada.Containers.Vectors is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
if Container.Lock > 0 then
elsif Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
else
Container.Elements.EA (Index) := New_Item;
end if;
Container.Elements.EA (Index) := New_Item;
end Replace_Element;
procedure Replace_Element
@ -2724,22 +2823,21 @@ package body Ada.Containers.Vectors is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with "Position cursor denotes wrong container";
end if;
if Position.Index > Container.Last then
elsif Position.Index > Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
end if;
else
if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
end if;
Container.Elements.EA (Position.Index) := New_Item;
Container.Elements.EA (Position.Index) := New_Item;
end if;
end Replace_Element;
----------------------
@ -3126,13 +3224,42 @@ package body Ada.Containers.Vectors is
then Container.Last
else Position.Index);
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements.EA (Indx) = Item then
return (Container'Unrestricted_Access, Indx);
end if;
end loop;
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
return No_Element;
declare
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Result : Index_Type'Base;
begin
B := B + 1;
L := L + 1;
Result := No_Index;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements.EA (Indx) = Item then
Result := Indx;
exit;
end if;
end loop;
B := B - 1;
L := L - 1;
if Result = No_Index then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end;
end Reverse_Find;
------------------------
@ -3144,17 +3271,39 @@ package body Ada.Containers.Vectors is
Item : Element_Type;
Index : Index_Type := Index_Type'Last) return Extended_Index
is
B : Natural renames Container'Unrestricted_Access.Busy;
L : Natural renames Container'Unrestricted_Access.Lock;
Last : constant Index_Type'Base :=
Index_Type'Min (Container.Last, Index);
Result : Index_Type'Base;
begin
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
B := B + 1;
L := L + 1;
Result := No_Index;
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements.EA (Indx) = Item then
return Indx;
Result := Indx;
exit;
end if;
end loop;
return No_Index;
B := B - 1;
L := L - 1;
return Result;
exception
when others =>
B := B - 1;
L := L - 1;
raise;
end Reverse_Find_Index;
---------------------
@ -3245,21 +3394,19 @@ package body Ada.Containers.Vectors is
begin
if I.Container = null then
raise Constraint_Error with "I cursor has no element";
end if;
if J.Container = null then
elsif J.Container = null then
raise Constraint_Error with "J cursor has no element";
end if;
if I.Container /= Container'Unrestricted_Access then
elsif I.Container /= Container'Unrestricted_Access then
raise Program_Error with "I cursor denotes wrong container";
end if;
if J.Container /= Container'Unrestricted_Access then
elsif J.Container /= Container'Unrestricted_Access then
raise Program_Error with "J cursor denotes wrong container";
end if;
Swap (Container, I.Index, J.Index);
else
Swap (Container, I.Index, J.Index);
end if;
end Swap;
---------------
@ -3286,13 +3433,11 @@ package body Ada.Containers.Vectors is
begin
if Position.Container = null then
return No_Index;
end if;
if Position.Index <= Position.Container.Last then
elsif Position.Index <= Position.Container.Last then
return Position.Index;
else
return No_Index;
end if;
return No_Index;
end To_Index;
---------------

30
gcc/ada/stand.ads
View File

@ -364,23 +364,21 @@ package Stand is
Any_Type : Entity_Id;
-- Used to represent some unknown type. Any_Type is the type of an
-- unresolved operator, and it is the type of a node where a type error
-- has been detected. Any_Type plays an important role in avoiding
-- cascaded errors, because it is compatible with all other types, and is
-- propagated to any expression that has a subexpression of Any_Type.
-- When resolving operators, Any_Type is the initial type of the node
-- before any of its candidate interpretations has been examined. If after
-- examining all of them the type is still Any_Type, the node has no
-- possible interpretation and an error can be emitted (and Any_Type will
-- be propagated upwards).
-- has been detected. Any_Type plays an important role in avoiding cascaded
-- errors, because it is compatible with all other types, and is propagated
-- to any expression that has a subexpression of Any_Type. When resolving
-- operators, Any_Type is the initial type of the node before any of its
-- candidate interpretations has been examined. If after examining all of
-- them the type is still Any_Type, the node has no possible interpretation
-- and an error can be emitted (and Any_Type will be propagated upwards).
--
-- There is one situation in which Any_Type is used to legitimately
-- represent a case where the type is not known pre-resolution, and
-- that is for the N_Raise_Expression node. In this case, the Etype
-- being set to Any_Type is normal and does not represent an error.
-- In particular, it is compatible with the type of any constituend of
-- the enclosing expression, if any. The type is eventually replaced
-- with the type of the context, which plays no role in the resolution
-- of the Raise_Expression.
-- represent a case where the type is not known pre-resolution, and that
-- is for the N_Raise_Expression node. In this case, the Etype being set to
-- Any_Type is normal and does not represent an error. In particular, it is
-- compatible with the type of any constituent of the enclosing expression,
-- if any. The type is eventually replaced with the type of the context,
-- which plays no role in the resolution of the Raise_Expression.
Any_Access : Entity_Id;
-- Used to resolve the overloaded literal NULL