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

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2011-08-29 16:25:19 +02:00
parent fd3d2680c8
commit d85fd922e1
20 changed files with 238 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -1,3 +1,18 @@
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.

16
gcc/ada/a-cbhama.ads
View File

@ -33,7 +33,7 @@
private with Ada.Containers.Hash_Tables;
with Ada.Streams; use Ada.Streams;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic
@ -321,11 +321,11 @@ package Ada.Containers.Bounded_Hashed_Maps is
for Reference_Type'Read use Read;
function Constant_Reference
(Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
return Constant_Reference_Type;
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type)
return Reference_Type;
function Reference (Container : Map; Key : Key_Type) return Reference_Type;
private
pragma Inline (Length);
@ -369,6 +369,12 @@ private
type Map_Access is access all Map;
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
Container : Map_Access;
Node : Count_Type := 0;

6
gcc/ada/a-cbhase.ads
View File

@ -429,6 +429,12 @@ private
type Set_Access is access all Set;
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
Container : Set_Access;
Node : Count_Type := 0;

78
gcc/ada/a-cborma.adb
View File

@ -46,7 +46,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
end record;
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
@ -255,7 +256,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
declare
LN : Node_Type renames Left.Container.Nodes (Left.Node);
begin
return Right < LN.Key;
end;
@ -514,13 +514,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function Element (Container : Map; Key : Key_Type) return Element_Type is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
if Node = 0 then
raise Constraint_Error with "key not in map";
else
return Container.Nodes (Node).Element;
end if;
return Container.Nodes (Node).Element;
end Element;
---------------------
@ -558,13 +557,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
if Node = 0 then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find;
-----------
@ -575,9 +573,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if Container.First = 0 then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Container.First);
end if;
return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
function First (Object : Iterator) return Cursor is
@ -585,10 +583,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if F = 0 then
return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, F);
end if;
return
Cursor'(Object.Container.all'Unchecked_Access, F);
end First;
-------------------
@ -599,9 +596,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if Container.First = 0 then
raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.First).Element;
end if;
return Container.Nodes (Container.First).Element;
end First_Element;
---------------
@ -612,9 +609,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if Container.First = 0 then
raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.First).Key;
end if;
return Container.Nodes (Container.First).Key;
end First_Key;
-----------
@ -623,13 +620,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Floor (Container, Key);
begin
if Node = 0 then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Floor;
-----------------
@ -664,7 +660,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
N.Key := Key;
N.Element := New_Item;
@ -714,7 +709,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function New_Node return Count_Type is
Result : Count_Type;
begin
Allocate (Container, Result);
return Result;
@ -778,6 +772,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
procedure Assign (Node : in out Node_Type) is
begin
Node.Key := Key;
-- Why is the following commented out ???
-- Node.Element := New_Item;
end Assign;
@ -787,7 +783,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
function New_Node return Count_Type is
Result : Count_Type;
begin
Allocate (Container, Result);
return Result;
@ -823,7 +818,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
Right : Node_Type) return Boolean
is
begin
-- k > node same as node < k
-- Left > Right same as Right < Left
return Right.Key < Left;
end Is_Greater_Key_Node;
@ -885,12 +880,14 @@ package body Ada.Containers.Bounded_Ordered_Maps is
(Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
is
It : constant Iterator :=
(Container'Unrestricted_Access, Container.First);
(Container'Unrestricted_Access, Container.First);
begin
return It;
end Iterate;
function Iterate (Container : Map; Start : Cursor)
function Iterate
(Container : Map;
Start : Cursor)
return Map_Iterator_Interfaces.Reversible_Iterator'class
is
It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
@ -923,9 +920,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if Container.Last = 0 then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Container.Last);
end if;
return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
@ -933,10 +930,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if F = 0 then
return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, F);
end if;
return
Cursor'(Object.Container.all'Unchecked_Access, F);
end Last;
------------------
@ -947,9 +943,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if Container.Last = 0 then
raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.Last).Element;
end if;
return Container.Nodes (Container.Last).Element;
end Last_Element;
--------------
@ -960,9 +956,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
begin
if Container.Last = 0 then
raise Constraint_Error with "map is empty";
else
return Container.Nodes (Container.Last).Key;
end if;
return Container.Nodes (Container.Last).Key;
end Last_Key;
----------
@ -1199,15 +1195,17 @@ package body Ada.Containers.Bounded_Ordered_Maps is
-- Reference --
---------------
function Constant_Reference (Container : Map; Key : Key_Type)
return Constant_Reference_Type
function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
function Reference (Container : Map; Key : Key_Type)
return Reference_Type
function Reference
(Container : Map;
Key : Key_Type) return Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
@ -1299,7 +1297,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
B : Natural renames Container'Unrestricted_Access.all.Busy;
-- Start of processing for Reverse_Iterate
-- Start of processing for Reverse_Iterate
begin
B := B + 1;

23
gcc/ada/a-cborma.ads
View File

@ -32,6 +32,7 @@
------------------------------------------------------------------------------
private with Ada.Containers.Red_Black_Trees;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
@ -48,8 +49,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map (Capacity : Count_Type) is tagged private
with
type Map (Capacity : Count_Type) is tagged private with
constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
@ -63,6 +63,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
Empty_Map : constant Map;
No_Element : constant Cursor;
function Has_Element (Position : Cursor) return Boolean;
package Map_Iterator_Interfaces is new
@ -94,7 +95,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
(Container : in out Map;
Position : Cursor;
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);
@ -216,20 +217,22 @@ package Ada.Containers.Bounded_Ordered_Maps is
for Reference_Type'Write use Write;
function Constant_Reference
(Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
return Constant_Reference_Type;
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED ???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type)
return Reference_Type;
function Reference (Container : Map; Key : Key_Type) return Reference_Type;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
function Iterate (Container : Map)
return Map_Iterator_Interfaces.Forward_Iterator'class;
function Iterate
(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;
procedure Reverse_Iterate

6
gcc/ada/a-cborse.ads
View File

@ -255,6 +255,12 @@ private
type Set_Access is access all Set;
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
Container : Set_Access;
Node : Count_Type := 0;

2
gcc/ada/a-cdlili.ads
View File

@ -33,7 +33,7 @@
private with Ada.Finalization;
with Ada.Streams; use Ada.Streams;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic

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

@ -28,15 +28,16 @@
------------------------------------------------------------------------------
with Ada.Containers.Generic_Array_Sort;
with System; use type System.Address;
package body Ada.Containers.Bounded_Vectors is
type Iterator is new
Vector_Iterator_Interfaces.Reversible_Iterator with record
Container : Vector_Access;
Index : Index_Type;
end record;
Container : Vector_Access;
Index : Index_Type;
end record;
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
@ -643,18 +644,18 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return Container.Elements (To_Array_Index (Index));
end if;
return Container.Elements (To_Array_Index (Index));
end Element;
function Element (Position : Cursor) return Element_Type is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
else
return Position.Container.Element (Position.Index);
end if;
return Position.Container.Element (Position.Index);
end Element;
----------
@ -713,18 +714,18 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Is_Empty (Container) then
return No_Element;
else
return (Container'Unrestricted_Access, Index_Type'First);
end if;
return (Container'Unrestricted_Access, Index_Type'First);
end First;
function First (Object : Iterator) return Cursor is
begin
if Is_Empty (Object.Container.all) then
return No_Element;
else
return Cursor'(Object.Container, Index_Type'First);
end if;
return Cursor'(Object.Container, Index_Type'First);
end First;
-------------------
@ -735,9 +736,9 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Container.Last = No_Index then
raise Constraint_Error with "Container is empty";
else
return Container.Elements (To_Array_Index (Index_Type'First));
end if;
return Container.Elements (To_Array_Index (Index_Type'First));
end First_Element;
-----------------
@ -1615,14 +1616,17 @@ package body Ada.Containers.Bounded_Vectors is
B := B - 1;
end Iterate;
function Iterate (Container : Vector)
function Iterate
(Container : Vector)
return Vector_Iterator_Interfaces.Reversible_Iterator'Class
is
begin
return Iterator'(Container'Unrestricted_Access, Index_Type'First);
end Iterate;
function Iterate (Container : Vector; Start : Cursor)
function Iterate
(Container : Vector;
Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class
is
begin
@ -1637,18 +1641,18 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Is_Empty (Container) then
return No_Element;
else
return (Container'Unrestricted_Access, Container.Last);
end if;
return (Container'Unrestricted_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
begin
if Is_Empty (Object.Container.all) then
return No_Element;
else
return Cursor'(Object.Container, Object.Container.Last);
end if;
return Cursor'(Object.Container, Object.Container.Last);
end Last;
------------------
@ -1659,9 +1663,9 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Container.Last = No_Index then
raise Constraint_Error with "Container is empty";
else
return Container.Elements (Container.Length);
end if;
return Container.Elements (Container.Length);
end Last_Element;
----------------
@ -1972,7 +1976,7 @@ package body Ada.Containers.Bounded_Vectors is
end if;
return (Element =>
Container.Elements (To_Array_Index (Position))'Access);
Container.Elements (To_Array_Index (Position))'Access);
end Constant_Reference;
function Reference (Container : Vector; Position : Cursor)
@ -1990,7 +1994,7 @@ package body Ada.Containers.Bounded_Vectors is
return
(Element =>
Position.Container.Elements
Position.Container.Elements
(To_Array_Index (Position.Index))'Access);
end Reference;
@ -1999,10 +2003,10 @@ package body Ada.Containers.Bounded_Vectors is
begin
if Position > Container.Last then
raise Constraint_Error with "Index is out of range";
else
return (Element =>
Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
end if;
return (Element =>
Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
end Reference;
---------------------
@ -2274,7 +2278,7 @@ package body Ada.Containers.Bounded_Vectors is
-- Index >= Index_Type'First
-- 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
@ -2377,6 +2381,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.
@ -2436,6 +2441,7 @@ package body Ada.Containers.Bounded_Vectors is
-- create a Last index value greater than Index_Type'Last.
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.
@ -2464,6 +2470,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.

10
gcc/ada/a-cobove.ads
View File

@ -50,8 +50,7 @@ package Ada.Containers.Bounded_Vectors is
No_Index : constant Extended_Index := Extended_Index'First;
type Vector (Capacity : Count_Type) is tagged private
with
type Vector (Capacity : Count_Type) is tagged private with
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
@ -300,10 +299,13 @@ package Ada.Containers.Bounded_Vectors is
(Container : Vector;
Process : not null access procedure (Position : Cursor));
function Iterate (Container : Vector)
function Iterate
(Container : Vector)
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;
type Constant_Reference_Type

2
gcc/ada/a-cohama.ads
View File

@ -34,7 +34,7 @@
private with Ada.Containers.Hash_Tables;
private with Ada.Finalization;
with Ada.Streams; use Ada.Streams;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic

2
gcc/ada/a-coinve.ads
View File

@ -33,7 +33,7 @@
private with Ada.Finalization;
with Ada.Streams; use Ada.Streams;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic

84
gcc/ada/a-coorma.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -44,7 +44,8 @@ package body Ada.Containers.Ordered_Maps is
end record;
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
@ -266,8 +267,7 @@ package body Ada.Containers.Ordered_Maps is
-- Clear --
-----------
procedure Clear is
new Tree_Operations.Generic_Clear (Delete_Tree);
procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
procedure Clear (Container : in out Map) is
begin
@ -283,6 +283,18 @@ package body Ada.Containers.Ordered_Maps is
return Node.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 --
--------------
@ -453,25 +465,23 @@ package body Ada.Containers.Ordered_Maps is
function First (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree;
begin
if T.First = null then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, T.First);
end if;
return Cursor'(Container'Unrestricted_Access, T.First);
end First;
function First (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.First;
begin
if N = null then
return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, N);
end if;
return Cursor'(Object.Container.all'Unchecked_Access, N);
end First;
-------------------
@ -484,9 +494,9 @@ package body Ada.Containers.Ordered_Maps is
begin
if T.First = null then
raise Constraint_Error with "map is empty";
else
return T.First.Element;
end if;
return T.First.Element;
end First_Element;
---------------
@ -495,13 +505,12 @@ package body Ada.Containers.Ordered_Maps is
function First_Key (Container : Map) return Key_Type is
T : Tree_Type renames Container.Tree;
begin
if T.First = null then
raise Constraint_Error with "map is empty";
else
return T.First.Key;
end if;
return T.First.Key;
end First_Key;
-----------
@ -510,13 +519,12 @@ package body Ada.Containers.Ordered_Maps is
function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
begin
if Node = null then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Floor;
----------
@ -693,7 +701,8 @@ package body Ada.Containers.Ordered_Maps is
------------------------
function Is_Equal_Node_Node
(L, R : Node_Access) return Boolean is
(L, R : Node_Access) return Boolean
is
begin
if L.Key < R.Key then
return False;
@ -715,7 +724,7 @@ package body Ada.Containers.Ordered_Maps is
Right : Node_Access) return Boolean
is
begin
-- k > node same as node < k
-- Left > Right same as Right < Left
return Right.Key < Left;
end Is_Greater_Key_Node;
@ -814,25 +823,23 @@ package body Ada.Containers.Ordered_Maps is
function Last (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree;
begin
if T.Last = null then
return No_Element;
else
return Cursor'(Container'Unrestricted_Access, T.Last);
end if;
return Cursor'(Container'Unrestricted_Access, T.Last);
end Last;
function Last (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.Last;
begin
if N = null then
return No_Element;
else
return Cursor'(Object.Container.all'Unchecked_Access, N);
end if;
return Cursor'(Object.Container.all'Unchecked_Access, N);
end Last;
------------------
@ -841,13 +848,12 @@ package body Ada.Containers.Ordered_Maps is
function Last_Element (Container : Map) return Element_Type is
T : Tree_Type renames Container.Tree;
begin
if T.Last = null then
raise Constraint_Error with "map is empty";
else
return T.Last.Element;
end if;
return T.Last.Element;
end Last_Element;
--------------
@ -856,13 +862,12 @@ package body Ada.Containers.Ordered_Maps is
function Last_Key (Container : Map) return Key_Type is
T : Tree_Type renames Container.Tree;
begin
if T.Last = null then
raise Constraint_Error with "map is empty";
else
return T.Last.Key;
end if;
return T.Last.Key;
end Last_Key;
----------
@ -1102,14 +1107,11 @@ package body Ada.Containers.Ordered_Maps is
-- 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;
function Reference (Container : Map; Key : Key_Type)
return Reference_Type is
function Reference
(Container : Map;
Key : Key_Type)
return Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Reference;
@ -1195,7 +1197,7 @@ package body Ada.Containers.Ordered_Maps is
B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
-- Start of processing for Reverse_Iterate
-- Start of processing for Reverse_Iterate
begin
B := B + 1;

19
gcc/ada/a-coorma.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -33,6 +33,7 @@
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
@ -49,8 +50,7 @@ package Ada.Containers.Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private
with
type Map is tagged private with
constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
@ -62,6 +62,7 @@ package Ada.Containers.Ordered_Maps is
Empty_Map : constant Map;
No_Element : constant Cursor;
function Has_Element (Position : Cursor) return Boolean;
package Map_Iterator_Interfaces is new
@ -211,8 +212,9 @@ package Ada.Containers.Ordered_Maps is
for Reference_Type'Write use Write;
function Constant_Reference
(Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
return Constant_Reference_Type;
(Container : Map;
Key : Key_Type) -- SHOULD BE ALIASED???
return Constant_Reference_Type;
function Reference (Container : Map; Key : Key_Type)
return Reference_Type;
@ -221,10 +223,13 @@ package Ada.Containers.Ordered_Maps is
(Container : Map;
Process : not null access procedure (Position : Cursor));
function Iterate (Container : Map)
function Iterate
(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;
procedure Reverse_Iterate

4
gcc/ada/a-coorse.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -34,7 +34,7 @@
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
with Ada.Streams; use Ada.Streams;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic

10
gcc/ada/a-except-2005.adb
View File

@ -1152,8 +1152,16 @@ package body Ada.Exceptions is
end Rcheck_21;
procedure Rcheck_22 (File : System.Address; Line : Integer) is
E : constant Exception_Id := Program_Error_Def'Access;
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;
procedure Rcheck_23 (File : System.Address; Line : Integer) is

10
gcc/ada/a-except.adb
View File

@ -1083,8 +1083,16 @@ package body Ada.Exceptions is
end Rcheck_21;
procedure Rcheck_22 (File : System.Address; Line : Integer) is
E : constant Exception_Id := Program_Error_Def'Access;
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;
procedure Rcheck_23 (File : System.Address; Line : Integer) is

27
gcc/ada/exp_ch7.adb
View File

@ -301,33 +301,6 @@ package body Exp_Ch7 is
-- context does not contain the above constructs, the routine returns an
-- 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
(N : Node_Id;
Clean_Stmts : List_Id;

27
gcc/ada/exp_ch7.ads
View File

@ -40,6 +40,33 @@ package Exp_Ch7 is
-- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
-- 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
(Typ : Entity_Id;
Ins_Node : Node_Id := Empty;

24
gcc/ada/exp_intr.adb
View File

@ -974,29 +974,7 @@ package body Exp_Intr is
Obj_Ref => Deref,
Typ => Desig_T)),
Exception_Handlers => New_List (
Make_Exception_Handler (Loc,
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))))))))))));
Build_Exception_Handler (Loc, E_Id, Raised_Id)))));
-- For .NET/JVM, detach the object from the containing finalization
-- collection before finalizing it.

4
gcc/ada/s-tassta.adb
View File

@ -1328,8 +1328,10 @@ package body System.Tasking.Stages is
TH.all (Cause, Self_ID, EO);
exception
-- RM-C.7.3 requires all exceptions raised here to be ignored
when others =>
-- RM-C.7.3 requires these exceptions to be ignored
null;
end;
end if;