+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.
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;
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;
-----------------
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;
------------
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 designates wrong set";
+ "Position cursor of Next designates wrong set";
end if;
- return (if Position.Node = 0 then No_Element else Next (Position));
+ return Next (Position);
end Next;
-------------
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;
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;
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;
-------------------
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;
----------
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;
------------------
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;
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;
-- 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;
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
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;
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;
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;
----------
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;
------------
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 designates wrong set";
+ "Position cursor of Next designates wrong set";
end if;
- return (if Position.Node = null then No_Element else Next (Position));
+ return Next (Position);
end Next;
-------------
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);
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;
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;
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;
-------------------
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;
----------
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;
------------------
(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;
(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;
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
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;
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 --
-----------------------
return Cursor'(Container'Unrestricted_Access, Node);
end First;
+ function First (Object : Iterator) return Cursor is
+ begin
+ return Object.Container.First;
+ end First;
+
----------
-- Free --
----------
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 --
------------
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 --
-------------
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;
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
private with Ada.Finalization;
+with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
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;
-- 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
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.
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;
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;
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;
-------------------
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;
----------
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;
------------------
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;
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;
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
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;
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);
# define NATIVE
-#endif
+#endif /* DUMMY */
#ifndef TARGET
# error Please define TARGET
: : "i" (__LINE__));
/* Freeform text */
-#endif
+#endif /* NATIVE */
#define CST(name,comment) C(#name,String,name,comment)
#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")
-
/*
----------------------
#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
+#ifdef CLOCK_MONOTONIC
+CND(CLOCK_MONOTONIC, "System monotonic clock")
#endif
-#if defined (__MINGW32__) || defined (DUMMY)
-/*
+#ifdef CLOCK_FASTEST
+CND(CLOCK_FASTEST, "Fastest clock")
+#endif
- ------------------------------
- -- MinGW-specific constants --
- ------------------------------
+#if defined (__sgi)
+CND(CLOCK_SGI_FAST, "SGI fast clock")
+CND(CLOCK_SGI_CYCLE, "SGI CPU clock")
+#endif
- -- These constants may be used only within the MinGW version of
- -- GNAT.Sockets.Thin.
-*/
+#if defined(__APPLE__)
+/* There's no clock_gettime or clock_id's on Darwin */
+# define CLOCK_RT_Ada "-1"
-CND(WSASYSNOTREADY, "System not ready")
-CND(WSAVERNOTSUPPORTED, "Version not supported")
-CND(WSANOTINITIALISED, "Winsock not initialized")
-CND(WSAEDISCON, "Disconnected")
+#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 NATIVE
- putchar ('\n');
+#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__
#define PTHREAD_ONCE_SIZE (sizeof (pthread_once_t))
#endif
-CND(PTHREAD_SIZE, "pthread_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")
+
+#endif /* __APPLE__ || __linux__ */
-CND(PTHREAD_ATTR_SIZE, "pthread_attr_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.
+ **/
-CND(PTHREAD_MUTEXATTR_SIZE, "pthread_mutexattr_t")
+#if defined (__vxworks) || defined (DUMMY)
-CND(PTHREAD_MUTEX_SIZE, "pthread_mutex_t")
+/*
-CND(PTHREAD_CONDATTR_SIZE, "pthread_condattr_t")
+ --------------------------------
+ -- VxWorks-specific constants --
+ --------------------------------
-CND(PTHREAD_COND_SIZE, "pthread_cond_t")
+ -- These constants may be used only within the VxWorks version of
+ -- GNAT.Sockets.Thin.
+*/
-CND(PTHREAD_RWLOCKATTR_SIZE, "pthread_rwlockattr_t")
+CND(OK, "VxWorks generic success")
+CND(ERROR, "VxWorks generic error")
-CND(PTHREAD_RWLOCK_SIZE, "pthread_rwlock_t")
+#endif /* __vxworks */
-CND(PTHREAD_ONCE_SIZE, "pthread_once_t")
+#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
/*
-- --
-- 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- --
-- 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
use System.OS_Interface;
use type Interfaces.C.int;
+ package OSC renames System.OS_Constants;
+
------------------------
-- Internal functions --
------------------------
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;
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)));
OSDN Git Service
