+2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * checks.adb (Apply_Predicate_Check): Update the comment associated
+ with the call to Check_Expression_Against_Static_Predicate.
+ * sem_ch3.adb (Analyze_Object_Declaration): Update the comment
+ associated with the call to Check_Expression_Against_Static_Predicate.
+ * sem_util.adb (Check_Expression_Against_Static_Predicate):
+ Broaden the check from a static expression to an expression with
+ a known value at compile time.
+ * sem_util.ads (Check_Expression_Against_Static_Predicate): Update
+ comment on usage.
+
+2013-04-25 Thomas Quinot <quinot@adacore.com>
+
+ * exp_attr.adb (Expand_N_Attribute_Reference, cases Position,
+ First_Bit, and Last_Bit): Fix incorrect test in implementation of
+ RM 2005 13.5.2(3/2).
+
+2013-04-25 Claire Dross <dross@adacore.com>
+
+ * a-cfhase.adb, a-cfhase.ads, a-cforma.adb, a-cforma.ads, a-cfhama.adb,
+ a-cfhama.ads, a-cforse.adb, a-cforse.ads, a-cofove.adb, a-cofove.ads
+ (Query_Element): Removed.
+ (Update_Element): Removed.
+ (Insert): The version with no New_Item specified is removed.
+ (Iterate): Removed.
+ (Write): Removed.
+ (Read): Removed.
+ Every check of fields Busy and Lock has been removed.
+
+2013-04-25 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma, case Contract_Cases): Remove
+ call to S14_Pragma (Find_Related_Subprogram): Require proper
+ placement in subprogram body (Find_Related_Subprogram): Detect
+ duplicates for all cases (Find_Related_Subprogram): Handle case
+ of spec nested inside body.
+
2013-04-25 Arnaud Charlet <charlet@adacore.com>
* par-prag.adb: Fix typo.
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
"Source length exceeds Target capacity";
end if;
- -- Check busy bits
-
Clear (Target);
Insert_Elements (Source);
"Position cursor of Delete has no element";
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "Delete attempted to tamper with elements (map is busy)";
- end if;
-
pragma Assert (Vet (Container, Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then
- if Container.Lock > 0 then
- raise Program_Error with
- "Include attempted to tamper with cursors (map is locked)";
- end if;
declare
N : Node_Type renames Container.Nodes (Position.Node);
procedure Insert
(Container : in out Map;
Key : Key_Type;
- Position : out Cursor;
- Inserted : out Boolean)
- is
- procedure Assign_Key (Node : in out Node_Type);
- pragma Inline (Assign_Key);
-
- function New_Node return Count_Type;
- pragma Inline (New_Node);
-
- procedure Local_Insert is
- new Key_Ops.Generic_Conditional_Insert (New_Node);
-
- procedure Allocate is
- new Generic_Allocate (Assign_Key);
-
- -----------------
- -- Assign_Key --
- -----------------
-
- procedure Assign_Key (Node : in out Node_Type) is
- begin
- Node.Key := Key;
-
- -- What is following commented out line doing here ???
- -- Node.Element := New_Item;
- end Assign_Key;
-
- --------------
- -- New_Node --
- --------------
-
- function New_Node return Count_Type is
- Result : Count_Type;
- begin
- Allocate (Container, Result);
- return Result;
- end New_Node;
-
- -- Start of processing for Insert
-
- begin
-
- Local_Insert (Container, Key, Position.Node, Inserted);
- end Insert;
-
- procedure Insert
- (Container : in out Map;
- Key : Key_Type;
New_Item : Element_Type;
Position : out Cursor;
Inserted : out Boolean)
return Length (Container) = 0;
end Is_Empty;
- -------------
- -- Iterate --
- -------------
-
- procedure Iterate
- (Container : Map;
- Process : not null
- access procedure (Container : Map; Position : Cursor))
- is
- procedure Process_Node (Node : Count_Type);
- pragma Inline (Process_Node);
-
- procedure Local_Iterate is new HT_Ops.Generic_Iteration (Process_Node);
-
- ------------------
- -- Process_Node --
- ------------------
-
- procedure Process_Node (Node : Count_Type) is
- begin
- Process (Container, (Node => Node));
- end Process_Node;
-
- B : Natural renames Container'Unrestricted_Access.Busy;
-
- -- Start of processing for Iterate
-
- begin
- B := B + 1;
-
- begin
- Local_Iterate (Container);
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Iterate;
-
---------
-- Key --
---------
"Source length exceeds Target capacity";
end if;
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
Clear (Target);
if Source.Length = 0 then
return False;
end Overlap;
- -------------------
- -- Query_Element --
- -------------------
-
- procedure Query_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access
- procedure (Key : Key_Type; Element : Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor of Query_Element has no element";
- end if;
-
- pragma Assert (Vet (Container, Position), "bad cursor in Query_Element");
-
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- declare
- K : Key_Type renames N.Key;
- E : Element_Type renames N.Element;
- begin
- Process (K, E);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Query_Element;
-
- ----------
- -- Read --
- ----------
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Map)
- is
- function Read_Node (Stream : not null access Root_Stream_Type'Class)
- return Count_Type;
-
- procedure Read_Nodes is
- new HT_Ops.Generic_Read (Read_Node);
-
- ---------------
- -- Read_Node --
- ---------------
-
- function Read_Node
- (Stream : not null access Root_Stream_Type'Class) return Count_Type
- is
- procedure Read_Element (Node : in out Node_Type);
- pragma Inline (Read_Element);
-
- procedure Allocate is
- new Generic_Allocate (Read_Element);
-
- procedure Read_Element (Node : in out Node_Type) is
- begin
- Element_Type'Read (Stream, Node.Element);
- end Read_Element;
-
- Node : Count_Type;
-
- -- Start of processing for Read_Node
-
- begin
- Allocate (Container, Node);
- return Node;
- end Read_Node;
-
- -- Start of processing for Read
-
- begin
- Read_Nodes (Stream, Container);
- end Read;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor)
- is
- begin
- raise Program_Error with "attempt to stream set cursor";
- end Read;
-
-------------
-- Replace --
-------------
"attempt to replace key not in map";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "Replace attempted to tamper with cursors (map is locked)";
- end if;
-
declare
N : Node_Type renames Container.Nodes (Node);
begin
"Position cursor of Replace_Element has no element";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "Replace_Element attempted to tamper with cursors (map is locked)";
- end if;
-
pragma Assert (Vet (Container, Position),
"bad cursor in Replace_Element");
return True;
end Strict_Equal;
- --------------------
- -- Update_Element --
- --------------------
-
- procedure Update_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access procedure (Key : Key_Type;
- Element : in out Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor of Update_Element has no element";
- end if;
-
- pragma Assert (Vet (Container, Position),
- "bad cursor in Update_Element");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- K : Key_Type renames N.Key;
- E : Element_Type renames N.Element;
-
- begin
- Process (K, E);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Update_Element;
-
---------
-- Vet --
---------
end;
end Vet;
- -----------
- -- Write --
- -----------
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Map)
- is
- procedure Write_Node
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type);
- pragma Inline (Write_Node);
-
- procedure Write_Nodes is new HT_Ops.Generic_Write (Write_Node);
-
- ----------------
- -- Write_Node --
- ----------------
-
- procedure Write_Node
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type)
- is
- begin
- Key_Type'Write (Stream, Node.Key);
- Element_Type'Write (Stream, Node.Element);
- end Write_Node;
-
- -- Start of processing for Write
-
- begin
- Write_Nodes (Stream, Container);
- end Write;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor)
- is
- begin
- raise Program_Error with "attempt to stream map cursor";
- end Write;
-
end Ada.Containers.Formal_Hashed_Maps;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- See detailed specifications for these subprograms
private with Ada.Containers.Hash_Tables;
-private with Ada.Streams;
generic
type Key_Type is private;
function Is_Empty (Container : Map) return Boolean;
- -- ??? what does clear do to active elements?
procedure Clear (Container : in out Map);
procedure Assign (Target : in out Map; Source : Map);
- -- ???
- -- capacity=0 means use container.length as cap of tgt
- -- modulos=0 means use default_modulous(container.length)
+ -- Copy returns a container stricty equal to Source
+ -- It must have the same cursors associated to each element
+ -- Therefore:
+ -- - capacity=0 means use container.capacity as cap of tgt
+ -- - the modulus cannot be changed.
function Copy
(Source : Map;
Capacity : Count_Type := 0) return Map;
Position : Cursor;
New_Item : Element_Type);
- procedure Query_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access
- procedure (Key : Key_Type; Element : Element_Type));
-
- procedure Update_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access
- procedure (Key : Key_Type; Element : in out Element_Type));
-
procedure Move (Target : in out Map; Source : in out Map);
procedure Insert
procedure Insert
(Container : in out Map;
Key : Key_Type;
- Position : out Cursor;
- Inserted : out Boolean);
-
- procedure Insert
- (Container : in out Map;
- Key : Key_Type;
New_Item : Element_Type);
procedure Include
Right : Map;
CRight : Cursor) return Boolean;
- procedure Iterate
- (Container : Map;
- Process : not null access
- procedure (Container : Map; Position : Cursor));
-
function Default_Modulus (Capacity : Count_Type) return Hash_Type;
function Strict_Equal (Left, Right : Map) return Boolean;
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
- use Ada.Streams;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Map);
-
- for Map'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Map);
-
- for Map'Read use Read;
-
- type Map_Access is access all Map;
- for Map_Access'Storage_Size use 0;
type Cursor is record
Node : Count_Type;
end record;
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor);
-
- for Cursor'Read use Read;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor);
-
- for Cursor'Write use Write;
-
Empty_Map : constant Map := (Capacity => 0, Modulus => 0, others => <>);
No_Element : constant Cursor := (Node => 0);
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
raise Constraint_Error with "Position cursor has no element";
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (set is busy)";
- end if;
-
pragma Assert (Vet (Container, Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
return;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (set is busy)";
- end if;
-
if Src_Length >= Target.Length then
Tgt_Node := HT_Ops.First (Target);
while Tgt_Node /= 0 loop
end;
end Equivalent_Elements;
- -- What does the following comment signify???
- -- NOT MODIFIED
-
---------------------
-- Equivalent_Keys --
---------------------
Insert (Container, New_Item, Position, Inserted);
if not Inserted then
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (set is locked)";
- end if;
Container.Nodes (Position.Node).Element := New_Item;
end if;
return;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (set is busy)";
- end if;
-
Tgt_Node := HT_Ops.First (Target);
while Tgt_Node /= 0 loop
if Find (Source, TN (Tgt_Node).Element).Node /= 0 then
return True;
end Is_Subset;
- -------------
- -- Iterate --
- -------------
-
- procedure Iterate
- (Container : Set;
- Process :
- not null access procedure (Container : Set; Position : Cursor))
- is
- procedure Process_Node (Node : Count_Type);
- pragma Inline (Process_Node);
-
- procedure Iterate is
- new HT_Ops.Generic_Iteration (Process_Node);
-
- ------------------
- -- Process_Node --
- ------------------
-
- procedure Process_Node (Node : Count_Type) is
- begin
- Process (Container, (Node => Node));
- end Process_Node;
-
- B : Natural renames Container'Unrestricted_Access.Busy;
-
- -- Start of processing for Iterate
-
- begin
- B := B + 1;
-
- begin
- Iterate (Container);
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Iterate;
-
----------
-- Left --
----------
"Source length exceeds Target capacity";
end if;
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
Clear (Target);
if Source.Length = 0 then
return False;
end Overlap;
- -------------------
- -- Query_Element --
- -------------------
-
- procedure Query_Element
- (Container : in out Set;
- Position : Cursor;
- Process : not null access procedure (Element : Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor of Query_Element has no element";
- end if;
-
- pragma Assert (Vet (Container, Position), "bad cursor in Query_Element");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- begin
- Process (Container.Nodes (Position.Node).Element);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Query_Element;
-
- ----------
- -- Read --
- ----------
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Set)
- is
- function Read_Node (Stream : not null access Root_Stream_Type'Class)
- return Count_Type;
-
- procedure Read_Nodes is
- new HT_Ops.Generic_Read (Read_Node);
-
- ---------------
- -- Read_Node --
- ---------------
-
- function Read_Node (Stream : not null access Root_Stream_Type'Class)
- return Count_Type
- is
- procedure Read_Element (Node : in out Node_Type);
- pragma Inline (Read_Element);
-
- procedure Allocate is new Generic_Allocate (Read_Element);
-
- ------------------
- -- Read_Element --
- ------------------
-
- procedure Read_Element (Node : in out Node_Type) is
- begin
- Element_Type'Read (Stream, Node.Element);
- end Read_Element;
-
- Node : Count_Type;
-
- -- Start of processing for Read_Node
-
- begin
- Allocate (Container, Node);
- return Node;
- end Read_Node;
-
- -- Start of processing for Read
-
- begin
- Read_Nodes (Stream, Container);
- end Read;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor)
- is
- begin
- raise Program_Error with "attempt to stream set cursor";
- end Read;
-
-------------
-- Replace --
-------------
"attempt to replace element not in set";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (set is locked)";
- end if;
-
Container.Nodes (Node).Element := New_Item;
end Replace;
return;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (set is busy)";
- end if;
-
Iterate (Source);
end Symmetric_Difference;
return;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (set is busy)";
- end if;
Iterate (Source);
end Union;
end;
end Vet;
- -----------
- -- Write --
- -----------
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Set)
- is
- procedure Write_Node
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type);
- pragma Inline (Write_Node);
-
- procedure Write_Nodes is
- new HT_Ops.Generic_Write (Write_Node);
-
- ----------------
- -- Write_Node --
- ----------------
-
- procedure Write_Node
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type)
- is
- begin
- Element_Type'Write (Stream, Node.Element);
- end Write_Node;
-
- -- Start of processing for Write
-
- begin
- Write_Nodes (Stream, Container);
- end Write;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor)
- is
- begin
- raise Program_Error with "attempt to stream set cursor";
- end Write;
package body Generic_Keys is
-----------------------
Replace_Element (Container, Node, New_Item);
end Replace;
- -----------------------------------
- -- Update_Element_Preserving_Key --
- -----------------------------------
-
- procedure Update_Element_Preserving_Key
- (Container : in out Set;
- Position : Cursor;
- Process : not null access
- procedure (Element : in out Element_Type))
- is
- Indx : Hash_Type;
- N : Nodes_Type renames Container.Nodes;
-
- begin
- if Position.Node = 0 then
- raise Constraint_Error with
- "Position cursor equals No_Element";
- end if;
-
- pragma Assert
- (Vet (Container, Position),
- "bad cursor in Update_Element_Preserving_Key");
-
- -- Record bucket now, in case key is changed
-
- Indx := HT_Ops.Index (Container.Buckets, N (Position.Node));
-
- declare
- E : Element_Type renames N (Position.Node).Element;
- K : constant Key_Type := Key (E);
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- begin
- Process (E);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
-
- if Equivalent_Keys (K, Key (E)) then
- pragma Assert (Hash (K) = Hash (E));
- return;
- end if;
- end;
-
- -- Key was modified, so remove this node from set
-
- if Container.Buckets (Indx) = Position.Node then
- Container.Buckets (Indx) := N (Position.Node).Next;
-
- else
- declare
- Prev : Count_Type := Container.Buckets (Indx);
-
- begin
- while N (Prev).Next /= Position.Node loop
- Prev := N (Prev).Next;
-
- if Prev = 0 then
- raise Program_Error with
- "Position cursor is bad (node not found)";
- end if;
- end loop;
-
- N (Prev).Next := N (Position.Node).Next;
- end;
- end if;
-
- Container.Length := Container.Length - 1;
- Free (Container, Position.Node);
-
- raise Program_Error with "key was modified";
- end Update_Element_Preserving_Key;
-
end Generic_Keys;
end Ada.Containers.Formal_Hashed_Sets;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- See detailed specifications for these subprograms
private with Ada.Containers.Hash_Tables;
-private with Ada.Streams;
generic
type Element_Type is private;
pragma Pure;
type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
- -- why is this commented out ???
- -- pragma Preelaborable_Initialization (Set);
+ pragma Preelaborable_Initialization (Set);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
Position : Cursor;
New_Item : Element_Type);
- procedure Query_Element
- (Container : in out Set;
- Position : Cursor;
- Process : not null access procedure (Element : Element_Type));
-
procedure Move (Target : in out Set; Source : in out Set);
procedure Insert
(Left : Element_Type;
Right : Set; CRight : Cursor) return Boolean;
- procedure Iterate
- (Container : Set;
- Process :
- not null access procedure (Container : Set; Position : Cursor));
-
function Default_Modulus (Capacity : Count_Type) return Hash_Type;
generic
function Contains (Container : Set; Key : Key_Type) return Boolean;
- procedure Update_Element_Preserving_Key
- (Container : in out Set;
- Position : Cursor;
- Process : not null access
- procedure (Element : in out Element_Type));
-
end Generic_Keys;
function Strict_Equal (Left, Right : Set) return Boolean;
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
- use Ada.Streams;
type Cursor is record
Node : Count_Type;
end record;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor);
-
- for Cursor'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor);
-
- for Cursor'Read use Read;
-
No_Element : constant Cursor := (Node => 0);
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Set);
-
- for Set'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Set);
-
- for Set'Read use Read;
-
Empty_Set : constant Set := (Capacity => 0, Modulus => 0, others => <>);
end Ada.Containers.Formal_Hashed_Sets;
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (map is locked)";
- end if;
-
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
end if;
end Insert;
- ------------
- -- Insert --
- ------------
-
- procedure Insert
- (Container : in out Map;
- Key : Key_Type;
- Position : out Cursor;
- Inserted : out Boolean)
- is
- function New_Node return Node_Access;
-
- procedure Insert_Post is
- new Key_Ops.Generic_Insert_Post (New_Node);
-
- procedure Insert_Sans_Hint is
- new Key_Ops.Generic_Conditional_Insert (Insert_Post);
-
- --------------
- -- New_Node --
- --------------
-
- function New_Node return Node_Access is
- procedure Initialize (Node : in out Node_Type);
- procedure Allocate_Node is new Generic_Allocate (Initialize);
-
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize (Node : in out Node_Type) is
- begin
- Node.Key := Key;
- end Initialize;
-
- X : Node_Access;
-
- -- Start of processing for New_Node
-
- begin
- Allocate_Node (Container, X);
- return X;
- end New_Node;
-
- -- Start of processing for Insert
-
- begin
- Insert_Sans_Hint (Container, Key, Position.Node, Inserted);
- end Insert;
-
--------------
-- Is_Empty --
--------------
return Left < Right.Key;
end Is_Less_Key_Node;
- -------------
- -- Iterate --
- -------------
-
- procedure Iterate
- (Container : Map;
- Process :
- not null access procedure (Container : Map; Position : Cursor))
- is
- procedure Process_Node (Node : Node_Access);
- pragma Inline (Process_Node);
-
- procedure Local_Iterate is
- new Tree_Operations.Generic_Iteration (Process_Node);
-
- ------------------
- -- Process_Node --
- ------------------
-
- procedure Process_Node (Node : Node_Access) is
- begin
- Process (Container, (Node => Node));
- end Process_Node;
-
- B : Natural renames Container'Unrestricted_Access.Busy;
-
- -- Start of processing for Iterate
-
- begin
- B := B + 1;
-
- begin
- Local_Iterate (Container);
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Iterate;
-
---------
-- Key --
---------
"Source length exceeds Target capacity";
end if;
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
Clear (Target);
loop
end;
end Previous;
- -------------------
- -- Query_Element --
- -------------------
-
- procedure Query_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access procedure (Key : Key_Type;
- Element : Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor of Query_Element has no element";
- end if;
-
- pragma Assert (Vet (Container, Position.Node),
- "Position cursor of Query_Element is bad");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- K : Key_Type renames N.Key;
- E : Element_Type renames N.Element;
-
- begin
- Process (K, E);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Query_Element;
-
- ----------
- -- Read --
- ----------
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Map)
- is
- procedure Read_Element (Node : in out Node_Type);
- pragma Inline (Read_Element);
-
- procedure Allocate is
- new Generic_Allocate (Read_Element);
-
- procedure Read_Elements is
- new Tree_Operations.Generic_Read (Allocate);
-
- ------------------
- -- Read_Element --
- ------------------
-
- procedure Read_Element (Node : in out Node_Type) is
- begin
- Key_Type'Read (Stream, Node.Key);
- Element_Type'Read (Stream, Node.Element);
- end Read_Element;
-
- -- Start of processing for Read
-
- begin
- Read_Elements (Stream, Container);
- end Read;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor)
- is
- begin
- raise Program_Error with "attempt to stream map cursor";
- end Read;
-
-------------
-- Replace --
-------------
raise Constraint_Error with "key not in map";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (map is locked)";
- end if;
-
declare
N : Node_Type renames Container.Nodes (Node);
begin
"Position cursor of Replace_Element has no element";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (map is locked)";
- end if;
-
pragma Assert (Vet (Container, Position.Node),
"Position cursor of Replace_Element is bad");
Container.Nodes (Position.Node).Element := New_Item;
end Replace_Element;
- ---------------------
- -- Reverse_Iterate --
- ---------------------
-
- procedure Reverse_Iterate
- (Container : Map;
- Process : not null access procedure (Container : Map;
- Position : Cursor))
- is
- procedure Process_Node (Node : Node_Access);
- pragma Inline (Process_Node);
-
- procedure Local_Reverse_Iterate is
- new Tree_Operations.Generic_Reverse_Iteration (Process_Node);
-
- ------------------
- -- Process_Node --
- ------------------
-
- procedure Process_Node (Node : Node_Access) is
- begin
- Process (Container, (Node => Node));
- end Process_Node;
-
- B : Natural renames Container'Unrestricted_Access.Busy;
-
- -- Start of processing for Reverse_Iterate
-
- begin
- B := B + 1;
-
- begin
- Local_Reverse_Iterate (Container);
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Reverse_Iterate;
-
-----------
-- Right --
-----------
return False;
end Strict_Equal;
- --------------------
- -- Update_Element --
- --------------------
-
- procedure Update_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access procedure (Key : Key_Type;
- Element : in out Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor of Update_Element has no element";
- end if;
-
- pragma Assert (Vet (Container, Position.Node),
- "Position cursor of Update_Element is bad");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- K : Key_Type renames N.Key;
- E : Element_Type renames N.Element;
-
- begin
- Process (K, E);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Update_Element;
-
- -----------
- -- Write --
- -----------
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Map)
- is
- procedure Write_Node
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type);
- pragma Inline (Write_Node);
-
- procedure Write_Nodes is
- new Tree_Operations.Generic_Write (Write_Node);
-
- ----------------
- -- Write_Node --
- ----------------
-
- procedure Write_Node
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type)
- is
- begin
- Key_Type'Write (Stream, Node.Key);
- Element_Type'Write (Stream, Node.Element);
- end Write_Node;
-
- -- Start of processing for Write
-
- begin
- Write_Nodes (Stream, Container);
- end Write;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor)
- is
- begin
- raise Program_Error with "attempt to stream map cursor";
- end Write;
-
end Ada.Containers.Formal_Ordered_Maps;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- See detailed specifications for these subprograms
private with Ada.Containers.Red_Black_Trees;
-private with Ada.Streams;
generic
type Key_Type is private;
Position : Cursor;
New_Item : Element_Type);
- procedure Query_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access
- procedure (Key : Key_Type; Element : Element_Type));
-
- procedure Update_Element
- (Container : in out Map;
- Position : Cursor;
- Process : not null access
- procedure (Key : Key_Type; Element : in out Element_Type));
-
procedure Move (Target : in out Map; Source : in out Map);
procedure Insert
procedure Insert
(Container : in out Map;
Key : Key_Type;
- Position : out Cursor;
- Inserted : out Boolean);
-
- procedure Insert
- (Container : in out Map;
- Key : Key_Type;
New_Item : Element_Type);
procedure Include
function Has_Element (Container : Map; Position : Cursor) return Boolean;
- procedure Iterate
- (Container : Map;
- Process :
- not null access procedure (Container : Map; Position : Cursor));
-
- procedure Reverse_Iterate
- (Container : Map;
- Process : not null access
- procedure (Container : Map; Position : Cursor));
-
function Strict_Equal (Left, Right : Map) return Boolean;
-- Strict_Equal returns True if the containers are physically equal, i.e.
-- they are structurally equal (function "=" returns True) and that they
type Map (Capacity : Count_Type) is
new Tree_Types.Tree_Type (Capacity) with null record;
- use Ada.Streams;
-
type Cursor is record
Node : Node_Access;
end record;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor);
-
- for Cursor'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor);
-
- for Cursor'Read use Read;
+ Empty_Map : constant Map := (Capacity => 0, others => <>);
No_Element : constant Cursor := (Node => 0);
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Map);
-
- for Map'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Map);
-
- for Map'Read use Read;
-
- Empty_Map : constant Map := (Capacity => 0, others => <>);
-
end Ada.Containers.Formal_Ordered_Maps;
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end if;
end Replace;
- -----------------------------------
- -- Update_Element_Preserving_Key --
- -----------------------------------
-
- procedure Update_Element_Preserving_Key
- (Container : in out Set;
- Position : Cursor;
- Process : not null access procedure (Element : in out Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor has no element";
- end if;
-
- pragma Assert (Vet (Container, Position.Node),
- "bad cursor in Update_Element_Preserving_Key");
-
- declare
- N : Tree_Types.Nodes_Type renames Container.Nodes;
-
- E : Element_Type renames N (Position.Node).Element;
- K : constant Key_Type := Key (E);
-
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- begin
- Process (E);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
-
- if Equivalent_Keys (K, Key (E)) then
- return;
- end if;
- end;
-
- declare
- X : constant Count_Type := Position.Node;
- begin
- Tree_Operations.Delete_Node_Sans_Free (Container, X);
- Formal_Ordered_Sets.Free (Container, X);
- end;
-
- raise Program_Error with "key was modified";
- end Update_Element_Preserving_Key;
-
end Generic_Keys;
-----------------
Insert (Container, New_Item, Position, Inserted);
if not Inserted then
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (set is locked)";
- end if;
-
declare
N : Tree_Types.Nodes_Type renames Container.Nodes;
begin
return Set_Ops.Set_Subset (Subset, Of_Set => Of_Set);
end Is_Subset;
- -------------
- -- Iterate --
- -------------
-
- procedure Iterate
- (Container : Set;
- Process : not null access procedure (Container : Set;
- Position : Cursor))
- is
- procedure Process_Node (Node : Count_Type);
- pragma Inline (Process_Node);
-
- procedure Local_Iterate is
- new Tree_Operations.Generic_Iteration (Process_Node);
-
- ------------------
- -- Process_Node --
- ------------------
-
- procedure Process_Node (Node : Count_Type) is
- begin
- Process (Container, (Node => Node));
- end Process_Node;
-
- -- Local variables
-
- B : Natural renames Container'Unrestricted_Access.Busy;
-
- -- Start of prccessing for Iterate
-
- begin
- B := B + 1;
-
- begin
- Local_Iterate (Container);
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Iterate;
-
----------
-- Last --
----------
"Source length exceeds Target capacity";
end if;
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
Clear (Target);
loop
Position := Previous (Container, Position);
end Previous;
- -------------------
- -- Query_Element --
- -------------------
-
- procedure Query_Element
- (Container : in out Set;
- Position : Cursor;
- Process : not null access procedure (Element : Element_Type))
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- pragma Assert (Vet (Container, Position.Node),
- "bad cursor in Query_Element");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- begin
- Process (Container.Nodes (Position.Node).Element);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Query_Element;
-
- ----------
- -- Read --
- ----------
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Set)
- is
- procedure Read_Element (Node : in out Node_Type);
- pragma Inline (Read_Element);
-
- procedure Allocate is
- new Generic_Allocate (Read_Element);
-
- procedure Read_Elements is
- new Tree_Operations.Generic_Read (Allocate);
-
- ------------------
- -- Read_Element --
- ------------------
-
- procedure Read_Element (Node : in out Node_Type) is
- begin
- Element_Type'Read (Stream, Node.Element);
- end Read_Element;
-
- -- Start of processing for Read
-
- begin
- Read_Elements (Stream, Container);
- end Read;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor)
- is
- begin
- raise Program_Error with "attempt to stream set cursor";
- end Read;
-
-------------
-- Replace --
-------------
"attempt to replace element not in set";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (set is locked)";
- end if;
-
Container.Nodes (Node).Element := New_Item;
end Replace;
null;
else
- if Tree.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (set is locked)";
- end if;
-
NN (Node).Element := Item;
return;
end if;
elsif Item < NN (Hint).Element then
if Hint = Node then
- if Tree.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (set is locked)";
- end if;
-
NN (Node).Element := Item;
return;
end if;
raise Program_Error with "attempt to replace existing element";
end if;
- Tree_Operations.Delete_Node_Sans_Free (Tree, Node); -- Checks busy-bit
+ Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
Local_Insert_With_Hint
(Tree => Tree,
Replace_Element (Container, Position.Node, New_Item);
end Replace_Element;
- ---------------------
- -- Reverse_Iterate --
- ---------------------
-
- procedure Reverse_Iterate
- (Container : Set;
- Process : not null access procedure (Container : Set;
- Position : Cursor))
- is
- procedure Process_Node (Node : Count_Type);
- pragma Inline (Process_Node);
-
- procedure Local_Reverse_Iterate is
- new Tree_Operations.Generic_Reverse_Iteration (Process_Node);
-
- ------------------
- -- Process_Node --
- ------------------
-
- procedure Process_Node (Node : Count_Type) is
- begin
- Process (Container, (Node => Node));
- end Process_Node;
-
- B : Natural renames Container'Unrestricted_Access.Busy;
-
- -- Start of processing for Reverse_Iterate
-
- begin
- B := B + 1;
-
- begin
- Local_Reverse_Iterate (Container);
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Reverse_Iterate;
-
-----------
-- Right --
-----------
end return;
end Union;
- -----------
- -- Write --
- -----------
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Set)
- is
- procedure Write_Element
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type);
- pragma Inline (Write_Element);
-
- procedure Write_Elements is
- new Tree_Operations.Generic_Write (Write_Element);
-
- -------------------
- -- Write_Element --
- -------------------
-
- procedure Write_Element
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type)
- is
- begin
- Element_Type'Write (Stream, Node.Element);
- end Write_Element;
-
- -- Start of processing for Write
-
- begin
- Write_Elements (Stream, Container);
- end Write;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor)
- is
- begin
- raise Program_Error with "attempt to stream set cursor";
- end Write;
-
end Ada.Containers.Formal_Ordered_Sets;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- See detailed specifications for these subprograms
private with Ada.Containers.Red_Black_Trees;
-private with Ada.Streams;
generic
type Element_Type is private;
Position : Cursor;
New_Item : Element_Type);
- procedure Query_Element
- (Container : in out Set;
- Position : Cursor;
- Process : not null access procedure (Element : Element_Type));
-
procedure Move (Target : in out Set; Source : in out Set);
procedure Insert
function Has_Element (Container : Set; Position : Cursor) return Boolean;
- procedure Iterate
- (Container : Set;
- Process :
- not null access procedure (Container : Set; Position : Cursor));
-
- procedure Reverse_Iterate
- (Container : Set;
- Process : not null access
- procedure (Container : Set; Position : Cursor));
-
generic
type Key_Type (<>) is private;
function Contains (Container : Set; Key : Key_Type) return Boolean;
- procedure Update_Element_Preserving_Key
- (Container : in out Set;
- Position : Cursor;
- Process : not null access
- procedure (Element : in out Element_Type));
-
end Generic_Keys;
function Strict_Equal (Left, Right : Set) return Boolean;
new Tree_Types.Tree_Type (Capacity) with null record;
use Red_Black_Trees;
- use Ada.Streams;
-
- type Set_Access is access all Set;
- for Set_Access'Storage_Size use 0;
type Cursor is record
Node : Count_Type;
end record;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor);
-
- for Cursor'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor);
-
- for Cursor'Read use Read;
-
No_Element : constant Cursor := (Node => 0);
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Set);
-
- for Set'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Set);
-
- for Set'Read use Read;
-
Empty_Set : constant Set := (Capacity => 0, others => <>);
end Ada.Containers.Formal_Ordered_Sets;
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
(Container : Vector;
Position : Count_Type) return Element_Type;
+ procedure Insert_Space
+ (Container : in out Vector;
+ Before : Extended_Index;
+ Count : Count_Type := 1);
+
---------
-- "&" --
---------
-- Capacity --
--------------
- function Capacity (Container : Vector) return Capacity_Subtype is
+ function Capacity (Container : Vector) return Count_Type is
begin
return Container.Elements'Length;
end Capacity;
procedure Clear (Container : in out Vector) is
begin
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
Container.Last := No_Index;
end Clear;
function Copy
(Source : Vector;
- Capacity : Capacity_Subtype := 0) return Vector
+ Capacity : Count_Type := 0) return Vector
is
LS : constant Count_Type := Length (Source);
- C : Capacity_Subtype;
+ C : Count_Type;
begin
if Capacity = 0 then
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
declare
I_As_Int : constant Int := Int (Index);
Old_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
Index := Int'Base (Container.Last) - Int'Base (Count);
if Index < Index_Type'Pos (Index_Type'First) then
end if;
declare
- L : constant Capacity_Subtype := Length (Container);
+ L : constant Count_Type := Length (Container);
begin
for J in Count_Type range 1 .. L - 1 loop
if Get_Element (Container, J + 1) <
-- I think we're missing this check in a-convec.adb... ???
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
I := Length (Target);
Target.Set_Length (I + Length (Source));
return;
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (vector is locked)";
- end if;
-
Sort (Container.Elements (1 .. Length (Container)));
end Sort;
-- Resolve issue of capacity vs. max index ???
end;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
declare
EA : Elements_Array renames Container.Elements;
Position := Cursor'(True, Index);
end Insert;
- procedure Insert
- (Container : in out Vector;
- Before : Extended_Index;
- Count : Count_Type := 1)
- is
- New_Item : Element_Type; -- Default-initialized value
- pragma Warnings (Off, New_Item);
-
- begin
- Insert (Container, Before, New_Item, Count);
- end Insert;
-
- procedure Insert
- (Container : in out Vector;
- Before : Cursor;
- Position : out Cursor;
- Count : Count_Type := 1)
- is
- New_Item : Element_Type; -- Default-initialized value
- pragma Warnings (Off, New_Item);
- begin
- Insert (Container, Before, New_Item, Position, Count);
- end Insert;
-
------------------
-- Insert_Space --
------------------
-- Resolve issue of capacity vs. max index ???
end;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
declare
EA : Elements_Array renames Container.Elements;
Container.Last := New_Last;
end Insert_Space;
- procedure Insert_Space
- (Container : in out Vector;
- Before : Cursor;
- Position : out Cursor;
- Count : Count_Type := 1)
- is
- Index : Index_Type'Base;
-
- begin
- if Count = 0 then
- if not Before.Valid
- or else Before.Index > Container.Last
- then
- Position := No_Element;
- else
- Position := (True, Before.Index);
- end if;
-
- return;
- end if;
-
- if not Before.Valid
- or else Before.Index > Container.Last
- then
- if Container.Last = Index_Type'Last then
- raise Constraint_Error with
- "vector is already at its maximum length";
- end if;
-
- Index := Container.Last + 1;
-
- else
- Index := Before.Index;
- end if;
-
- Insert_Space (Container, Index, Count => Count);
-
- Position := Cursor'(True, Index);
- end Insert_Space;
-
--------------
-- Is_Empty --
--------------
return Last_Index (Container) < Index_Type'First;
end Is_Empty;
- -------------
- -- Iterate --
- -------------
-
- procedure Iterate
- (Container : Vector;
- Process :
- not null access procedure (Container : Vector; Position : Cursor))
- is
- V : Vector renames Container'Unrestricted_Access.all;
- B : Natural renames V.Busy;
-
- begin
- B := B + 1;
-
- begin
- for Indx in Index_Type'First .. Last_Index (Container) loop
- Process (Container, Cursor'(True, Indx));
- end loop;
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Iterate;
-
----------
-- Last --
----------
-- Length --
------------
- function Length (Container : Vector) return Capacity_Subtype is
+ function Length (Container : Vector) return Count_Type is
L : constant Int := Int (Last_Index (Container));
F : constant Int := Int (Index_Type'First);
N : constant Int'Base := L - F + 1;
begin
- return Capacity_Subtype (N);
+ return Count_Type (N);
end Length;
----------
return;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (Target is busy)";
- end if;
-
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (Source is busy)";
- end if;
-
if N > Target.Capacity then
raise Constraint_Error with -- correct exception here???
"length of Source is greater than capacity of Target";
return No_Element;
end Previous;
- -------------------
- -- Query_Element --
- -------------------
-
- procedure Query_Element
- (Container : Vector;
- Index : Index_Type;
- Process : not null access procedure (Element : Element_Type))
- is
- V : Vector renames Container'Unrestricted_Access.all;
- B : Natural renames V.Busy;
- L : Natural renames V.Lock;
-
- begin
- if Index > Last_Index (Container) then
- raise Constraint_Error with "Index is out of range";
- end if;
-
- B := B + 1;
- L := L + 1;
-
- declare
- II : constant Int'Base := Int (Index) - Int (No_Index);
- I : constant Count_Type := Count_Type (II);
-
- begin
- Process (Get_Element (V, I));
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end Query_Element;
-
- procedure Query_Element
- (Container : Vector;
- Position : Cursor;
- Process : not null access procedure (Element : Element_Type))
- is
- begin
- if not Position.Valid then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- Query_Element (Container, Position.Index, Process);
- end Query_Element;
-
- ----------
- -- Read --
- ----------
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Vector)
- is
- Length : Count_Type'Base;
- Last : Index_Type'Base := No_Index;
-
- begin
- Clear (Container);
-
- Count_Type'Base'Read (Stream, Length);
-
- if Length < 0 then
- raise Program_Error with "stream appears to be corrupt";
- end if;
-
- if Length > Container.Capacity then
- raise Storage_Error with "not enough capacity"; -- ???
- end if;
-
- for J in Count_Type range 1 .. Length loop
- Last := Last + 1;
- Element_Type'Read (Stream, Container.Elements (J));
- Container.Last := Last;
- end loop;
- end Read;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Position : out Cursor)
- is
- begin
- raise Program_Error with "attempt to stream vector cursor";
- end Read;
-
---------------------
-- Replace_Element --
---------------------
raise Constraint_Error with "Index is out of range";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (vector is locked)";
- end if;
-
declare
II : constant Int'Base := Int (Index) - Int (No_Index);
I : constant Count_Type := Count_Type (II);
raise Constraint_Error with "Position cursor is out of range";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (vector is locked)";
- end if;
-
declare
II : constant Int'Base := Int (Position.Index) - Int (No_Index);
I : constant Count_Type := Count_Type (II);
procedure Reserve_Capacity
(Container : in out Vector;
- Capacity : Capacity_Subtype)
+ Capacity : Count_Type)
is
begin
if Capacity > Container.Capacity then
- raise Constraint_Error; -- ???
+ raise Constraint_Error with "Capacity is out of range";
end if;
end Reserve_Capacity;
return;
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (vector is locked)";
- end if;
-
declare
I, J : Count_Type;
E : Elements_Array renames Container.Elements;
return No_Index;
end Reverse_Find_Index;
- ---------------------
- -- Reverse_Iterate --
- ---------------------
-
- procedure Reverse_Iterate
- (Container : Vector;
- Process : not null access procedure (Container : Vector;
- Position : Cursor))
- is
- V : Vector renames Container'Unrestricted_Access.all;
- B : Natural renames V.Busy;
-
- begin
- B := B + 1;
-
- begin
- for Indx in reverse Index_Type'First .. Last_Index (Container) loop
- Process (Container, Cursor'(True, Indx));
- end loop;
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Reverse_Iterate;
-
-----------
-- Right --
-----------
procedure Set_Length
(Container : in out Vector;
- Length : Capacity_Subtype)
+ Length : Count_Type)
is
begin
if Length = Formal_Vectors.Length (Container) then
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (vector is busy)";
- end if;
-
if Length > Container.Capacity then
raise Constraint_Error; -- ???
end if;
return;
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (vector is locked)";
- end if;
-
declare
II : constant Int'Base := Int (I) - Int (No_Index);
JJ : constant Int'Base := Int (J) - Int (No_Index);
-- To_Vector --
---------------
- function To_Vector (Length : Capacity_Subtype) return Vector is
- begin
- if Length = 0 then
- return Empty_Vector;
- end if;
-
- declare
- First : constant Int := Int (Index_Type'First);
- Last_As_Int : constant Int'Base := First + Int (Length) - 1;
- Last : Index_Type;
-
- begin
- if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
- raise Constraint_Error with "Length is out of range"; -- ???
- end if;
-
- Last := Index_Type (Last_As_Int);
-
- return (Length, (others => <>), Last => Last,
- others => <>);
- end;
- end To_Vector;
-
function To_Vector
(New_Item : Element_Type;
- Length : Capacity_Subtype) return Vector
+ Length : Count_Type) return Vector
is
begin
if Length = 0 then
end;
end To_Vector;
- --------------------
- -- Update_Element --
- --------------------
-
- procedure Update_Element
- (Container : in out Vector;
- Index : Index_Type;
- Process : not null access procedure (Element : in out Element_Type))
- is
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- if Index > Container.Last then
- raise Constraint_Error with "Index is out of range";
- end if;
-
- B := B + 1;
- L := L + 1;
-
- declare
- II : constant Int'Base := Int (Index) - Int (No_Index);
- I : constant Count_Type := Count_Type (II);
-
- begin
- Process (Container.Elements (I));
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end Update_Element;
-
- procedure Update_Element
- (Container : in out Vector;
- Position : Cursor;
- Process : not null access procedure (Element : in out Element_Type))
- is
- begin
- if not Position.Valid then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- Update_Element (Container, Position.Index, Process);
- end Update_Element;
-
- -----------
- -- Write --
- -----------
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Vector)
- is
- begin
- Count_Type'Base'Write (Stream, Length (Container));
-
- for J in 1 .. Length (Container) loop
- Element_Type'Write (Stream, Container.Elements (J));
- end loop;
- end Write;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Position : Cursor)
- is
- begin
- raise Program_Error with "attempt to stream vector cursor";
- end Write;
-
end Ada.Containers.Formal_Vectors;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- iterate over containers. Left returns the part of the container already
-- scanned and Right the part not scanned yet.
-private with Ada.Streams;
with Ada.Containers;
use Ada.Containers;
range Index_Type'First - 1 ..
Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
- -- ??? i don't think we can do this...
- -- TODO: we need the ARG to either figure out how to declare this subtype,
- -- or eliminate the requirement that it be present.
- -- subtype Capacity_Subtype is Count_Type -- correct name???
- -- range 0 .. Count_Type'Max (0,
- -- Index_Type'Pos (Index_Type'Last) -
- -- Index_Type'Pos (Index_Type'First) + 1);
- --
- -- so for now:
- subtype Capacity_Subtype is Count_Type;
-
No_Index : constant Extended_Index := Extended_Index'First;
- type Vector (Capacity : Capacity_Subtype) is tagged private;
- -- pragma Preelaborable_Initialization (Vector);
+ type Vector (Capacity : Count_Type) is tagged private;
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
function "=" (Left, Right : Vector) return Boolean;
- function To_Vector (Length : Capacity_Subtype) return Vector;
-
function To_Vector
(New_Item : Element_Type;
- Length : Capacity_Subtype) return Vector;
+ Length : Count_Type) return Vector;
function "&" (Left, Right : Vector) return Vector;
function "&" (Left, Right : Element_Type) return Vector;
- function Capacity (Container : Vector) return Capacity_Subtype;
+ function Capacity (Container : Vector) return Count_Type;
procedure Reserve_Capacity
(Container : in out Vector;
- Capacity : Capacity_Subtype);
+ Capacity : Count_Type);
- function Length (Container : Vector) return Capacity_Subtype;
+ function Length (Container : Vector) return Count_Type;
procedure Set_Length
(Container : in out Vector;
- Length : Capacity_Subtype);
+ Length : Count_Type);
function Is_Empty (Container : Vector) return Boolean;
function Copy
(Source : Vector;
- Capacity : Capacity_Subtype := 0) return Vector;
+ Capacity : Count_Type := 0) return Vector;
function To_Cursor
(Container : Vector;
Position : Cursor;
New_Item : Element_Type);
- procedure Query_Element
- (Container : Vector;
- Index : Index_Type;
- Process : not null access procedure (Element : Element_Type));
-
- procedure Query_Element
- (Container : Vector;
- Position : Cursor;
- Process : not null access procedure (Element : Element_Type));
-
- procedure Update_Element
- (Container : in out Vector;
- Index : Index_Type;
- Process : not null access procedure (Element : in out Element_Type));
-
- procedure Update_Element
- (Container : in out Vector;
- Position : Cursor;
- Process : not null access procedure (Element : in out Element_Type));
-
procedure Move (Target : in out Vector; Source : in out Vector);
procedure Insert
Position : out Cursor;
Count : Count_Type := 1);
- procedure Insert
- (Container : in out Vector;
- Before : Extended_Index;
- Count : Count_Type := 1);
-
- procedure Insert
- (Container : in out Vector;
- Before : Cursor;
- Position : out Cursor;
- Count : Count_Type := 1);
-
procedure Prepend
(Container : in out Vector;
New_Item : Vector);
New_Item : Element_Type;
Count : Count_Type := 1);
- procedure Insert_Space
- (Container : in out Vector;
- Before : Extended_Index;
- Count : Count_Type := 1);
-
- procedure Insert_Space
- (Container : in out Vector;
- Before : Cursor;
- Position : out Cursor;
- Count : Count_Type := 1);
-
procedure Delete
(Container : in out Vector;
Index : Extended_Index;
function Has_Element (Container : Vector; Position : Cursor) return Boolean;
- procedure Iterate
- (Container : Vector;
- Process : not null access
- procedure (Container : Vector; Position : Cursor));
-
- procedure Reverse_Iterate
- (Container : Vector;
- Process : not null access
- procedure (Container : Vector; Position : Cursor));
-
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
pragma Inline (Element);
pragma Inline (First_Element);
pragma Inline (Last_Element);
- pragma Inline (Query_Element);
- pragma Inline (Update_Element);
pragma Inline (Replace_Element);
pragma Inline (Contains);
pragma Inline (Next);
type Elements_Array is array (Count_Type range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
- type Vector (Capacity : Capacity_Subtype) is tagged record
+ type Vector (Capacity : Count_Type) is tagged record
Elements : Elements_Array (1 .. Capacity);
Last : Extended_Index := No_Index;
- Busy : Natural := 0;
- Lock : Natural := 0;
end record;
- use Ada.Streams;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Container : Vector);
-
- for Vector'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Container : out Vector);
-
- for Vector'Read use Read;
-
type Cursor is record
Valid : Boolean := True;
Index : Index_Type := Index_Type'First;
end record;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Position : Cursor);
-
- for Cursor'Write use Write;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Position : out Cursor);
-
- for Cursor'Read use Read;
-
Empty_Vector : constant Vector := (Capacity => 0, others => <>);
No_Element : constant Cursor := (Valid => False, Index => Index_Type'First);
-- Here for normal case of predicate active
else
- -- If the type has a static predicate and the expression is also
- -- static, see if the expression satisfies the predicate.
+ -- If the type has a static predicate and the expression is known
+ -- at compile time, see if the expression satisfies the predicate.
Check_Expression_Against_Static_Predicate (N, Typ);
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
- -- In Ada 2005 (or later) if we have the standard nondefault
- -- bit order, then we return the original value as given in
- -- the component clause (RM 2005 13.5.2(3/2)).
+ -- In Ada 2005 (or later) if we have the non-default bit order, then
+ -- we return the original value as given in the component clause
+ -- (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
- and then not Reverse_Bit_Order (Scope (CE))
+ and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (First_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
- -- Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
+ -- Otherwise (Ada 83/95 or Ada 2005 or later with default bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE) then
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
- -- In Ada 2005 (or later) if we have the standard nondefault
- -- bit order, then we return the original value as given in
- -- the component clause (RM 2005 13.5.2(4/2)).
+ -- In Ada 2005 (or later) if we have the non-default bit order, then
+ -- we return the original value as given in the component clause
+ -- (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
- and then not Reverse_Bit_Order (Scope (CE))
+ and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Last_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
- -- Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
+ -- Otherwise (Ada 83/95 or Ada 2005 or later with default bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE)
begin
if Present (Component_Clause (CE)) then
- -- In Ada 2005 (or later) if we have the standard nondefault
- -- bit order, then we return the original value as given in
- -- the component clause (RM 2005 13.5.2(2/2)).
+ -- In Ada 2005 (or later) if we have the non-default bit order,
+ -- then we return the original value as given in the component
+ -- clause (RM 2005 13.5.2(2/2)).
if Ada_Version >= Ada_2005
- and then not Reverse_Bit_Order (Scope (CE))
+ and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Position (Component_Clause (CE)))));
- -- Otherwise (Ada 83 or 95, or reverse bit order specified in
+ -- Otherwise (Ada 83 or 95, or default bit order specified in
-- later Ada version), return the normalized value.
else
or else
Is_Partially_Initialized_Type (T, Include_Implicit => False))
then
- -- If the type has a static predicate and the expression is also
- -- static, see if the expression satisfies the predicate.
+ -- If the type has a static predicate and the expression is known at
+ -- compile time, see if the expression satisfies the predicate.
if Present (E) then
Check_Expression_Against_Static_Predicate (E, T);
if Is_String_Type (T) and then not Constant_Present (N) then
Check_SPARK_Restriction
- ("declaration of object of unconstrained type not allowed",
- N);
+ ("declaration of object of unconstrained type not allowed", N);
end if;
-- Nothing to do in deferred constant case
Check_Duplicates : Boolean := False) return Node_Id;
-- Find the declaration of the related subprogram subject to pragma Prag.
-- If flag Check_Duplicates is set, the routine emits errors concerning
- -- duplicate pragmas.
+ -- duplicate pragmas. If a related subprogram is found, then either the
+ -- corresponding N_Subprogram_Declaration node is returned, or, if the
+ -- pragma applies to a subprogram body, then the N_Subprogram_Body node
+ -- is returned. Note that in the latter case, no check is made to ensure
+ -- that there is no separate declaration of the subprogram.
function Get_Base_Subprogram (Def_Id : Entity_Id) return Entity_Id;
-- If Def_Id refers to a renamed subprogram, then the base subprogram (the
begin
GNAT_Pragma;
- S14_Pragma;
Check_Arg_Count (1);
-- Ensure the proper placement of the pragma. Contract_Cases must
is
Context : constant Node_Id := Parent (Prag);
Nam : constant Name_Id := Pragma_Name (Prag);
- Decl : Node_Id;
+ Elmt : Node_Id;
Subp_Decl : Node_Id;
begin
- -- The pragma is a byproduct of an aspect
+ pragma Assert (Nkind (Prag) = N_Pragma);
+
+ -- If the pragma comes from an aspect, then what we want is the
+ -- declaration to which the aspect is attached, i.e. its parent.
if Present (Corresponding_Aspect (Prag)) then
- Subp_Decl := Parent (Corresponding_Aspect (Prag));
+ return Parent (Corresponding_Aspect (Prag));
+ end if;
- -- The pragma is associated with a library-level subprogram
+ -- Otherwise the pragma must be a list element, and the first thing to
+ -- do is to position past any previous pragmas or generated code. What
+ -- we are doing here is looking for the preceding declaration. This is
+ -- also where we will check for a duplicate pragma.
- elsif Nkind (Context) = N_Compilation_Unit_Aux then
- Subp_Decl := Unit (Parent (Context));
+ pragma Assert (Is_List_Member (Prag));
- -- The pragma appears inside the declarative part of a subprogram body
+ Elmt := Prag;
+ loop
+ Elmt := Prev (Elmt);
+ exit when No (Elmt);
- elsif Nkind (Context) = N_Subprogram_Body then
- Subp_Decl := Context;
+ -- Typically want we will want is the declaration original node. But
+ -- for the generic subprogram case, don't go to to the original node,
+ -- which is the unanalyzed tree: we need to attach the pre- and post-
+ -- conditions to the analyzed version at this point. They propagate
+ -- to the original tree when analyzing the corresponding body.
- -- The pragma appears someplace after its related subprogram. Inspect
- -- all previous declarations for a suitable candidate.
+ if Nkind (Elmt) not in N_Generic_Declaration then
+ Subp_Decl := Original_Node (Elmt);
+ else
+ Subp_Decl := Elmt;
+ end if;
- else
- Decl := Prag;
- Subp_Decl := Empty;
- while Present (Prev (Decl)) loop
- Decl := Prev (Decl);
+ -- Skip prior pragmas
- if Nkind (Decl) in N_Generic_Declaration then
- Subp_Decl := Decl;
- else
- Subp_Decl := Original_Node (Decl);
+ if Nkind (Subp_Decl) = N_Pragma then
+ if Check_Duplicates and then Pragma_Name (Subp_Decl) = Nam then
+ Error_Msg_Name_1 := Nam;
+ Error_Msg_Sloc := Sloc (Subp_Decl);
+ Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
end if;
- -- Skip prior pragmas
+ -- Skip internally generated code
- if Nkind (Subp_Decl) = N_Pragma then
- if Check_Duplicates and then Pragma_Name (Subp_Decl) = Nam then
- Error_Msg_Name_1 := Nam;
- Error_Msg_Sloc := Sloc (Subp_Decl);
- Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
- end if;
+ elsif not Comes_From_Source (Subp_Decl) then
+ null;
- -- Skip internally generated code
+ -- Otherwise we have a declaration to return
- elsif not Comes_From_Source (Subp_Decl) then
- null;
+ else
+ return Subp_Decl;
+ end if;
+ end loop;
- -- The nearest preceding declaration is the related subprogram
+ -- We fell through, which means there was no declaration preceding the
+ -- pragma (either it was the first element of the list, or we only had
+ -- other pragmas and generated code before it).
- else
- exit;
- end if;
- end loop;
- end if;
+ -- The pragma is associated with a library-level subprogram
+
+ if Nkind (Context) = N_Compilation_Unit_Aux then
+ return Unit (Parent (Context));
- return Subp_Decl;
+ -- The pragma appears inside the declarative part of a subprogram body
+
+ elsif Nkind (Context) = N_Subprogram_Body then
+ return Context;
+
+ -- Otherwise no subprogram found, return original pragma
+
+ else
+ return Prag;
+ end if;
end Find_Related_Subprogram;
-------------------------
Typ : Entity_Id)
is
begin
- -- When both the predicate and the expression are static, evaluate the
- -- check at compile time. A type becomes non-static when it has aspect
- -- Dynamic_Predicate.
+ -- When the predicate is static and the value of the expression is known
+ -- at compile time, evaluate the predicate check. A type is non-static
+ -- when it has aspect Dynamic_Predicate.
- if Is_OK_Static_Expression (Expr)
+ if Compile_Time_Known_Value (Expr)
and then Has_Predicates (Typ)
and then Present (Static_Predicate (Typ))
and then not Has_Dynamic_Predicate_Aspect (Typ)
(Expr : Node_Id;
Typ : Entity_Id);
-- Determine whether an arbitrary expression satisfies the static predicate
- -- of a type. The routine does nothing if Expr is non-static or Typ lacks a
- -- static predicate, otherwise it may emit a warning if the expression is
- -- prohibited by the predicate.
+ -- of a type. The routine does nothing if Expr is not known at compile time
+ -- or Typ lacks a static predicate, otherwise it may emit a warning if the
+ -- expression is prohibited by the predicate.
procedure Check_Fully_Declared (T : Entity_Id; N : Node_Id);
-- Verify that the full declaration of type T has been seen. If not, place
projects / platform / upstream / linaro-gcc.git / commitdiff