[multiple changes]

2011-11-23  Matthew Heaney  <heaney@adacore.com>

	* a-coorse.ads, a-ciorse.ads, a-cborse.ads (Set_Iterator_Interfaces):
	Renamed from Ordered_Set_Iterator_Interfaces.
	* a-coorse.adb, a-ciorse.adb, a-cborse.adb (Iterator): Declared
	Iterator type as limited (First, Last): Cursor return value
	depends on iterator node value (Iterate): Use start position as
	iterator node value (Next, Previous): Forward to corresponding
	cursor-based operation.
	* a-cohase.ads, a-cohase.adb: Implemented forward iterator.
	* a-cihase.adb, a-cbhase.adb (Iterator): Removed unnecessary
	node component (First, Next): Forward call to corresponding
	cursor-based operation (Iterate): Representation of iterator no
	longer has node component

2011-11-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_intr.adb (Expand_Unc_Deallocation): Ensure that the
	dereference has a proper type before the side effect removal
	mechanism kicks in.
	* sem_ch3.adb (Analyze_Subtype_Declaration): Handle a rare case
	where the base type of the subtype is a private itype created
	to act as the partial view of a constrained record type. This
	scenario manifests with equivalent class-wide types for records
	with unknown discriminants.

2011-11-23  Jerome Guitton  <guitton@adacore.com>

	* s-osprim-vxworks.adb (Clock): Use Clock_RT_Ada.

2011-11-23  Thomas Quinot  <quinot@adacore.com>

	* s-oscons-tmplt.c: Fix unbalanced preprocessor directives Minor
	reformatting/reorganization.

From-SVN: r181666
This commit is contained in:
Arnaud Charlet 2011-11-23 14:32:44 +01:00
parent 24fee494c5
commit b38c20a636
15 changed files with 563 additions and 198 deletions

View File

@ -1,3 +1,38 @@
2011-11-23 Matthew Heaney <heaney@adacore.com>
* a-coorse.ads, a-ciorse.ads, a-cborse.ads (Set_Iterator_Interfaces):
Renamed from Ordered_Set_Iterator_Interfaces.
* a-coorse.adb, a-ciorse.adb, a-cborse.adb (Iterator): Declared
Iterator type as limited (First, Last): Cursor return value
depends on iterator node value (Iterate): Use start position as
iterator node value (Next, Previous): Forward to corresponding
cursor-based operation.
* a-cohase.ads, a-cohase.adb: Implemented forward iterator.
* a-cihase.adb, a-cbhase.adb (Iterator): Removed unnecessary
node component (First, Next): Forward call to corresponding
cursor-based operation (Iterate): Representation of iterator no
longer has node component
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* exp_intr.adb (Expand_Unc_Deallocation): Ensure that the
dereference has a proper type before the side effect removal
mechanism kicks in.
* sem_ch3.adb (Analyze_Subtype_Declaration): Handle a rare case
where the base type of the subtype is a private itype created
to act as the partial view of a constrained record type. This
scenario manifests with equivalent class-wide types for records
with unknown discriminants.
2011-11-23 Jerome Guitton <guitton@adacore.com>
* s-osprim-vxworks.adb (Clock): Use Clock_RT_Ada.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* s-oscons-tmplt.c: Fix unbalanced preprocessor directives Minor
reformatting/reorganization.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* g-htable.ads: Remove old comments.

View File

@ -41,7 +41,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
type Iterator is new Set_Iterator_Interfaces.Forward_Iterator with record
Container : Set_Access;
Position : Cursor;
end record;
overriding function First (Object : Iterator) return Cursor;
@ -596,10 +595,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
end First;
overriding function First (Object : Iterator) return Cursor is
Node : constant Count_Type := HT_Ops.First (Object.Container.all);
begin
return (if Node = 0 then No_Element
else Cursor'(Object.Container, Node));
return Object.Container.First;
end First;
-----------------
@ -911,7 +908,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
function Iterate (Container : Set)
return Set_Iterator_Interfaces.Forward_Iterator'Class is
begin
return Iterator'(Container'Unrestricted_Access, First (Container));
return Iterator'(Container => Container'Unrestricted_Access);
end Iterate;
------------
@ -982,12 +979,16 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Position : Cursor) return Cursor
is
begin
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor designates wrong set";
if Position.Container = null then
return No_Element;
end if;
return (if Position.Node = 0 then No_Element else Next (Position));
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
-------------
@ -1599,7 +1600,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
begin
if Node = 0 then
raise Constraint_Error with "key not in map";
raise Constraint_Error with "key not in map"; -- ??? "set"
end if;
return Container.Nodes (Node).Element;

View File

@ -42,9 +42,9 @@ with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Sets is
type Iterator is new
Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
Container : access constant Set;
type Iterator is limited new
Set_Iterator_Interfaces.Reversible_Iterator with record
Container : Set_Access;
Node : Count_Type;
end record;
@ -591,9 +591,24 @@ package body Ada.Containers.Bounded_Ordered_Sets is
function First (Object : Iterator) return Cursor is
begin
return (if Object.Container.First = 0 then No_Element
else Cursor'(Object.Container.all'Unrestricted_Access,
Object.Container.First));
-- The value of the iterator object's Node component influences the
-- behavior of the First (and Last) selector function.
-- When the Node component is 0, this means the iterator object was
-- constructed without a start expression, in which case the (forward)
-- iteration starts from the (logical) beginning of the entire sequence
-- of items (corresponding to Container.First, for a forward iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is positive, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (forward) partial iteration begins.
if Object.Node = 0 then
return Bounded_Ordered_Sets.First (Object.Container.all);
else
return Cursor'(Object.Container, Object.Node);
end if;
end First;
-------------------
@ -1206,22 +1221,60 @@ package body Ada.Containers.Bounded_Ordered_Sets is
end Iterate;
function Iterate (Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
begin
if Container.Length = 0 then
return Iterator'(null, 0);
else
return Iterator'(Container'Unchecked_Access, Container.First);
end if;
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is 0 (as is the case here), this means the iterator object
-- was constructed without a start expression. This is a complete
-- iterator, meaning that the iteration starts from the (logical)
-- beginning of the sequence of items.
-- Note: For a forward iterator, Container.First is the beginning, and
-- for a reverse iterator, Container.Last is the beginning.
return Iterator'(Container'Unrestricted_Access, Node => 0);
end Iterate;
function Iterate (Container : Set; Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
It : constant Iterator := (Container'Unchecked_Access, Start.Node);
begin
return It;
-- It was formerly the case that when Start = No_Element, the partial
-- iterator was defined to behave the same as for a complete iterator,
-- and iterate over the entire sequence of items. However, those
-- semantics were unintuitive and arguably error-prone (it is too easy
-- to accidentally create an endless loop), and so they were changed,
-- per the ARG meeting in Denver on 2011/11. However, there was no
-- consensus about what positive meaning this corner case should have,
-- and so it was decided to simply raise an exception. This does imply,
-- however, that it is not possible to use a partial iterator to specify
-- an empty sequence of items.
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
end if;
if Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong set";
end if;
pragma Assert (Vet (Container, Start.Node),
"Start cursor of Iterate is bad");
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is positive (as is the case here), it means that this
-- is a partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. (Note that
-- the start position has the same value irrespective of whether this
-- is a forward or reverse iteration.)
return Iterator'(Container'Unrestricted_Access, Node => Start.Node);
end Iterate;
----------
@ -1236,9 +1289,24 @@ package body Ada.Containers.Bounded_Ordered_Sets is
function Last (Object : Iterator) return Cursor is
begin
return (if Object.Container.Last = 0 then No_Element
else Cursor'(Object.Container.all'Unrestricted_Access,
Object.Container.Last));
-- The value of the iterator object's Node component influences the
-- behavior of the Last (and First) selector function.
-- When the Node component is 0, this means the iterator object was
-- constructed without a start expression, in which case the (reverse)
-- iteration starts from the (logical) beginning of the entire sequence
-- (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is positive, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (reverse) partial iteration begins.
if Object.Node = 0 then
return Bounded_Ordered_Sets.Last (Object.Container.all);
else
return Cursor'(Object.Container, Object.Node);
end if;
end Last;
------------------
@ -1323,8 +1391,16 @@ package body Ada.Containers.Bounded_Ordered_Sets is
end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
@ -1374,8 +1450,16 @@ package body Ada.Containers.Bounded_Ordered_Sets is
end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong set";
end if;
return Previous (Position);
end Previous;

View File

@ -31,9 +31,9 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Iterator_Interfaces;
private with Ada.Containers.Red_Black_Trees;
with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
@ -62,7 +62,7 @@ package Ada.Containers.Bounded_Ordered_Sets is
No_Element : constant Cursor;
function Has_Element (Position : Cursor) return Boolean;
package Ordered_Set_Iterator_Interfaces is new
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
type Constant_Reference_Type
@ -212,12 +212,12 @@ package Ada.Containers.Bounded_Ordered_Sets is
function Iterate
(Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
return Set_Iterator_Interfaces.Reversible_Iterator'class;
function Iterate
(Container : Set;
Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
return Set_Iterator_Interfaces.Reversible_Iterator'class;
generic
type Key_Type (<>) is private;

View File

@ -41,10 +41,10 @@ with System; use type System.Address;
package body Ada.Containers.Indefinite_Hashed_Sets is
type Iterator is new Set_Iterator_Interfaces.Forward_Iterator with record
Container : Set_Access;
Position : Cursor;
end record;
type Iterator is limited new
Set_Iterator_Interfaces.Forward_Iterator with record
Container : Set_Access;
end record;
overriding function First (Object : Iterator) return Cursor;
@ -649,10 +649,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
end First;
function First (Object : Iterator) return Cursor is
Node : constant Node_Access := HT_Ops.First (Object.Container.HT);
begin
return (if Node = null then No_Element
else Cursor'(Object.Container, Node));
return Object.Container.First;
end First;
----------
@ -1011,7 +1009,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
function Iterate (Container : Set)
return Set_Iterator_Interfaces.Forward_Iterator'Class is
begin
return Iterator'(Container'Unrestricted_Access, First (Container));
return Iterator'(Container => Container'Unrestricted_Access);
end Iterate;
------------
@ -1072,12 +1070,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Position : Cursor) return Cursor
is
begin
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor designates wrong set";
if Position.Container = null then
return No_Element;
end if;
return (if Position.Node = null then No_Element else Next (Position));
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
-------------
@ -1895,7 +1897,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
if X = null then
raise Constraint_Error with "key not in map";
raise Constraint_Error with "key not in map"; -- ??? "set"
end if;
Free (X);
@ -1913,7 +1915,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin
if Node = null then
raise Constraint_Error with "key not in map";
raise Constraint_Error with "key not in map"; -- ??? "set"
end if;
return Node.Element.all;

View File

@ -42,9 +42,9 @@ with System; use type System.Address;
package body Ada.Containers.Indefinite_Ordered_Sets is
type Iterator is new
Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
Container : access constant Set;
type Iterator is limited new
Set_Iterator_Interfaces.Reversible_Iterator with record
Container : Set_Access;
Node : Node_Access;
end record;
@ -600,8 +600,24 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
function First (Object : Iterator) return Cursor is
begin
return Cursor'(
Object.Container.all'Unrestricted_Access, Object.Container.Tree.First);
-- The value of the iterator object's Node component influences the
-- behavior of the First (and Last) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (forward)
-- iteration starts from the (logical) beginning of the entire sequence
-- of items (corresponding to Container.First, for a forward iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (forward) partial iteration begins.
if Object.Node = null then
return Object.Container.First;
else
return Cursor'(Object.Container, Object.Node);
end if;
end First;
-------------------
@ -1259,22 +1275,62 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
function Iterate
(Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
It : constant Iterator :=
(Container'Unchecked_Access, Container.Tree.First);
begin
return It;
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is null (as is the case here), this means the iterator
-- object was constructed without a start expression. This is a complete
-- iterator, meaning that the iteration starts from the (logical)
-- beginning of the sequence of items.
-- Note: For a forward iterator, Container.First is the beginning, and
-- for a reverse iterator, Container.Last is the beginning.
return Iterator'(Container'Unrestricted_Access, Node => null);
end Iterate;
function Iterate
(Container : Set;
Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
It : constant Iterator := (Container'Unchecked_Access, Start.Node);
begin
return It;
-- It was formerly the case that when Start = No_Element, the partial
-- iterator was defined to behave the same as for a complete iterator,
-- and iterate over the entire sequence of items. However, those
-- semantics were unintuitive and arguably error-prone (it is too easy
-- to accidentally create an endless loop), and so they were changed,
-- per the ARG meeting in Denver on 2011/11. However, there was no
-- consensus about what positive meaning this corner case should have,
-- and so it was decided to simply raise an exception. This does imply,
-- however, that it is not possible to use a partial iterator to specify
-- an empty sequence of items.
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
end if;
if Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong set";
end if;
pragma Assert (Vet (Container.Tree, Start.Node),
"Start cursor of Iterate is bad");
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is non-null (as is the case here), it means that this is a
-- partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that
-- the start position has the same value irrespective of whether this is
-- a forward or reverse iteration.
return Iterator'(Container'Unrestricted_Access, Node => Start.Node);
end Iterate;
----------
@ -1290,9 +1346,24 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
function Last (Object : Iterator) return Cursor is
begin
return (if Object.Container.Tree.Last = null then No_Element
else Cursor'(Object.Container.all'Unrestricted_Access,
Object.Container.Tree.Last));
-- The value of the iterator object's Node component influences the
-- behavior of the Last (and First) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (reverse)
-- iteration starts from the (logical) beginning of the entire sequence
-- (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (reverse) partial iteration begins.
if Object.Node = null then
return Object.Container.Last;
else
return Cursor'(Object.Container, Object.Node);
end if;
end Last;
------------------
@ -1372,8 +1443,16 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
(Object : Iterator;
Position : Cursor) return Cursor
is
pragma Unreferenced (Object);
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
@ -1430,8 +1509,16 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
(Object : Iterator;
Position : Cursor) return Cursor
is
pragma Unreferenced (Object);
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong set";
end if;
return Previous (Position);
end Previous;

View File

@ -64,7 +64,7 @@ package Ada.Containers.Indefinite_Ordered_Sets is
function Has_Element (Position : Cursor) return Boolean;
package Ordered_Set_Iterator_Interfaces is new
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
type Constant_Reference_Type
@ -233,12 +233,12 @@ package Ada.Containers.Indefinite_Ordered_Sets is
function Iterate
(Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
return Set_Iterator_Interfaces.Reversible_Iterator'class;
function Iterate
(Container : Set;
Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
return Set_Iterator_Interfaces.Reversible_Iterator'class;
generic
type Key_Type (<>) is private;

View File

@ -41,6 +41,17 @@ with System; use type System.Address;
package body Ada.Containers.Hashed_Sets is
type Iterator is limited new
Set_Iterator_Interfaces.Forward_Iterator with record
Container : Set_Access;
end record;
overriding function First (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
Position : Cursor) return Cursor;
-----------------------
-- Local Subprograms --
-----------------------
@ -601,6 +612,11 @@ package body Ada.Containers.Hashed_Sets is
return Cursor'(Container'Unrestricted_Access, Node);
end First;
function First (Object : Iterator) return Cursor is
begin
return Object.Container.First;
end First;
----------
-- Free --
----------
@ -920,6 +936,13 @@ package body Ada.Containers.Hashed_Sets is
B := B - 1;
end Iterate;
function Iterate
(Container : Set) return Set_Iterator_Interfaces.Forward_Iterator'Class
is
begin
return Iterator'(Container => Container'Unrestricted_Access);
end Iterate;
------------
-- Length --
------------
@ -973,6 +996,23 @@ package body Ada.Containers.Hashed_Sets is
Position := Next (Position);
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
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
-------------
-- Overlap --
-------------
@ -1695,7 +1735,7 @@ package body Ada.Containers.Hashed_Sets is
begin
if Node = null then
raise Constraint_Error with "key not in map";
raise Constraint_Error with "key not in map"; -- ??? "set"
end if;
return Node.Element;

View File

@ -34,6 +34,7 @@
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
private with Ada.Finalization;
with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
@ -49,7 +50,11 @@ package Ada.Containers.Hashed_Sets is
pragma Preelaborate;
pragma Remote_Types;
type Set is tagged private;
type Set is tagged private
with
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Set);
type Cursor is private;
@ -63,6 +68,12 @@ package Ada.Containers.Hashed_Sets is
-- Cursor objects declared without an initialization expression are
-- initialized to the value No_Element.
function Has_Element (Position : Cursor) return Boolean;
-- Equivalent to Position /= No_Element
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
function "=" (Left, Right : Set) return Boolean;
-- For each element in Left, set equality attempts to find the equal
-- element in Right; if a search fails, then set equality immediately
@ -303,9 +314,6 @@ package Ada.Containers.Hashed_Sets is
function Contains (Container : Set; Item : Element_Type) return Boolean;
-- Equivalent to Find (Container, Item) /= No_Element
function Has_Element (Position : Cursor) return Boolean;
-- Equivalent to Position /= No_Element
function Equivalent_Elements (Left, Right : Cursor) return Boolean;
-- Returns the result of calling Equivalent_Elements with the elements of
-- the nodes designated by cursors Left and Right.
@ -327,6 +335,9 @@ package Ada.Containers.Hashed_Sets is
Process : not null access procedure (Position : Cursor));
-- Calls Process for each node in the set
function Iterate
(Container : Set) return Set_Iterator_Interfaces.Forward_Iterator'Class;
generic
type Key_Type (<>) is private;

View File

@ -42,9 +42,9 @@ with System; use type System.Address;
package body Ada.Containers.Ordered_Sets is
type Iterator is new
Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
Container : access constant Set;
type Iterator is limited new
Set_Iterator_Interfaces.Reversible_Iterator with record
Container : Set_Access;
Node : Node_Access;
end record;
@ -537,9 +537,24 @@ package body Ada.Containers.Ordered_Sets is
function First (Object : Iterator) return Cursor is
begin
return (if Object.Container = null then No_Element
else Cursor'(Object.Container.all'Unrestricted_Access,
Object.Container.Tree.First));
-- The value of the iterator object's Node component influences the
-- behavior of the First (and Last) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (forward)
-- iteration starts from the (logical) beginning of the entire sequence
-- of items (corresponding to Container.First, for a forward iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (forward) partial iteration begins.
if Object.Node = null then
return Object.Container.First;
else
return Cursor'(Object.Container, Object.Node);
end if;
end First;
-------------------
@ -1165,22 +1180,60 @@ package body Ada.Containers.Ordered_Sets is
end Iterate;
function Iterate (Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
begin
if Container.Length = 0 then
return Iterator'(null, null);
else
return Iterator'(Container'Unchecked_Access, Container.Tree.First);
end if;
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is null (as is the case here), this means the iterator
-- object was constructed without a start expression. This is a complete
-- iterator, meaning that the iteration starts from the (logical)
-- beginning of the sequence of items.
-- Note: For a forward iterator, Container.First is the beginning, and
-- for a reverse iterator, Container.Last is the beginning.
return Iterator'(Container'Unrestricted_Access, Node => null);
end Iterate;
function Iterate (Container : Set; Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
It : constant Iterator := (Container'Unchecked_Access, Start.Node);
begin
return It;
-- It was formerly the case that when Start = No_Element, the partial
-- iterator was defined to behave the same as for a complete iterator,
-- and iterate over the entire sequence of items. However, those
-- semantics were unintuitive and arguably error-prone (it is too easy
-- to accidentally create an endless loop), and so they were changed,
-- per the ARG meeting in Denver on 2011/11. However, there was no
-- consensus about what positive meaning this corner case should have,
-- and so it was decided to simply raise an exception. This does imply,
-- however, that it is not possible to use a partial iterator to specify
-- an empty sequence of items.
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
end if;
if Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong set";
end if;
pragma Assert (Vet (Container.Tree, Start.Node),
"Start cursor of Iterate is bad");
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is non-null (as is the case here), it means that this is a
-- partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that
-- the start position has the same value irrespective of whether this is
-- a forward or reverse iteration.
return Iterator'(Container'Unrestricted_Access, Node => Start.Node);
end Iterate;
----------
@ -1196,9 +1249,24 @@ package body Ada.Containers.Ordered_Sets is
function Last (Object : Iterator) return Cursor is
begin
return (if Object.Container = null then No_Element
else Cursor'(Object.Container.all'Unrestricted_Access,
Object.Container.Tree.Last));
-- The value of the iterator object's Node component influences the
-- behavior of the Last (and First) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (reverse)
-- iteration starts from the (logical) beginning of the entire sequence
-- (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (reverse) partial iteration begins.
if Object.Node = null then
return Object.Container.Last;
else
return Cursor'(Object.Container, Object.Node);
end if;
end Last;
------------------
@ -1271,8 +1339,16 @@ package body Ada.Containers.Ordered_Sets is
end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
@ -1322,8 +1398,16 @@ package body Ada.Containers.Ordered_Sets is
end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong set";
end if;
return Previous (Position);
end Previous;

View File

@ -65,7 +65,7 @@ package Ada.Containers.Ordered_Sets is
No_Element : constant Cursor;
package Ordered_Set_Iterator_Interfaces is new
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
type Constant_Reference_Type
@ -227,12 +227,12 @@ package Ada.Containers.Ordered_Sets is
function Iterate
(Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
return Set_Iterator_Interfaces.Reversible_Iterator'class;
function Iterate
(Container : Set;
Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
return Set_Iterator_Interfaces.Reversible_Iterator'class;
generic
type Key_Type (<>) is private;

View File

@ -1123,6 +1123,10 @@ package body Exp_Intr is
D_Type : Entity_Id;
begin
-- Perform minor decoration as it is needed by the side effect
-- removal mechanism.
Set_Etype (Deref, Desig_T);
Set_Parent (Deref, Free_Node);
D_Subtyp := Make_Subtype_From_Expr (Deref, Desig_T);

View File

@ -146,7 +146,7 @@ pragma Style_Checks ("M32766");
# define NATIVE
#endif
#endif /* DUMMY */
#ifndef TARGET
# error Please define TARGET
@ -213,7 +213,7 @@ int counter = 0;
: : "i" (__LINE__));
/* Freeform text */
#endif
#endif /* NATIVE */
#define CST(name,comment) C(#name,String,name,comment)
@ -1208,55 +1208,6 @@ CND(IP_DROP_MEMBERSHIP, "Leave a multicast group")
#endif
CND(IP_PKTINFO, "Get datagram info")
#endif /* HAVE_SOCKETS */
/*
------------
-- Clocks --
------------
*/
#ifdef CLOCK_REALTIME
CND(CLOCK_REALTIME, "System realtime clock")
#endif
#ifdef CLOCK_MONOTONIC
CND(CLOCK_MONOTONIC, "System monotonic clock")
#endif
#ifdef CLOCK_FASTEST
CND(CLOCK_FASTEST, "Fastest clock")
#endif
#if defined (__sgi)
CND(CLOCK_SGI_FAST, "SGI fast clock")
CND(CLOCK_SGI_CYCLE, "SGI CPU clock")
#endif
#if defined(__APPLE__)
/* There's no clock_gettime or clock_id's on Darwin */
# define CLOCK_RT_Ada "-1"
#elif defined(FreeBSD) || defined(_AIX)
/* On these platforms use system provided monotonic clock */
# define CLOCK_RT_Ada "CLOCK_MONOTONIC"
#elif defined(CLOCK_REALTIME)
/* By default use CLOCK_REALTIME */
# define CLOCK_RT_Ada "CLOCK_REALTIME"
#endif
#ifdef CLOCK_RT_Ada
CNS(CLOCK_RT_Ada, "Ada realtime clock")
#endif
#ifndef CLOCK_THREAD_CPUTIME_ID
# define CLOCK_THREAD_CPUTIME_ID -1
#endif
CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
/*
----------------------
@ -1367,58 +1318,67 @@ CST(Inet_Pton_Linkname, "")
#endif /* HAVE_SOCKETS */
/**
** System-specific constants follow
** Each section should be activated if compiling for the corresponding
** platform *or* generating the dummy version for runtime test compilation.
**/
#if defined (__vxworks) || defined (DUMMY)
/*
--------------------------------
-- VxWorks-specific constants --
--------------------------------
---------------------
-- Threads support --
---------------------
-- Clock identifier definitions
-- These constants may be used only within the VxWorks version of
-- GNAT.Sockets.Thin.
*/
CND(OK, "VxWorks generic success")
CND(ERROR, "VxWorks generic error")
#ifdef CLOCK_REALTIME
CND(CLOCK_REALTIME, "System realtime clock")
#endif
#if defined (__MINGW32__) || defined (DUMMY)
/*
------------------------------
-- MinGW-specific constants --
------------------------------
-- These constants may be used only within the MinGW version of
-- GNAT.Sockets.Thin.
*/
CND(WSASYSNOTREADY, "System not ready")
CND(WSAVERNOTSUPPORTED, "Version not supported")
CND(WSANOTINITIALISED, "Winsock not initialized")
CND(WSAEDISCON, "Disconnected")
#ifdef CLOCK_MONOTONIC
CND(CLOCK_MONOTONIC, "System monotonic clock")
#endif
#ifdef NATIVE
putchar ('\n');
#ifdef CLOCK_FASTEST
CND(CLOCK_FASTEST, "Fastest clock")
#endif
#if defined (__sgi)
CND(CLOCK_SGI_FAST, "SGI fast clock")
CND(CLOCK_SGI_CYCLE, "SGI CPU clock")
#endif
#if defined(__APPLE__)
/* There's no clock_gettime or clock_id's on Darwin */
# define CLOCK_RT_Ada "-1"
#elif defined(FreeBSD) || defined(_AIX)
/* On these platforms use system provided monotonic clock */
# define CLOCK_RT_Ada "CLOCK_MONOTONIC"
#elif defined(CLOCK_REALTIME)
/* By default use CLOCK_REALTIME */
# define CLOCK_RT_Ada "CLOCK_REALTIME"
#endif
#ifdef CLOCK_RT_Ada
CNS(CLOCK_RT_Ada, "")
#endif
#ifndef CLOCK_THREAD_CPUTIME_ID
# define CLOCK_THREAD_CPUTIME_ID -1
#endif
CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
#if defined (__APPLE__) || defined (__linux__) || defined (DUMMY)
/*
-- Sizes of pthread data types (on Darwin these are padding)
-- Sizes of pthread data types
*/
#if defined (__APPLE__) || defined (DUMMY)
/*
-- (on Darwin, these are just placeholders)
*/
#define PTHREAD_SIZE __PTHREAD_SIZE__
#define PTHREAD_ATTR_SIZE __PTHREAD_ATTR_SIZE__
#define PTHREAD_MUTEXATTR_SIZE __PTHREAD_MUTEXATTR_SIZE__
@ -1440,24 +1400,65 @@ CND(WSAEDISCON, "Disconnected")
#define PTHREAD_ONCE_SIZE (sizeof (pthread_once_t))
#endif
CND(PTHREAD_SIZE, "pthread_t")
CND(PTHREAD_ATTR_SIZE, "pthread_attr_t")
CND(PTHREAD_MUTEXATTR_SIZE, "pthread_mutexattr_t")
CND(PTHREAD_MUTEX_SIZE, "pthread_mutex_t")
CND(PTHREAD_CONDATTR_SIZE, "pthread_condattr_t")
CND(PTHREAD_COND_SIZE, "pthread_cond_t")
CND(PTHREAD_SIZE, "pthread_t")
CND(PTHREAD_ATTR_SIZE, "pthread_attr_t")
CND(PTHREAD_MUTEXATTR_SIZE, "pthread_mutexattr_t")
CND(PTHREAD_MUTEX_SIZE, "pthread_mutex_t")
CND(PTHREAD_CONDATTR_SIZE, "pthread_condattr_t")
CND(PTHREAD_COND_SIZE, "pthread_cond_t")
CND(PTHREAD_RWLOCKATTR_SIZE, "pthread_rwlockattr_t")
CND(PTHREAD_RWLOCK_SIZE, "pthread_rwlock_t")
CND(PTHREAD_ONCE_SIZE, "pthread_once_t")
CND(PTHREAD_RWLOCK_SIZE, "pthread_rwlock_t")
#endif /* __APPLE__ || __linux__ */
CND(PTHREAD_ONCE_SIZE, "pthread_once_t")
/**
** System-specific constants follow
** Each section should be activated if compiling for the corresponding
** platform *or* generating the dummy version for runtime test compilation.
**/
#if defined (__vxworks) || defined (DUMMY)
/*
--------------------------------
-- VxWorks-specific constants --
--------------------------------
-- These constants may be used only within the VxWorks version of
-- GNAT.Sockets.Thin.
*/
CND(OK, "VxWorks generic success")
CND(ERROR, "VxWorks generic error")
#endif /* __vxworks */
#if defined (__MINGW32__) || defined (DUMMY)
/*
------------------------------
-- MinGW-specific constants --
------------------------------
-- These constants may be used only within the MinGW version of
-- GNAT.Sockets.Thin.
*/
CND(WSASYSNOTREADY, "System not ready")
CND(WSAVERNOTSUPPORTED, "Version not supported")
CND(WSANOTINITIALISED, "Winsock not initialized")
CND(WSAEDISCON, "Disconnected")
#endif /* __MINGW32__ */
/**
** End of constants definitions
**/
#ifdef NATIVE
putchar ('\n');
#endif
/*

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -37,6 +37,7 @@ with System.OS_Interface;
-- set of C imported routines: using Ada routines from this package would
-- create a dependency on libgnarl in libgnat, which is not desirable.
with System.OS_Constants;
with Interfaces.C;
package body System.OS_Primitives is
@ -44,6 +45,8 @@ package body System.OS_Primitives is
use System.OS_Interface;
use type Interfaces.C.int;
package OSC renames System.OS_Constants;
------------------------
-- Internal functions --
------------------------
@ -94,7 +97,7 @@ package body System.OS_Primitives is
TS : aliased timespec;
Result : int;
begin
Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
end Clock;

View File

@ -4064,6 +4064,19 @@ package body Sem_Ch3 is
T := Process_Subtype (Subtype_Indication (N), N, Id, 'P');
-- Class-wide equivalent types of records with unknown discriminants
-- involve the generation of an itype which serves as the private view
-- of a constrained record subtype. In such cases the base type of the
-- current subtype we are processing is the private itype. Use the full
-- of the private itype when decorating various attributes.
if Is_Itype (T)
and then Is_Private_Type (T)
and then Present (Full_View (T))
then
T := Full_View (T);
end if;
-- Inherit common attributes
Set_Is_Generic_Type (Id, Is_Generic_Type (Base_Type (T)));