+2011-08-29 Robert Dewar <dewar@adacore.com>
+
+ * a-cdlili.adb, a-cdlili.ads, a-coinve.adb, a-coinve.ads,
+ sem_util.adb, sem_util.ads, a-cohama.adb, a-cohama.ads, a-coorse.adb,
+ a-coorse.ads, aspects.ads, sem_ch8.adb: Minor reformatting.
+
2011-08-29 Thomas Quinot <quinot@adacore.com>
* system-freebsd-x86_64.ads (Backend_Overflow_Checks): Set true True.
Node : Node_Access;
end record;
- 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;
+ 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 --
declare
Next_Node : constant Node_Access := Position.Node.Next;
+
begin
if Next_Node = null then
return No_Element;
end;
end Next;
- function Next (Object : Iterator; Position : Cursor) return Cursor is
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
begin
if Position.Node = Object.Container.Last then
return No_Element;
-
else
return (Object.Container, Position.Node.Next);
end if;
declare
Prev_Node : constant Node_Access := Position.Node.Prev;
+
begin
if Prev_Node = null then
return No_Element;
end;
end Previous;
- function Previous (Object : Iterator; Position : Cursor) return Cursor is
+ function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
begin
if Position.Node = Position.Container.First then
return No_Element;
-
else
return (Object.Container, Position.Node.Prev);
end if;
------------------------------------------------------------------------------
private with Ada.Finalization;
-with Ada.Streams; use Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic
type Iterator is new
Map_Iterator_Interfaces.Forward_Iterator with record
- Container : Map_Access;
- Node : Node_Access;
- end record;
+ Container : Map_Access;
+ Node : Node_Access;
+ end record;
overriding function First (Object : Iterator) return Cursor;
- overriding function Next (Object : Iterator; Position : Cursor)
- return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
-----------------------
-- Local Subprograms --
B := B - 1;
end Iterate;
- function Iterate (Container : Map)
- return Map_Iterator_Interfaces.Forward_Iterator'class
+ function Iterate
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
is
Node : constant Node_Access := HT_Ops.First (Container.HT);
It : constant Iterator := (Container'Unrestricted_Access, Node);
Position := Next (Position);
end Next;
- function Next (Object : Iterator; Position : Cursor) return Cursor is
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
begin
if Position.Node = null then
return No_Element;
-
else
return (Object.Container, Next (Position).Node);
end if;
------------------------------------------------------------------------------
private with Ada.Containers.Hash_Tables;
-with Ada.Streams; use Ada.Streams;
private with Ada.Finalization;
+
+with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic
end record;
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;
+
+ 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;
---------
-- "&" --
return It;
end Iterate;
- function Iterate (Container : Vector; Start : Cursor)
+ function Iterate
+ (Container : Vector;
+ Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class
is
It : constant Iterator :=
end if;
end Next;
- ----------
- -- Next --
- ----------
-
procedure Next (Position : in out Cursor) is
begin
if Position.Container = null then
------------------------------------------------------------------------------
private with Ada.Finalization;
-with Ada.Streams; use Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic
function Iterate (Container : Vector)
return Vector_Iterator_Interfaces.Reversible_Iterator'class;
- function Iterate (Container : Vector; Start : Cursor)
+ function Iterate
+ (Container : Vector;
+ Start : Cursor)
return Vector_Iterator_Interfaces.Reversible_Iterator'class;
procedure Reverse_Iterate
end record;
type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ (Element : not null access constant Element_Type) is null record;
type Reference_Type
- (Element : not null access Element_Type) is null record;
+ (Element : not null access Element_Type) is null record;
overriding procedure Adjust (Container : in out Vector);
type Iterator is new
Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
- Container : access constant Set;
- Node : Node_Access;
- end record;
+ Container : access constant Set;
+ Node : Node_Access;
+ end record;
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;
+
+ 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;
------------------------------
-- Access to Fields of Node --
Position := Next (Position);
end Next;
- function Next (Object : Iterator; Position : Cursor)
- return Cursor
- is
+ function Next (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
begin
return Next (Position);
Position := Previous (Position);
end Previous;
- overriding function Previous (Object : Iterator; Position : Cursor)
- return Cursor
- is
+ function Previous (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
begin
return Previous (Position);
end Previous;
+
-------------------
-- Query_Element --
-------------------
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
-with Ada.Streams; use Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
with Ada.Iterator_Interfaces;
generic
(Container : Set;
Process : not null access procedure (Position : Cursor));
- function Iterate (Container : Set)
+ function Iterate
+ (Container : Set)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
- function Iterate (Container : Set; Start : Cursor)
+ function Iterate
+ (Container : Set;
+ Start : Cursor)
return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
generic
-- empty list or No_List.
function Find_Aspect (Ent : Entity_Id; A : Aspect_Id) return Node_Id;
- -- Find value of a given aspect from aspect list of entity.
+ -- Find value of a given aspect from aspect list of entity
procedure Move_Aspects (From : Node_Id; To : Node_Id);
-- Moves aspects from 'From' node to 'To' node. Has_Aspects (To) must be
Next_Entity (Id);
end loop;
- -- If not found, standard error message
+ -- If not found, standard error message
Error_Msg_NE ("& not declared in&", N, Selector);
Disc : Entity_Id)
is
Loc : constant Source_Ptr := Sloc (Expr);
-
begin
Set_Is_Overloaded (Expr, False);
Rewrite (Expr,
Make_Explicit_Dereference (Loc,
Prefix =>
Make_Selected_Component (Loc,
- Prefix => Relocate_Node (Expr),
- Selector_Name =>
- New_Occurrence_Of (Disc, Loc))));
-
+ Prefix => Relocate_Node (Expr),
+ Selector_Name => New_Occurrence_Of (Disc, Loc))));
Set_Etype (Prefix (Expr), Etype (Disc));
Set_Etype (Expr, Designated_Type (Etype (Disc)));
end Build_Explicit_Dereference;
Iface : Entity_Id;
begin
- if not Is_Tagged_Type (Typ)
- or else not Is_Derived_Type (Typ)
- then
+ if not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
return False;
else
return False;
end if;
-
end Is_Iterator;
-
- ----------------------------
- -- Is_Reversible_Iterator --
- ----------------------------
-
- function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is
- Ifaces_List : Elist_Id;
- Iface_Elmt : Elmt_Id;
- Iface : Entity_Id;
-
- begin
- if not Is_Tagged_Type (Typ)
- or else not Is_Derived_Type (Typ)
- then
- return False;
- else
-
- Collect_Interfaces (Typ, Ifaces_List);
-
- Iface_Elmt := First_Elmt (Ifaces_List);
- while Present (Iface_Elmt) loop
- Iface := Node (Iface_Elmt);
- if Chars (Iface) = Name_Reversible_Iterator
- and then
- Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Iface)))
- then
- return True;
- end if;
-
- Next_Elmt (Iface_Elmt);
- end loop;
-
- end if;
- return False;
- end Is_Reversible_Iterator;
-
------------
-- Is_LHS --
------------
-- original node is a conversion, then Is_Variable will not be true
-- but we still want to allow the conversion if it converts a variable).
- -- In Ada2012, the explicit dereference may be a rewritten call
- -- to a Reference function.
-
elsif Original_Node (AV) /= AV then
+
+ -- In Ada2012, the explicit dereference may be a rewritten call to a
+ -- Reference function.
+
if Ada_Version >= Ada_2012
and then Nkind (Original_Node (AV)) = N_Function_Call
and then
- Has_Implicit_Dereference
- (Etype (Name (Original_Node (AV))))
+ Has_Implicit_Dereference (Etype (Name (Original_Node (AV))))
then
return True;
return False;
end Is_Renamed_Entry;
+ ----------------------------
+ -- Is_Reversible_Iterator --
+ ----------------------------
+
+ function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is
+ Ifaces_List : Elist_Id;
+ Iface_Elmt : Elmt_Id;
+ Iface : Entity_Id;
+
+ begin
+ if not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
+ return False;
+
+ else
+ Collect_Interfaces (Typ, Ifaces_List);
+
+ Iface_Elmt := First_Elmt (Ifaces_List);
+ while Present (Iface_Elmt) loop
+ Iface := Node (Iface_Elmt);
+ if Chars (Iface) = Name_Reversible_Iterator
+ and then
+ Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Iface)))
+ then
+ return True;
+ end if;
+
+ Next_Elmt (Iface_Elmt);
+ end loop;
+ end if;
+
+ return False;
+ end Is_Reversible_Iterator;
+
----------------------
-- Is_Selector_Name --
----------------------
-- by a derived type declaration.
function Is_Inherited_Operation_For_Type
- (E : Entity_Id; Typ : Entity_Id) return Boolean;
+ (E : Entity_Id;
+ Typ : Entity_Id) return Boolean;
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by the derived type declaration for type Typ.
function Is_Iterator (Typ : Entity_Id) return Boolean;
- -- AI05-0139-2 : check whether Typ is derived from the predefined interface
+ -- AI05-0139-2: Check whether Typ is derived from the predefined interface
-- Ada.Iterator_Interfaces.Forward_Iterator.
- function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean;
- -- Ditto for Ada.Iterator_Interfaces.Reversible_Iterator.
-
function Is_LHS (N : Node_Id) return Boolean;
-- Returns True iff N is used as Name in an assignment statement
function Is_Renamed_Entry (Proc_Nam : Entity_Id) return Boolean;
-- Return True if Proc_Nam is a procedure renaming of an entry
+ function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean;
+ -- AI05-0139-2: Check whether Typ is derived from the predefined interface
+ -- Ada.Iterator_Interfaces.Reversible_Iterator.
+
function Is_Selector_Name (N : Node_Id) return Boolean;
-- Given an N_Identifier node N, determines if it is a Selector_Name.
-- As described in Sinfo, Selector_Names are special because they