Skip to content

R
riscv-gcc-1
Commit d85fd922 by Arnaud Charlet
Options

[multiple changes] 

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
	a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
	a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
	reformatting.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
	package spec.
	* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
	* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
	while raising PE.

From-SVN: r178245
parent fd3d2680
Showing with 238 additions and 192 deletions
gcc/ada/ChangeLog
2011-08-29 Robert Dewar <dewar@adacore.com> 2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cbhama.adb, a-cbhama.ads: Minor reformatting. * a-cbhama.adb, a-cbhama.ads: Minor reformatting.
2011-08-29 Javier Miranda <miranda@adacore.com> 2011-08-29 Javier Miranda <miranda@adacore.com>
......
gcc/ada/a-cbhama.ads
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
private with Ada.Containers.Hash_Tables; private with Ada.Containers.Hash_Tables;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
generic generic
...@@ -321,11 +321,11 @@ package Ada.Containers.Bounded_Hashed_Maps is ...@@ -321,11 +321,11 @@ package Ada.Containers.Bounded_Hashed_Maps is
for Reference_Type'Read use Read; for Reference_Type'Read use Read;
function Constant_Reference function Constant_Reference
(Container : Map; Key : Key_Type) -- SHOULD BE ALIASED (Container : Map;
return Constant_Reference_Type; Key : Key_Type) -- SHOULD BE ALIASED???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type) function Reference (Container : Map; Key : Key_Type) return Reference_Type;
return Reference_Type;
private private
pragma Inline (Length); pragma Inline (Length);
...@@ -369,6 +369,12 @@ private ...@@ -369,6 +369,12 @@ private
type Map_Access is access all Map; type Map_Access is access all Map;
for Map_Access'Storage_Size use 0; for Map_Access'Storage_Size use 0;
-- Note: If a Cursor object has no explicit initialization expression,
-- it must default initialize to the same value as constant No_Element.
-- The Node component of type Cursor has scalar type Count_Type, so it
-- requires an explicit initialization expression of its own declaration,
-- in order for objects of record type Cursor to properly initialize.
type Cursor is record type Cursor is record
Container : Map_Access; Container : Map_Access;
Node : Count_Type := 0; Node : Count_Type := 0;
......
gcc/ada/a-cbhase.ads
...@@ -429,6 +429,12 @@ private ...@@ -429,6 +429,12 @@ private
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
-- Note: If a Cursor object has no explicit initialization expression,
-- it must default initialize to the same value as constant No_Element.
-- The Node component of type Cursor has scalar type Count_Type, so it
-- requires an explicit initialization expression of its own declaration,
-- in order for objects of record type Cursor to properly initialize.
type Cursor is record type Cursor is record
Container : Set_Access; Container : Set_Access;
Node : Count_Type := 0; Node : Count_Type := 0;
......
gcc/ada/a-cborma.adb
...@@ -46,7 +46,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -46,7 +46,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
end record; end record;
overriding function First (Object : Iterator) return Cursor; overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Iterator; (Object : Iterator;
...@@ -255,7 +256,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -255,7 +256,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
declare declare
LN : Node_Type renames Left.Container.Nodes (Left.Node); LN : Node_Type renames Left.Container.Nodes (Left.Node);
begin begin
return Right < LN.Key; return Right < LN.Key;
end; end;
...@@ -514,13 +514,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -514,13 +514,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function Element (Container : Map; Key : Key_Type) return Element_Type is function Element (Container : Map; Key : Key_Type) return Element_Type is
Node : constant Count_Type := Key_Ops.Find (Container, Key); Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin begin
if Node = 0 then if Node = 0 then
raise Constraint_Error with "key not in map"; raise Constraint_Error with "key not in map";
else
return Container.Nodes (Node).Element;
end if; end if;
return Container.Nodes (Node).Element;
end Element; end Element;
--------------------- ---------------------
...@@ -558,13 +557,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -558,13 +557,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function Find (Container : Map; Key : Key_Type) return Cursor is function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Find (Container, Key); Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin begin
if Node = 0 then if Node = 0 then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
----------- -----------
...@@ -575,9 +573,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -575,9 +573,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if Container.First = 0 then if Container.First = 0 then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Container.First);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Container.First);
end First; end First;
function First (Object : Iterator) return Cursor is function First (Object : Iterator) return Cursor is
...@@ -585,10 +583,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -585,10 +583,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if F = 0 then if F = 0 then
return No_Element; return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, F);
end if; end if;
return
Cursor'(Object.Container.all'Unchecked_Access, F);
end First; end First;
------------------- -------------------
...@@ -599,9 +596,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -599,9 +596,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if Container.First = 0 then if Container.First = 0 then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.First).Element;
end if; end if;
return Container.Nodes (Container.First).Element;
end First_Element; end First_Element;
--------------- ---------------
...@@ -612,9 +609,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -612,9 +609,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if Container.First = 0 then if Container.First = 0 then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.First).Key;
end if; end if;
return Container.Nodes (Container.First).Key;
end First_Key; end First_Key;
----------- -----------
...@@ -623,13 +620,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -623,13 +620,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function Floor (Container : Map; Key : Key_Type) return Cursor is function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Floor (Container, Key); Node : constant Count_Type := Key_Ops.Floor (Container, Key);
begin begin
if Node = 0 then if Node = 0 then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Floor; end Floor;
----------------- -----------------
...@@ -664,7 +660,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -664,7 +660,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
declare declare
N : Node_Type renames Container.Nodes (Position.Node); N : Node_Type renames Container.Nodes (Position.Node);
begin begin
N.Key := Key; N.Key := Key;
N.Element := New_Item; N.Element := New_Item;
...@@ -714,7 +709,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -714,7 +709,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function New_Node return Count_Type is function New_Node return Count_Type is
Result : Count_Type; Result : Count_Type;
begin begin
Allocate (Container, Result); Allocate (Container, Result);
return Result; return Result;
...@@ -778,6 +772,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -778,6 +772,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
procedure Assign (Node : in out Node_Type) is procedure Assign (Node : in out Node_Type) is
begin begin
Node.Key := Key; Node.Key := Key;
-- Why is the following commented out ???
-- Node.Element := New_Item; -- Node.Element := New_Item;
end Assign; end Assign;
...@@ -787,7 +783,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -787,7 +783,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function New_Node return Count_Type is function New_Node return Count_Type is
Result : Count_Type; Result : Count_Type;
begin begin
Allocate (Container, Result); Allocate (Container, Result);
return Result; return Result;
...@@ -823,7 +818,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -823,7 +818,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
Right : Node_Type) return Boolean Right : Node_Type) return Boolean
is is
begin begin
-- k > node same as node < k -- Left > Right same as Right < Left
return Right.Key < Left; return Right.Key < Left;
end Is_Greater_Key_Node; end Is_Greater_Key_Node;
...@@ -885,12 +880,14 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -885,12 +880,14 @@ package body Ada.Containers.Bounded_Ordered_Maps is
(Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
is is
It : constant Iterator := It : constant Iterator :=
(Container'Unrestricted_Access, Container.First); (Container'Unrestricted_Access, Container.First);
begin begin
return It; return It;
end Iterate; end Iterate;
function Iterate (Container : Map; Start : Cursor) function Iterate
(Container : Map;
Start : Cursor)
return Map_Iterator_Interfaces.Reversible_Iterator'class return Map_Iterator_Interfaces.Reversible_Iterator'class
is is
It : constant Iterator := (Container'Unrestricted_Access, Start.Node); It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
...@@ -923,9 +920,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -923,9 +920,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if Container.Last = 0 then if Container.Last = 0 then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Container.Last);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is function Last (Object : Iterator) return Cursor is
...@@ -933,10 +930,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -933,10 +930,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if F = 0 then if F = 0 then
return No_Element; return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, F);
end if; end if;
return
Cursor'(Object.Container.all'Unchecked_Access, F);
end Last; end Last;
------------------ ------------------
...@@ -947,9 +943,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -947,9 +943,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if Container.Last = 0 then if Container.Last = 0 then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.Last).Element;
end if; end if;
return Container.Nodes (Container.Last).Element;
end Last_Element; end Last_Element;
-------------- --------------
...@@ -960,9 +956,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -960,9 +956,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin begin
if Container.Last = 0 then if Container.Last = 0 then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.Last).Key;
end if; end if;
return Container.Nodes (Container.Last).Key;
end Last_Key; end Last_Key;
---------- ----------
...@@ -1199,15 +1195,17 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -1199,15 +1195,17 @@ package body Ada.Containers.Bounded_Ordered_Maps is
-- Reference -- -- Reference --
--------------- ---------------
function Constant_Reference (Container : Map; Key : Key_Type) function Constant_Reference
return Constant_Reference_Type (Container : Map;
Key : Key_Type) return Constant_Reference_Type
is is
begin begin
return (Element => Container.Element (Key)'Unrestricted_Access); return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference; end Constant_Reference;
function Reference (Container : Map; Key : Key_Type) function Reference
return Reference_Type (Container : Map;
Key : Key_Type) return Reference_Type
is is
begin begin
return (Element => Container.Element (Key)'Unrestricted_Access); return (Element => Container.Element (Key)'Unrestricted_Access);
...@@ -1299,7 +1297,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -1299,7 +1297,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
B : Natural renames Container'Unrestricted_Access.all.Busy; B : Natural renames Container'Unrestricted_Access.all.Busy;
-- Start of processing for Reverse_Iterate -- Start of processing for Reverse_Iterate
begin begin
B := B + 1; B := B + 1;
......
gcc/ada/a-cborma.ads
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
private with Ada.Containers.Red_Black_Trees; private with Ada.Containers.Red_Black_Trees;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
...@@ -48,8 +49,7 @@ package Ada.Containers.Bounded_Ordered_Maps is ...@@ -48,8 +49,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map (Capacity : Count_Type) is tagged private type Map (Capacity : Count_Type) is tagged private with
with
constant_Indexing => Constant_Reference, constant_Indexing => Constant_Reference,
Variable_Indexing => Reference, Variable_Indexing => Reference,
Default_Iterator => Iterate, Default_Iterator => Iterate,
...@@ -63,6 +63,7 @@ package Ada.Containers.Bounded_Ordered_Maps is ...@@ -63,6 +63,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
Empty_Map : constant Map; Empty_Map : constant Map;
No_Element : constant Cursor; No_Element : constant Cursor;
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
package Map_Iterator_Interfaces is new package Map_Iterator_Interfaces is new
...@@ -94,7 +95,7 @@ package Ada.Containers.Bounded_Ordered_Maps is ...@@ -94,7 +95,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
(Container : in out Map; (Container : in out Map;
Position : Cursor; Position : Cursor;
Process : not null access Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type)); procedure (Key : Key_Type; Element : in out Element_Type));
procedure Assign (Target : in out Map; Source : Map); procedure Assign (Target : in out Map; Source : Map);
...@@ -216,20 +217,22 @@ package Ada.Containers.Bounded_Ordered_Maps is ...@@ -216,20 +217,22 @@ package Ada.Containers.Bounded_Ordered_Maps is
for Reference_Type'Write use Write; for Reference_Type'Write use Write;
function Constant_Reference function Constant_Reference
(Container : Map; Key : Key_Type) -- SHOULD BE ALIASED (Container : Map;
return Constant_Reference_Type; Key : Key_Type) -- SHOULD BE ALIASED ???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type) function Reference (Container : Map; Key : Key_Type) return Reference_Type;
return Reference_Type;
procedure Iterate procedure Iterate
(Container : Map; (Container : Map;
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
function Iterate (Container : Map) function Iterate
return Map_Iterator_Interfaces.Forward_Iterator'class; (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class;
function Iterate (Container : Map; Start : Cursor) function Iterate
(Container : Map;
Start : Cursor)
return Map_Iterator_Interfaces.Reversible_Iterator'class; return Map_Iterator_Interfaces.Reversible_Iterator'class;
procedure Reverse_Iterate procedure Reverse_Iterate
......
gcc/ada/a-cborse.ads
...@@ -255,6 +255,12 @@ private ...@@ -255,6 +255,12 @@ private
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
-- Note: If a Cursor object has no explicit initialization expression,
-- it must default initialize to the same value as constant No_Element.
-- The Node component of type Cursor has scalar type Count_Type, so it
-- requires an explicit initialization expression of its own declaration,
-- in order for objects of record type Cursor to properly initialize.
type Cursor is record type Cursor is record
Container : Set_Access; Container : Set_Access;
Node : Count_Type := 0; Node : Count_Type := 0;
......
gcc/ada/a-cdlili.ads
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
private with Ada.Finalization; private with Ada.Finalization;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
generic generic
......
gcc/ada/a-cobove.adb
...@@ -28,15 +28,16 @@ ...@@ -28,15 +28,16 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Containers.Generic_Array_Sort; with Ada.Containers.Generic_Array_Sort;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Vectors is package body Ada.Containers.Bounded_Vectors is
type Iterator is new type Iterator is new
Vector_Iterator_Interfaces.Reversible_Iterator with record Vector_Iterator_Interfaces.Reversible_Iterator with record
Container : Vector_Access; Container : Vector_Access;
Index : Index_Type; Index : Index_Type;
end record; end record;
overriding function First (Object : Iterator) return Cursor; overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor; overriding function Last (Object : Iterator) return Cursor;
...@@ -643,18 +644,18 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -643,18 +644,18 @@ package body Ada.Containers.Bounded_Vectors is
begin begin
if Index > Container.Last then if Index > Container.Last then
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
else
return Container.Elements (To_Array_Index (Index));
end if; end if;
return Container.Elements (To_Array_Index (Index));
end Element; end Element;
function Element (Position : Cursor) return Element_Type is function Element (Position : Cursor) return Element_Type is
begin begin
if Position.Container = null then if Position.Container = null then
raise Constraint_Error with "Position cursor has no element"; raise Constraint_Error with "Position cursor has no element";
else
return Position.Container.Element (Position.Index);
end if; end if;
return Position.Container.Element (Position.Index);
end Element; end Element;
---------- ----------
...@@ -713,18 +714,18 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -713,18 +714,18 @@ package body Ada.Containers.Bounded_Vectors is
begin begin
if Is_Empty (Container) then if Is_Empty (Container) then
return No_Element; return No_Element;
else
return (Container'Unrestricted_Access, Index_Type'First);
end if; end if;
return (Container'Unrestricted_Access, Index_Type'First);
end First; end First;
function First (Object : Iterator) return Cursor is function First (Object : Iterator) return Cursor is
begin begin
if Is_Empty (Object.Container.all) then if Is_Empty (Object.Container.all) then
return No_Element; return No_Element;
else
return Cursor'(Object.Container, Index_Type'First);
end if; end if;
return Cursor'(Object.Container, Index_Type'First);
end First; end First;
------------------- -------------------
...@@ -735,9 +736,9 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -735,9 +736,9 @@ package body Ada.Containers.Bounded_Vectors is
begin begin
if Container.Last = No_Index then if Container.Last = No_Index then
raise Constraint_Error with "Container is empty"; raise Constraint_Error with "Container is empty";
else
return Container.Elements (To_Array_Index (Index_Type'First));
end if; end if;
return Container.Elements (To_Array_Index (Index_Type'First));
end First_Element; end First_Element;
----------------- -----------------
...@@ -1615,14 +1616,17 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1615,14 +1616,17 @@ package body Ada.Containers.Bounded_Vectors is
B := B - 1; B := B - 1;
end Iterate; end Iterate;
function Iterate (Container : Vector) function Iterate
(Container : Vector)
return Vector_Iterator_Interfaces.Reversible_Iterator'Class return Vector_Iterator_Interfaces.Reversible_Iterator'Class
is is
begin begin
return Iterator'(Container'Unrestricted_Access, Index_Type'First); return Iterator'(Container'Unrestricted_Access, Index_Type'First);
end Iterate; end Iterate;
function Iterate (Container : Vector; Start : Cursor) function Iterate
(Container : Vector;
Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class return Vector_Iterator_Interfaces.Reversible_Iterator'class
is is
begin begin
...@@ -1637,18 +1641,18 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1637,18 +1641,18 @@ package body Ada.Containers.Bounded_Vectors is
begin begin
if Is_Empty (Container) then if Is_Empty (Container) then
return No_Element; return No_Element;
else
return (Container'Unrestricted_Access, Container.Last);
end if; end if;
return (Container'Unrestricted_Access, Container.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is function Last (Object : Iterator) return Cursor is
begin begin
if Is_Empty (Object.Container.all) then if Is_Empty (Object.Container.all) then
return No_Element; return No_Element;
else
return Cursor'(Object.Container, Object.Container.Last);
end if; end if;
return Cursor'(Object.Container, Object.Container.Last);
end Last; end Last;
------------------ ------------------
...@@ -1659,9 +1663,9 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1659,9 +1663,9 @@ package body Ada.Containers.Bounded_Vectors is
begin begin
if Container.Last = No_Index then if Container.Last = No_Index then
raise Constraint_Error with "Container is empty"; raise Constraint_Error with "Container is empty";
else
return Container.Elements (Container.Length);
end if; end if;
return Container.Elements (Container.Length);
end Last_Element; end Last_Element;
---------------- ----------------
...@@ -1972,7 +1976,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1972,7 +1976,7 @@ package body Ada.Containers.Bounded_Vectors is
end if; end if;
return (Element => return (Element =>
Container.Elements (To_Array_Index (Position))'Access); Container.Elements (To_Array_Index (Position))'Access);
end Constant_Reference; end Constant_Reference;
function Reference (Container : Vector; Position : Cursor) function Reference (Container : Vector; Position : Cursor)
...@@ -1990,7 +1994,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1990,7 +1994,7 @@ package body Ada.Containers.Bounded_Vectors is
return return
(Element => (Element =>
Position.Container.Elements Position.Container.Elements
(To_Array_Index (Position.Index))'Access); (To_Array_Index (Position.Index))'Access);
end Reference; end Reference;
...@@ -1999,10 +2003,10 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1999,10 +2003,10 @@ package body Ada.Containers.Bounded_Vectors is
begin begin
if Position > Container.Last then if Position > Container.Last then
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
else
return (Element =>
Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
end if; end if;
return (Element =>
Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
end Reference; end Reference;
--------------------- ---------------------
...@@ -2274,7 +2278,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2274,7 +2278,7 @@ package body Ada.Containers.Bounded_Vectors is
-- Index >= Index_Type'First -- Index >= Index_Type'First
-- hence we also know that -- hence we also know that
-- Index - Index_Type'First >= 0 -- Index - Index_Type'First >= 0
--
-- The issue is that even though 0 is guaranteed to be a value -- 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 -- in the type Index_Type'Base, there's no guarantee that the
-- difference is a value in that type. To prevent overflow we -- difference is a value in that type. To prevent overflow we
...@@ -2377,6 +2381,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2377,6 +2381,7 @@ package body Ada.Containers.Bounded_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- Here we can compute Last directly, in the normal way. We know that -- 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 -- No_Index is less than 0, so there is no danger of overflow when
-- adding the (positive) value of Length. -- adding the (positive) value of Length.
...@@ -2436,6 +2441,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2436,6 +2441,7 @@ package body Ada.Containers.Bounded_Vectors is
-- create a Last index value greater than Index_Type'Last. -- create a Last index value greater than Index_Type'Last.
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
-- We perform a two-part test. First we determine whether the -- We perform a two-part test. First we determine whether the
-- computed Last value lies in the base range of the type, and then -- 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. -- determine whether it lies in the range of the index (sub)type.
...@@ -2464,6 +2470,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2464,6 +2470,7 @@ package body Ada.Containers.Bounded_Vectors is
end if; end if;
elsif Index_Type'First <= 0 then elsif Index_Type'First <= 0 then
-- Here we can compute Last directly, in the normal way. We know that -- 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 -- No_Index is less than 0, so there is no danger of overflow when
-- adding the (positive) value of Length. -- adding the (positive) value of Length.
......
gcc/ada/a-cobove.ads
...@@ -50,8 +50,7 @@ package Ada.Containers.Bounded_Vectors is ...@@ -50,8 +50,7 @@ package Ada.Containers.Bounded_Vectors is
No_Index : constant Extended_Index := Extended_Index'First; No_Index : constant Extended_Index := Extended_Index'First;
type Vector (Capacity : Count_Type) is tagged private type Vector (Capacity : Count_Type) is tagged private with
with
Constant_Indexing => Constant_Reference, Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference, Variable_Indexing => Reference,
Default_Iterator => Iterate, Default_Iterator => Iterate,
...@@ -300,10 +299,13 @@ package Ada.Containers.Bounded_Vectors is ...@@ -300,10 +299,13 @@ package Ada.Containers.Bounded_Vectors is
(Container : Vector; (Container : Vector;
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
function Iterate (Container : Vector) function Iterate
(Container : Vector)
return Vector_Iterator_Interfaces.Reversible_Iterator'Class; return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
function Iterate (Container : Vector; Start : Cursor) function Iterate
(Container : Vector;
Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class; return Vector_Iterator_Interfaces.Reversible_Iterator'class;
type Constant_Reference_Type type Constant_Reference_Type
......
gcc/ada/a-cohama.ads
...@@ -34,7 +34,7 @@ ...@@ -34,7 +34,7 @@
private with Ada.Containers.Hash_Tables; private with Ada.Containers.Hash_Tables;
private with Ada.Finalization; private with Ada.Finalization;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
generic generic
......
gcc/ada/a-coinve.ads
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
private with Ada.Finalization; private with Ada.Finalization;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
generic generic
......
gcc/ada/a-coorma.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -44,7 +44,8 @@ package body Ada.Containers.Ordered_Maps is ...@@ -44,7 +44,8 @@ package body Ada.Containers.Ordered_Maps is
end record; end record;
overriding function First (Object : Iterator) return Cursor; overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Iterator; (Object : Iterator;
...@@ -266,8 +267,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -266,8 +267,7 @@ package body Ada.Containers.Ordered_Maps is
-- Clear -- -- Clear --
----------- -----------
procedure Clear is procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
new Tree_Operations.Generic_Clear (Delete_Tree);
procedure Clear (Container : in out Map) is procedure Clear (Container : in out Map) is
begin begin
...@@ -283,6 +283,18 @@ package body Ada.Containers.Ordered_Maps is ...@@ -283,6 +283,18 @@ package body Ada.Containers.Ordered_Maps is
return Node.Color; return Node.Color;
end Color; end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
-------------- --------------
-- Contains -- -- Contains --
-------------- --------------
...@@ -453,25 +465,23 @@ package body Ada.Containers.Ordered_Maps is ...@@ -453,25 +465,23 @@ package body Ada.Containers.Ordered_Maps is
function First (Container : Map) return Cursor is function First (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.First = null then if T.First = null then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, T.First);
end if; end if;
return Cursor'(Container'Unrestricted_Access, T.First);
end First; end First;
function First (Object : Iterator) return Cursor is function First (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container; M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.First; N : constant Node_Access := M.Tree.First;
begin begin
if N = null then if N = null then
return No_Element; return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, N);
end if; end if;
return Cursor'(Object.Container.all'Unchecked_Access, N);
end First; end First;
------------------- -------------------
...@@ -484,9 +494,9 @@ package body Ada.Containers.Ordered_Maps is ...@@ -484,9 +494,9 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if T.First = null then if T.First = null then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return T.First.Element;
end if; end if;
return T.First.Element;
end First_Element; end First_Element;
--------------- ---------------
...@@ -495,13 +505,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -495,13 +505,12 @@ package body Ada.Containers.Ordered_Maps is
function First_Key (Container : Map) return Key_Type is function First_Key (Container : Map) return Key_Type is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.First = null then if T.First = null then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return T.First.Key;
end if; end if;
return T.First.Key;
end First_Key; end First_Key;
----------- -----------
...@@ -510,13 +519,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -510,13 +519,12 @@ package body Ada.Containers.Ordered_Maps is
function Floor (Container : Map; Key : Key_Type) return Cursor is function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key); Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
begin begin
if Node = null then if Node = null then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Floor; end Floor;
---------- ----------
...@@ -693,7 +701,8 @@ package body Ada.Containers.Ordered_Maps is ...@@ -693,7 +701,8 @@ package body Ada.Containers.Ordered_Maps is
------------------------ ------------------------
function Is_Equal_Node_Node function Is_Equal_Node_Node
(L, R : Node_Access) return Boolean is (L, R : Node_Access) return Boolean
is
begin begin
if L.Key < R.Key then if L.Key < R.Key then
return False; return False;
...@@ -715,7 +724,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -715,7 +724,7 @@ package body Ada.Containers.Ordered_Maps is
Right : Node_Access) return Boolean Right : Node_Access) return Boolean
is is
begin begin
-- k > node same as node < k -- Left > Right same as Right < Left
return Right.Key < Left; return Right.Key < Left;
end Is_Greater_Key_Node; end Is_Greater_Key_Node;
...@@ -814,25 +823,23 @@ package body Ada.Containers.Ordered_Maps is ...@@ -814,25 +823,23 @@ package body Ada.Containers.Ordered_Maps is
function Last (Container : Map) return Cursor is function Last (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.Last = null then if T.Last = null then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, T.Last);
end if; end if;
return Cursor'(Container'Unrestricted_Access, T.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is function Last (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container; M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.Last; N : constant Node_Access := M.Tree.Last;
begin begin
if N = null then if N = null then
return No_Element; return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, N);
end if; end if;
return Cursor'(Object.Container.all'Unchecked_Access, N);
end Last; end Last;
------------------ ------------------
...@@ -841,13 +848,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -841,13 +848,12 @@ package body Ada.Containers.Ordered_Maps is
function Last_Element (Container : Map) return Element_Type is function Last_Element (Container : Map) return Element_Type is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.Last = null then if T.Last = null then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return T.Last.Element;
end if; end if;
return T.Last.Element;
end Last_Element; end Last_Element;
-------------- --------------
...@@ -856,13 +862,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -856,13 +862,12 @@ package body Ada.Containers.Ordered_Maps is
function Last_Key (Container : Map) return Key_Type is function Last_Key (Container : Map) return Key_Type is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.Last = null then if T.Last = null then
raise Constraint_Error with "map is empty"; raise Constraint_Error with "map is empty";
else
return T.Last.Key;
end if; end if;
return T.Last.Key;
end Last_Key; end Last_Key;
---------- ----------
...@@ -1102,14 +1107,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1102,14 +1107,11 @@ package body Ada.Containers.Ordered_Maps is
-- Reference -- -- Reference --
--------------- ---------------
function Constant_Reference (Container : Map; Key : Key_Type) function Reference
return Constant_Reference_Type is (Container : Map;
begin Key : Key_Type)
return (Element => Container.Element (Key)'Unrestricted_Access); return Reference_Type
end Constant_Reference; is
function Reference (Container : Map; Key : Key_Type)
return Reference_Type is
begin begin
return (Element => Container.Element (Key)'Unrestricted_Access); return (Element => Container.Element (Key)'Unrestricted_Access);
end Reference; end Reference;
...@@ -1195,7 +1197,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1195,7 +1197,7 @@ package body Ada.Containers.Ordered_Maps is
B : Natural renames Container.Tree'Unrestricted_Access.all.Busy; B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
-- Start of processing for Reverse_Iterate -- Start of processing for Reverse_Iterate
begin begin
B := B + 1; B := B + 1;
......
gcc/ada/a-coorma.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -33,6 +33,7 @@ ...@@ -33,6 +33,7 @@
private with Ada.Containers.Red_Black_Trees; private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization; private with Ada.Finalization;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
...@@ -49,8 +50,7 @@ package Ada.Containers.Ordered_Maps is ...@@ -49,8 +50,7 @@ package Ada.Containers.Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private type Map is tagged private with
with
constant_Indexing => Constant_Reference, constant_Indexing => Constant_Reference,
Variable_Indexing => Reference, Variable_Indexing => Reference,
Default_Iterator => Iterate, Default_Iterator => Iterate,
...@@ -62,6 +62,7 @@ package Ada.Containers.Ordered_Maps is ...@@ -62,6 +62,7 @@ package Ada.Containers.Ordered_Maps is
Empty_Map : constant Map; Empty_Map : constant Map;
No_Element : constant Cursor; No_Element : constant Cursor;
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
package Map_Iterator_Interfaces is new package Map_Iterator_Interfaces is new
...@@ -211,8 +212,9 @@ package Ada.Containers.Ordered_Maps is ...@@ -211,8 +212,9 @@ package Ada.Containers.Ordered_Maps is
for Reference_Type'Write use Write; for Reference_Type'Write use Write;
function Constant_Reference function Constant_Reference
(Container : Map; Key : Key_Type) -- SHOULD BE ALIASED (Container : Map;
return Constant_Reference_Type; Key : Key_Type) -- SHOULD BE ALIASED???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type) function Reference (Container : Map; Key : Key_Type)
return Reference_Type; return Reference_Type;
...@@ -221,10 +223,13 @@ package Ada.Containers.Ordered_Maps is ...@@ -221,10 +223,13 @@ package Ada.Containers.Ordered_Maps is
(Container : Map; (Container : Map;
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
function Iterate (Container : Map) function Iterate
(Container : Map)
return Map_Iterator_Interfaces.Forward_Iterator'class; return Map_Iterator_Interfaces.Forward_Iterator'class;
function Iterate (Container : Map; Start : Cursor) function Iterate
(Container : Map;
Start : Cursor)
return Map_Iterator_Interfaces.Reversible_Iterator'class; return Map_Iterator_Interfaces.Reversible_Iterator'class;
procedure Reverse_Iterate procedure Reverse_Iterate
......
gcc/ada/a-coorse.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -34,7 +34,7 @@ ...@@ -34,7 +34,7 @@
private with Ada.Containers.Red_Black_Trees; private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization; private with Ada.Finalization;
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces; with Ada.Iterator_Interfaces;
generic generic
......
gcc/ada/a-except-2005.adb
...@@ -1152,8 +1152,16 @@ package body Ada.Exceptions is ...@@ -1152,8 +1152,16 @@ package body Ada.Exceptions is
end Rcheck_21; end Rcheck_21;
procedure Rcheck_22 (File : System.Address; Line : Integer) is procedure Rcheck_22 (File : System.Address; Line : Integer) is
E : constant Exception_Id := Program_Error_Def'Access;
begin begin
Raise_Program_Error_Msg (File, Line, Rmsg_22'Address); -- This is "finalize/adjust raised exception".
-- As this exception is only raised with aborts defered, it must
-- call Raise_Exception_No_Defer, contrary to all other Rcheck
-- subprograms (which defer aborts).
-- This is coherent with Raise_From_Controlled_Operation.
Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
Raise_Current_Excep (E);
end Rcheck_22; end Rcheck_22;
procedure Rcheck_23 (File : System.Address; Line : Integer) is procedure Rcheck_23 (File : System.Address; Line : Integer) is
......
gcc/ada/a-except.adb
...@@ -1083,8 +1083,16 @@ package body Ada.Exceptions is ...@@ -1083,8 +1083,16 @@ package body Ada.Exceptions is
end Rcheck_21; end Rcheck_21;
procedure Rcheck_22 (File : System.Address; Line : Integer) is procedure Rcheck_22 (File : System.Address; Line : Integer) is
E : constant Exception_Id := Program_Error_Def'Access;
begin begin
Raise_Program_Error_Msg (File, Line, Rmsg_22'Address); -- This is "finalize/adjust raised exception".
-- As this exception is only raised with aborts defered, it must
-- call Raise_Exception_No_Defer, contrary to all other Rcheck
-- subprograms (which defer aborts).
-- This is coherent with Raise_From_Controlled_Operation.
Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
Raise_Current_Excep (E);
end Rcheck_22; end Rcheck_22;
procedure Rcheck_23 (File : System.Address; Line : Integer) is procedure Rcheck_23 (File : System.Address; Line : Integer) is
......
gcc/ada/exp_ch7.adb
...@@ -301,33 +301,6 @@ package body Exp_Ch7 is ...@@ -301,33 +301,6 @@ package body Exp_Ch7 is
-- context does not contain the above constructs, the routine returns an -- context does not contain the above constructs, the routine returns an
-- empty list. -- empty list.
function Build_Exception_Handler
(Loc : Source_Ptr;
E_Id : Entity_Id;
Raised_Id : Entity_Id;
For_Library : Boolean := False) return Node_Id;
-- Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
-- _Body. Create an exception handler of the following form:
--
-- when others =>
-- if not Raised_Id then
-- Raised_Id := True;
-- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
-- end if;
--
-- If flag For_Library is set (and not in restricted profile):
--
-- when others =>
-- if not Raised_Id then
-- Raised_Id := True;
-- Save_Library_Occurrence (Get_Current_Excep.all.all);
-- end if;
--
-- E_Id denotes the defining identifier of a local exception occurrence.
-- Raised_Id is the entity of a local boolean flag. Flag For_Library is
-- used when operating at the library level, when enabled the current
-- exception will be saved to a global location.
procedure Build_Finalizer procedure Build_Finalizer
(N : Node_Id; (N : Node_Id;
Clean_Stmts : List_Id; Clean_Stmts : List_Id;
......
gcc/ada/exp_ch7.ads
...@@ -40,6 +40,33 @@ package Exp_Ch7 is ...@@ -40,6 +40,33 @@ package Exp_Ch7 is
-- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize -- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
-- that take care of finalization management at run-time. -- that take care of finalization management at run-time.
function Build_Exception_Handler
(Loc : Source_Ptr;
E_Id : Entity_Id;
Raised_Id : Entity_Id;
For_Library : Boolean := False) return Node_Id;
-- Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
-- _Body. Create an exception handler of the following form:
--
-- when others =>
-- if not Raised_Id then
-- Raised_Id := True;
-- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
-- end if;
--
-- If flag For_Library is set (and not in restricted profile):
--
-- when others =>
-- if not Raised_Id then
-- Raised_Id := True;
-- Save_Library_Occurrence (Get_Current_Excep.all.all);
-- end if;
--
-- E_Id denotes the defining identifier of a local exception occurrence.
-- Raised_Id is the entity of a local boolean flag. Flag For_Library is
-- used when operating at the library level, when enabled the current
-- exception will be saved to a global location.
procedure Build_Finalization_Master procedure Build_Finalization_Master
(Typ : Entity_Id; (Typ : Entity_Id;
Ins_Node : Node_Id := Empty; Ins_Node : Node_Id := Empty;
......
gcc/ada/exp_intr.adb
...@@ -974,29 +974,7 @@ package body Exp_Intr is ...@@ -974,29 +974,7 @@ package body Exp_Intr is
Obj_Ref => Deref, Obj_Ref => Deref,
Typ => Desig_T)), Typ => Desig_T)),
Exception_Handlers => New_List ( Exception_Handlers => New_List (
Make_Exception_Handler (Loc, Build_Exception_Handler (Loc, E_Id, Raised_Id)))));
Exception_Choices => New_List (
Make_Others_Choice (Loc)),
Statements => New_List (
Make_Assignment_Statement (Loc,
Name =>
New_Reference_To (Raised_Id, Loc),
Expression =>
New_Reference_To (Standard_True, Loc)),
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Save_Occurrence), Loc),
Parameter_Associations => New_List (
New_Reference_To (E_Id, Loc),
Make_Explicit_Dereference (Loc,
Prefix =>
Make_Function_Call (Loc,
Name =>
Make_Explicit_Dereference (Loc,
Prefix =>
New_Reference_To
(RTE (RE_Get_Current_Excep),
Loc))))))))))));
-- For .NET/JVM, detach the object from the containing finalization -- For .NET/JVM, detach the object from the containing finalization
-- collection before finalizing it. -- collection before finalizing it.
......
gcc/ada/s-tassta.adb
...@@ -1328,8 +1328,10 @@ package body System.Tasking.Stages is ...@@ -1328,8 +1328,10 @@ package body System.Tasking.Stages is
TH.all (Cause, Self_ID, EO); TH.all (Cause, Self_ID, EO);
exception exception
-- RM-C.7.3 requires all exceptions raised here to be ignored
when others => when others =>
-- RM-C.7.3 requires these exceptions to be ignored
null; null;
end; end;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment