Commit 88115c2a by Arnaud Charlet

[multiple changes]

2011-12-21  Robert Dewar  <dewar@adacore.com>

	* exp_ch5.adb, sem_dim.adb, sem_dim.ads, sem_ch12.adb, prj-conf.adb:
	Minor reformatting.

2011-12-21  Claire Dross  <dross@adacore.com>

	* a-cfdlli.ads (Constant_Indexing, Default_Iterator,
	Iterator_Element): Added to type List.               
	(Not_No_Element, List_Iterator_Interfaces, Iterate,
	Constant_Reference_Type, Constant_Reference): New.
	* a-cfdlli.adb (type Iterator, Finalize, First, Last, Next,
	Previous, Iterate, Not_No_Element, Constant_Reference): New.

From-SVN: r182576
parent 6c57023b
2011-12-21 Robert Dewar <dewar@adacore.com>
* exp_ch5.adb, sem_dim.adb, sem_dim.ads, sem_ch12.adb, prj-conf.adb:
Minor reformatting.
2011-12-21 Claire Dross <dross@adacore.com>
* a-cfdlli.ads (Constant_Indexing, Default_Iterator,
Iterator_Element): Added to type List.
(Not_No_Element, List_Iterator_Interfaces, Iterate,
Constant_Reference_Type, Constant_Reference): New.
* a-cfdlli.adb (type Iterator, Finalize, First, Last, Next,
Previous, Iterate, Not_No_Element, Constant_Reference): New.
2011-12-21 Gary Dismukes <dismukes@adacore.com> 2011-12-21 Gary Dismukes <dismukes@adacore.com>
* gnat_ugn.texi: Minor reformatting. * gnat_ugn.texi: Minor reformatting.
......
...@@ -26,9 +26,30 @@ ...@@ -26,9 +26,30 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with System; use type System.Address; with System; use type System.Address;
with Ada.Finalization;
package body Ada.Containers.Formal_Doubly_Linked_Lists is package body Ada.Containers.Formal_Doubly_Linked_Lists is
type Iterator is new Ada.Finalization.Limited_Controlled and
List_Iterator_Interfaces.Reversible_Iterator with
record
Container : List_Access;
Node : Count_Type;
end record;
overriding procedure Finalize (Object : in out Iterator);
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
Position : Cursor) return Cursor;
overriding function Previous
(Object : Iterator;
Position : Cursor) return Cursor;
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
...@@ -423,6 +444,21 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -423,6 +444,21 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return Container.Nodes (Position.Node).Element; return Container.Nodes (Position.Node).Element;
end Element; end Element;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out Iterator) is
begin
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
begin
B := B - 1;
end;
end if;
end Finalize;
---------- ----------
-- Find -- -- Find --
---------- ----------
...@@ -474,6 +510,28 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -474,6 +510,28 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return (Node => Container.First); return (Node => Container.First);
end First; end First;
function First (Object : Iterator) return Cursor is
begin
-- 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 = 0 then
return First (Object.Container.all);
else
return (Node => Object.Node);
end if;
end First;
------------------- -------------------
-- First_Element -- -- First_Element --
------------------- -------------------
...@@ -915,6 +973,71 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -915,6 +973,71 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
B := B - 1; B := B - 1;
end Iterate; end Iterate;
function Iterate (Container : List)
return List_Iterator_Interfaces.Reversible_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.Busy;
begin
-- 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 It : constant Iterator :=
Iterator'(Ada.Finalization.Limited_Controlled with
Container => Container'Unrestricted_Access,
Node => 0)
do
B := B + 1;
end return;
end Iterate;
function Iterate (Container : List; Start : Cursor)
return List_Iterator_Interfaces.Reversible_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.Busy;
begin
-- 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 not Has_Element (Container, Start) then
raise Constraint_Error with
"Start position for iterator is not a valid cursor";
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 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 It : constant Iterator :=
Iterator'(Ada.Finalization.Limited_Controlled with
Container => Container'Unrestricted_Access,
Node => Start.Node)
do
B := B + 1;
end return;
end Iterate;
---------- ----------
-- Last -- -- Last --
---------- ----------
...@@ -927,6 +1050,28 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -927,6 +1050,28 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return (Node => Container.Last); return (Node => Container.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is
begin
-- 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 = 0 then
return Last (Object.Container.all);
else
return (Node => Object.Node);
end if;
end Last;
------------------ ------------------
-- Last_Element -- -- Last_Element --
------------------ ------------------
...@@ -1085,6 +1230,24 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1085,6 +1230,24 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return (Node => Container.Nodes (Position.Node).Next); return (Node => Container.Nodes (Position.Node).Next);
end Next; end Next;
function Next
(Object : Iterator;
Position : Cursor) return Cursor
is
begin
return Next (Object.Container.all, Position);
end Next;
--------------------
-- Not_No_Element --
--------------------
function Not_No_Element (Position : Cursor) return Boolean is
begin
return Position /= No_Element;
end Not_No_Element;
------------- -------------
-- Prepend -- -- Prepend --
------------- -------------
...@@ -1120,6 +1283,15 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1120,6 +1283,15 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return (Node => Container.Nodes (Position.Node).Prev); return (Node => Container.Nodes (Position.Node).Prev);
end Previous; end Previous;
function Previous
(Object : Iterator;
Position : Cursor) return Cursor
is
begin
return Previous (Object.Container.all, Position);
end Previous;
------------------- -------------------
-- Query_Element -- -- Query_Element --
------------------- -------------------
...@@ -1196,6 +1368,21 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1196,6 +1368,21 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Program_Error with "attempt to stream list cursor"; raise Program_Error with "attempt to stream list cursor";
end Read; end Read;
---------------
-- Reference --
---------------
function Constant_Reference (Container : List; Position : Cursor)
return Constant_Reference_Type is
begin
if not Has_Element (Container, Position) then
raise Constraint_Error with "Position cursor has no element";
end if;
return (Element => Container.Nodes (Position.Node).Element'Access);
end Constant_Reference;
--------------------- ---------------------
-- Replace_Element -- -- Replace_Element --
--------------------- ---------------------
......
...@@ -53,6 +53,7 @@ ...@@ -53,6 +53,7 @@
private with Ada.Streams; private with Ada.Streams;
with Ada.Containers; with Ada.Containers;
with Ada.Iterator_Interfaces;
generic generic
type Element_Type is private; type Element_Type is private;
...@@ -63,7 +64,10 @@ generic ...@@ -63,7 +64,10 @@ generic
package Ada.Containers.Formal_Doubly_Linked_Lists is package Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Pure; pragma Pure;
type List (Capacity : Count_Type) is tagged private; type List (Capacity : Count_Type) is tagged private with
Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
-- pragma Preelaborable_Initialization (List); -- pragma Preelaborable_Initialization (List);
type Cursor is private; type Cursor is private;
...@@ -73,6 +77,17 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -73,6 +77,17 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
No_Element : constant Cursor; No_Element : constant Cursor;
function Not_No_Element (Position : Cursor) return Boolean;
package List_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor => Cursor, Has_Element => Not_No_Element);
function Iterate (Container : List; Start : Cursor)
return List_Iterator_Interfaces.Reversible_Iterator'Class;
function Iterate (Container : List)
return List_Iterator_Interfaces.Reversible_Iterator'Class;
function "=" (Left, Right : List) return Boolean; function "=" (Left, Right : List) return Boolean;
function Length (Container : List) return Count_Type; function Length (Container : List) return Count_Type;
...@@ -225,6 +240,15 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -225,6 +240,15 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
end Generic_Sorting; end Generic_Sorting;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with
Implicit_Dereference => Element;
function Constant_Reference
(Container : List; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type;
function Strict_Equal (Left, Right : List) return Boolean; function Strict_Equal (Left, Right : List) return Boolean;
-- Strict_Equal returns True if the containers are physically equal, i.e. -- Strict_Equal returns True if the containers are physically equal, i.e.
-- they are structurally equal (function "=" returns True) and that they -- they are structurally equal (function "=" returns True) and that they
...@@ -244,8 +268,9 @@ private ...@@ -244,8 +268,9 @@ private
type Node_Type is record type Node_Type is record
Prev : Count_Type'Base := -1; Prev : Count_Type'Base := -1;
Next : Count_Type; Next : Count_Type;
Element : Element_Type; Element : aliased Element_Type;
end record; end record;
function "=" (L, R : Node_Type) return Boolean is abstract; function "=" (L, R : Node_Type) return Boolean is abstract;
type Node_Array is array (Count_Type range <>) of Node_Type; type Node_Array is array (Count_Type range <>) of Node_Type;
...@@ -275,6 +300,9 @@ private ...@@ -275,6 +300,9 @@ private
for List'Write use Write; for List'Write use Write;
type List_Access is access all List;
for List_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
Node : Count_Type := 0; Node : Count_Type := 0;
end record; end record;
...@@ -295,4 +323,7 @@ private ...@@ -295,4 +323,7 @@ private
No_Element : constant Cursor := (Node => 0); No_Element : constant Cursor := (Node => 0);
type Constant_Reference_Type
(Element : not null access constant Element_Type) is null record;
end Ada.Containers.Formal_Doubly_Linked_Lists; end Ada.Containers.Formal_Doubly_Linked_Lists;
...@@ -3003,7 +3003,7 @@ package body Exp_Ch5 is ...@@ -3003,7 +3003,7 @@ package body Exp_Ch5 is
-- Cursor : Cursor_type := First (Iter); -- Cursor : Cursor_type := First (Iter);
-- while Has_Element (Iter) loop -- while Has_Element (Iter) loop
-- declare -- declare
-- -- the block is added when Element_Type is controlled -- -- The block is added when Element_Type is controlled
-- Obj : Pack.Element_Type := Element (Cursor); -- Obj : Pack.Element_Type := Element (Cursor);
-- -- for the "of" loop form -- -- for the "of" loop form
...@@ -3052,7 +3052,7 @@ package body Exp_Ch5 is ...@@ -3052,7 +3052,7 @@ package body Exp_Ch5 is
-- The "of" case uses an internally generated cursor whose type -- The "of" case uses an internally generated cursor whose type
-- is found in the container package. The domain of iteration -- is found in the container package. The domain of iteration
-- is expanded into a call to the default Iterator function, but -- is expanded into a call to the default Iterator function, but
-- this expansion does not take place in a quantifier expressions -- this expansion does not take place in quantified expressions
-- that are analyzed with expansion disabled, and in that case the -- that are analyzed with expansion disabled, and in that case the
-- type of the iterator must be obtained from the aspect. -- type of the iterator must be obtained from the aspect.
...@@ -3103,8 +3103,8 @@ package body Exp_Ch5 is ...@@ -3103,8 +3103,8 @@ package body Exp_Ch5 is
New_List (Container_Arg))); New_List (Container_Arg)));
Analyze_And_Resolve (Name (I_Spec)); Analyze_And_Resolve (Name (I_Spec));
-- Find cursor type in proper iterator package, which -- Find cursor type in proper iterator package, which is an
-- is an instantiation of Iterator_Interfaces. -- instantiation of Iterator_Interfaces.
Ent := First_Entity (Pack); Ent := First_Entity (Pack);
while Present (Ent) loop while Present (Ent) loop
...@@ -3218,7 +3218,7 @@ package body Exp_Ch5 is ...@@ -3218,7 +3218,7 @@ package body Exp_Ch5 is
-- while Iterator.Has_Element loop -- while Iterator.Has_Element loop
-- <Stats> -- <Stats>
-- end loop; -- end loop;
--
-- Has_Element is the second actual in the iterator package -- Has_Element is the second actual in the iterator package
New_Loop := New_Loop :=
...@@ -3236,12 +3236,8 @@ package body Exp_Ch5 is ...@@ -3236,12 +3236,8 @@ package body Exp_Ch5 is
Statements => Stats, Statements => Stats,
End_Label => Empty); End_Label => Empty);
-- Make_Selected_Component (Loc,
-- Prefix => New_Reference_To (Cursor, Loc),
-- Selector_Name =>
-- Make_Identifier (Loc, Name_Has_Element))),
-- Create the declarations for Iterator and cursor and insert then -- Create the declarations for Iterator and cursor and insert them
-- before the source loop. Given that the domain of iteration is -- before the source loop. Given that the domain of iteration is
-- already an entity, the iterator is just a renaming of that -- already an entity, the iterator is just a renaming of that
-- entity. Possible optimization ??? -- entity. Possible optimization ???
......
...@@ -1157,8 +1157,8 @@ package body Prj.Conf is ...@@ -1157,8 +1157,8 @@ package body Prj.Conf is
if Path_FD /= Invalid_FD then if Path_FD /= Invalid_FD then
declare declare
Temp_Dir : constant String := Temp_Dir : constant String :=
Containing_Directory Containing_Directory
(Get_Name_String (Path_Name)); (Get_Name_String (Path_Name));
begin begin
GNAT.OS_Lib.Close (Path_FD); GNAT.OS_Lib.Close (Path_FD);
Args (3) := Args (3) :=
......
...@@ -3795,10 +3795,10 @@ package body Sem_Ch12 is ...@@ -3795,10 +3795,10 @@ package body Sem_Ch12 is
then then
declare declare
Assoc : constant Node_Id := First (Generic_Associations (N)); Assoc : constant Node_Id := First (Generic_Associations (N));
begin begin
if not Has_Dimension_System if not Has_Dimension_System
(Etype (Explicit_Generic_Actual_Parameter (Assoc))) then (Etype (Explicit_Generic_Actual_Parameter (Assoc)))
then
Error_Msg_N ("type with a dimension system expected", Assoc); Error_Msg_N ("type with a dimension system expected", Assoc);
end if; end if;
end; end;
......
...@@ -98,10 +98,9 @@ package Sem_Dim is ...@@ -98,10 +98,9 @@ package Sem_Dim is
Id : Entity_Id; Id : Entity_Id;
Aggr : Node_Id); Aggr : Node_Id);
-- Analyze the contents of aspect Dimension. Associate the provided values -- Analyze the contents of aspect Dimension. Associate the provided values
-- and quantifiers with the related context N. -- and quantifiers with the related context N. Id is the corresponding
-- Id is the corresponding Aspect_Id (Aspect_Dimension) -- Aspect_Id (Aspect_Dimension) Aggr is the corresponding expression for
-- Aggr is the corresponding expression for the aspect Dimension declared -- the aspect Dimension declared by the declaration of N.
-- by the declaration of N.
procedure Analyze_Aspect_Dimension_System procedure Analyze_Aspect_Dimension_System
(N : Node_Id; (N : Node_Id;
...@@ -141,9 +140,8 @@ package Sem_Dim is ...@@ -141,9 +140,8 @@ package Sem_Dim is
Btyp : Entity_Id); Btyp : Entity_Id);
-- Evaluate the Expon operator for dimensioned type with rational exponent. -- Evaluate the Expon operator for dimensioned type with rational exponent.
-- Indeed the regular Eval_Op_Expon routine (see package Sem_Eval) is -- Indeed the regular Eval_Op_Expon routine (see package Sem_Eval) is
-- restricted to Integer exponent. -- restricted to Integer exponent. This routine deals only with rational
-- This routine deals only with rational exponent which is not an integer -- exponent which is not an integer if Btyp is a dimensioned type.
-- if Btyp is a dimensioned type.
procedure Expand_Put_Call_With_Dimension_Symbol (N : Node_Id); procedure Expand_Put_Call_With_Dimension_Symbol (N : Node_Id);
-- Determine whether N denotes a subprogram call to one of the routines -- Determine whether N denotes a subprogram call to one of the routines
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment