Skip to content

R
riscv-gcc-1
Commit 9686dbc7 by Arnaud Charlet
Options

[multiple changes] 

2013-04-12  Robert Dewar  <dewar@adacore.com>

	* sem.ads, opt.ads: Minor comment edits.
	* sem_warn.adb, sem_ch6.adb: Minor reformatting.

2013-04-12  Claire Dross  <dross@adacore.com>

	* a-cfdlli.adb a-cfdlli.ads (List, Not_No_Element, Iterate,
	Reverse_Iterate, Query_Element, Update_Element, Read, Write): Removed,
	not suitable for formal analysis.

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Abstract_State): Use Defining entity
	to locate package entity, which may be a child unit.

2013-04-12  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb, g-socket.ads (Connect_Socket, version with timeout): If
	the specified timeout is 0, do not attempt to determine whether the
	connection succeeded.

2013-04-12  Doug Rupp  <rupp@adacore.com>

	* s-fileio.adb (Form_RMS Context_Key): Fix some thinkos.

From-SVN: r197904
parent 7a1f094d
Showing with 70 additions and 605 deletions
gcc/ada/ChangeLog
2013-04-12 Robert Dewar <dewar@adacore.com>
* sem.ads, opt.ads: Minor comment edits.
* sem_warn.adb, sem_ch6.adb: Minor reformatting.
2013-04-12 Claire Dross <dross@adacore.com>
* a-cfdlli.adb a-cfdlli.ads (List, Not_No_Element, Iterate,
Reverse_Iterate, Query_Element, Update_Element, Read, Write): Removed,
not suitable for formal analysis.
2013-04-12 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Abstract_State): Use Defining entity
to locate package entity, which may be a child unit.
2013-04-12 Thomas Quinot <quinot@adacore.com>
* g-socket.adb, g-socket.ads (Connect_Socket, version with timeout): If
the specified timeout is 0, do not attempt to determine whether the
connection succeeded.
2013-04-12 Doug Rupp <rupp@adacore.com>
* s-fileio.adb (Form_RMS Context_Key): Fix some thinkos.
2013-04-12 Doug Rupp <rupp@adacore.com> 2013-04-12 Doug Rupp <rupp@adacore.com>
* s-fileio.adb: Minor reformatting. * s-fileio.adb: Minor reformatting.
......
gcc/ada/a-cfdlli.adb
...@@ -176,8 +176,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -176,8 +176,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
if Container.Length = 0 then if Container.Length = 0 then
pragma Assert (Container.First = 0); pragma Assert (Container.First = 0);
pragma Assert (Container.Last = 0); pragma Assert (Container.Last = 0);
pragma Assert (Container.Busy = 0);
pragma Assert (Container.Lock = 0);
return; return;
end if; end if;
...@@ -186,11 +184,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -186,11 +184,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.First).Prev = 0);
pragma Assert (N (Container.Last).Next = 0); pragma Assert (N (Container.Last).Next = 0);
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
while Container.Length > 1 loop while Container.Length > 1 loop
X := Container.First; X := Container.First;
...@@ -297,11 +290,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -297,11 +290,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return; return;
end if; end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
for Index in 1 .. Count loop for Index in 1 .. Count loop
pragma Assert (Container.Length >= 2); pragma Assert (Container.Length >= 2);
...@@ -350,11 +338,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -350,11 +338,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return; return;
end if; end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
for J in 1 .. Count loop for J in 1 .. Count loop
X := Container.First; X := Container.First;
pragma Assert (N (N (X).Next).Prev = Container.First); pragma Assert (N (N (X).Next).Prev = Container.First);
...@@ -389,11 +372,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -389,11 +372,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return; return;
end if; end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
for J in 1 .. Count loop for J in 1 .. Count loop
X := Container.Last; X := Container.Last;
pragma Assert (N (N (X).Prev).Next = Container.Last); pragma Assert (N (N (X).Prev).Next = Container.Last);
...@@ -424,21 +402,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -424,21 +402,6 @@ 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 --
---------- ----------
...@@ -490,28 +453,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -490,28 +453,6 @@ 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 --
------------------- -------------------
...@@ -613,16 +554,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -613,16 +554,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return; return;
end if; end if;
if Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
end if;
if Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
end if;
LI := First (Target); LI := First (Target);
RI := First (Source); RI := First (Source);
while RI.Node /= 0 loop while RI.Node /= 0 loop
...@@ -739,11 +670,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -739,11 +670,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.First).Prev = 0);
pragma Assert (N (Container.Last).Next = 0); pragma Assert (N (Container.Last).Next = 0);
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
Sort (Front => 0, Back => 0); Sort (Front => 0, Back => 0);
pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.First).Prev = 0);
...@@ -792,11 +718,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -792,11 +718,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Constraint_Error with "new length exceeds capacity"; raise Constraint_Error with "new length exceeds capacity";
end if; end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
Allocate (Container, New_Item, New_Node => J); Allocate (Container, New_Item, New_Node => J);
Insert_Internal (Container, Before.Node, New_Node => J); Insert_Internal (Container, Before.Node, New_Node => J);
Position := (Node => J); Position := (Node => J);
...@@ -840,11 +761,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -840,11 +761,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Constraint_Error with "new length exceeds capacity"; raise Constraint_Error with "new length exceeds capacity";
end if; end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
Allocate (Container, New_Node => J); Allocate (Container, New_Node => J);
Insert_Internal (Container, Before.Node, New_Node => J); Insert_Internal (Container, Before.Node, New_Node => J);
Position := (Node => J); Position := (Node => J);
...@@ -919,103 +835,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -919,103 +835,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return Length (Container) = 0; return Length (Container) = 0;
end Is_Empty; end Is_Empty;
-------------
-- Iterate --
-------------
procedure Iterate
(Container : List;
Process :
not null access procedure (Container : List; Position : Cursor))
is
C : List renames Container'Unrestricted_Access.all;
B : Natural renames C.Busy;
Node : Count_Type;
begin
B := B + 1;
begin
Node := Container.First;
while Node /= 0 loop
Process (Container, (Node => Node));
Node := Container.Nodes (Node).Next;
end loop;
exception
when others =>
B := B - 1;
raise;
end;
B := B - 1;
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 --
---------- ----------
...@@ -1028,28 +847,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1028,28 +847,6 @@ 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 --
------------------ ------------------
...@@ -1121,11 +918,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1121,11 +918,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
"Source length exceeds Target capacity"; "Source length exceeds Target capacity";
end if; 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); Clear (Target);
while Source.Length > 1 loop while Source.Length > 1 loop
...@@ -1208,23 +1000,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1208,23 +1000,6 @@ 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 --
------------- -------------
...@@ -1260,106 +1035,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1260,106 +1035,6 @@ 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 --
-------------------
procedure Query_Element
(Container : List; Position : Cursor;
Process : not null access procedure (Element : Element_Type))
is
C : List renames Container'Unrestricted_Access.all;
B : Natural renames C.Busy;
L : Natural renames C.Lock;
begin
if not Has_Element (Container, Position) then
raise Constraint_Error with
"Position cursor has no element";
end if;
B := B + 1;
L := L + 1;
declare
N : Node_Type renames C.Nodes (Position.Node);
begin
Process (N.Element);
exception
when others =>
L := L - 1;
B := B - 1;
raise;
end;
L := L - 1;
B := B - 1;
end Query_Element;
----------
-- Read --
----------
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out List)
is
N : Count_Type'Base;
begin
Clear (Item);
Count_Type'Base'Read (Stream, N);
if N < 0 then
raise Program_Error with "bad list length";
end if;
if N = 0 then
return;
end if;
if N > Item.Capacity then
raise Constraint_Error with "length exceeds capacity";
end if;
for J in 1 .. N loop
Item.Append (Element_Type'Input (Stream)); -- ???
end loop;
end Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error with "attempt to stream list cursor";
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 --
--------------------- ---------------------
...@@ -1374,11 +1049,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1374,11 +1049,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Constraint_Error with "Position cursor has no element"; raise Constraint_Error with "Position cursor has no element";
end if; end if;
if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is locked)";
end if;
pragma Assert pragma Assert
(Vet (Container, Position), "bad cursor in Replace_Element"); (Vet (Container, Position), "bad cursor in Replace_Element");
...@@ -1444,11 +1114,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1444,11 +1114,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.First).Prev = 0);
pragma Assert (N (Container.Last).Next = 0); pragma Assert (N (Container.Last).Next = 0);
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
Container.First := J; Container.First := J;
Container.Last := I; Container.Last := I;
loop loop
...@@ -1503,39 +1168,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1503,39 +1168,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return No_Element; return No_Element;
end Reverse_Find; end Reverse_Find;
---------------------
-- Reverse_Iterate --
---------------------
procedure Reverse_Iterate
(Container : List;
Process :
not null access procedure (Container : List; Position : Cursor))
is
C : List renames Container'Unrestricted_Access.all;
B : Natural renames C.Busy;
Node : Count_Type;
begin
B := B + 1;
begin
Node := Container.Last;
while Node /= 0 loop
Process (Container, (Node => Node));
Node := Container.Nodes (Node).Prev;
end loop;
exception
when others =>
B := B - 1;
raise;
end;
B := B - 1;
end Reverse_Iterate;
----------- -----------
-- Right -- -- Right --
----------- -----------
...@@ -1597,16 +1229,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1597,16 +1229,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
end if;
if Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
end if;
loop loop
Insert (Target, Before, SN (Source.Last).Element); Insert (Target, Before, SN (Source.Last).Element);
Delete_Last (Source); Delete_Last (Source);
...@@ -1638,16 +1260,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1638,16 +1260,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
end if;
if Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
end if;
Insert Insert
(Container => Target, (Container => Target,
Before => Before, Before => Before,
...@@ -1686,11 +1298,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1686,11 +1298,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Assert (Container.Length >= 2); pragma Assert (Container.Length >= 2);
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
if Before.Node = 0 then if Before.Node = 0 then
pragma Assert (Position.Node /= Container.Last); pragma Assert (Position.Node /= Container.Last);
...@@ -1800,11 +1407,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1800,11 +1407,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return; return;
end if; end if;
if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is locked)";
end if;
pragma Assert (Vet (Container, I), "bad I cursor in Swap"); pragma Assert (Vet (Container, I), "bad I cursor in Swap");
pragma Assert (Vet (Container, J), "bad J cursor in Swap"); pragma Assert (Vet (Container, J), "bad J cursor in Swap");
...@@ -1844,11 +1446,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1844,11 +1446,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return; return;
end if; end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (list is busy)";
end if;
pragma Assert (Vet (Container, I), "bad I cursor in Swap_Links"); pragma Assert (Vet (Container, I), "bad I cursor in Swap_Links");
pragma Assert (Vet (Container, J), "bad J cursor in Swap_Links"); pragma Assert (Vet (Container, J), "bad J cursor in Swap_Links");
...@@ -1871,47 +1468,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -1871,47 +1468,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
end if; end if;
end Swap_Links; end Swap_Links;
--------------------
-- Update_Element --
--------------------
procedure Update_Element
(Container : in out List;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type))
is
begin
if Position.Node = 0 then
raise Constraint_Error with "Position cursor 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);
begin
Process (N.Element);
exception
when others =>
L := L - 1;
B := B - 1;
raise;
end;
L := L - 1;
B := B - 1;
end;
end Update_Element;
--------- ---------
-- Vet -- -- Vet --
--------- ---------
...@@ -2047,33 +1603,4 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -2047,33 +1603,4 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
return True; return True;
end Vet; end Vet;
-----------
-- Write --
-----------
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : List)
is
N : Node_Array renames Item.Nodes;
Node : Count_Type;
begin
Count_Type'Base'Write (Stream, Item.Length);
Node := Item.First;
while Node /= 0 loop
Element_Type'Write (Stream, N (Node).Element);
Node := N (Node).Next;
end loop;
end Write;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error with "attempt to stream list cursor";
end Write;
end Ada.Containers.Formal_Doubly_Linked_Lists; end Ada.Containers.Formal_Doubly_Linked_Lists;
gcc/ada/a-cfdlli.ads
...@@ -51,9 +51,9 @@ ...@@ -51,9 +51,9 @@
-- See detailed specifications for these subprograms -- See detailed specifications for these subprograms
private with Ada.Streams; -- private with Ada.Streams;
private with Ada.Finalization; -- private with Ada.Finalization;
with Ada.Iterator_Interfaces; -- with Ada.Iterator_Interfaces;
generic generic
type Element_Type is private; type Element_Type is private;
...@@ -64,11 +64,8 @@ generic ...@@ -64,11 +64,8 @@ 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 with type List (Capacity : Count_Type) is private;
Constant_Indexing => Constant_Reference, pragma Preelaborable_Initialization (List);
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
-- pragma Preelaborable_Initialization (List);
type Cursor is private; type Cursor is private;
pragma Preelaborable_Initialization (Cursor); pragma Preelaborable_Initialization (Cursor);
...@@ -77,17 +74,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -77,17 +74,6 @@ 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;
...@@ -107,15 +93,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -107,15 +93,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
Position : Cursor; Position : Cursor;
New_Item : Element_Type); New_Item : Element_Type);
procedure Query_Element
(Container : List; Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Update_Element
(Container : in out List;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Move (Target : in out List; Source : in out List); procedure Move (Target : in out List; Source : in out List);
procedure Insert procedure Insert
...@@ -218,16 +195,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -218,16 +195,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
function Has_Element (Container : List; Position : Cursor) return Boolean; function Has_Element (Container : List; Position : Cursor) return Boolean;
procedure Iterate
(Container : List;
Process :
not null access procedure (Container : List; Position : Cursor));
procedure Reverse_Iterate
(Container : List;
Process :
not null access procedure (Container : List; Position : Cursor));
generic generic
with function "<" (Left, Right : Element_Type) return Boolean is <>; with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is package Generic_Sorting is
...@@ -240,15 +207,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is ...@@ -240,15 +207,6 @@ 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; -- SHOULD BE ALIASED ???
Position : Cursor) 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
...@@ -268,7 +226,7 @@ private ...@@ -268,7 +226,7 @@ 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 : aliased Element_Type; Element : Element_Type;
end record; end record;
function "=" (L, R : Node_Type) return Boolean is abstract; function "=" (L, R : Node_Type) return Boolean is abstract;
...@@ -279,73 +237,17 @@ private ...@@ -279,73 +237,17 @@ private
type List (Capacity : Count_Type) is tagged record type List (Capacity : Count_Type) is tagged record
Nodes : Node_Array (1 .. Capacity) := (others => <>); Nodes : Node_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1; Free : Count_Type'Base := -1;
Busy : Natural := 0;
Lock : Natural := 0;
Length : Count_Type := 0; Length : Count_Type := 0;
First : Count_Type := 0; First : Count_Type := 0;
Last : Count_Type := 0; Last : Count_Type := 0;
end record; end record;
use Ada.Streams;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out List);
for List'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : List);
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;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is null 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_List : constant List := (0, others => <>); Empty_List : constant List := (0, others => <>);
No_Element : constant Cursor := (Node => 0); No_Element : constant Cursor := (Node => 0);
use Ada.Finalization;
type Iterator is new 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;
end Ada.Containers.Formal_Doubly_Linked_Lists; end Ada.Containers.Formal_Doubly_Linked_Lists;
gcc/ada/g-socket.adb
...@@ -516,10 +516,6 @@ package body GNAT.Sockets is ...@@ -516,10 +516,6 @@ package body GNAT.Sockets is
(Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout); (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
end Check_Selector; end Check_Selector;
--------------------
-- Check_Selector --
--------------------
procedure Check_Selector procedure Check_Selector
(Selector : Selector_Type; (Selector : Selector_Type;
R_Socket_Set : in out Socket_Set_Type; R_Socket_Set : in out Socket_Set_Type;
...@@ -739,12 +735,17 @@ package body GNAT.Sockets is ...@@ -739,12 +735,17 @@ package body GNAT.Sockets is
-- Wait for socket to become available for writing -- Wait for socket to become available for writing
Wait_On_Socket if Timeout = 0.0 then
(Socket => Socket, Status := Expired;
For_Read => False,
Timeout => Timeout, else
Selector => Selector, Wait_On_Socket
Status => Status); (Socket => Socket,
For_Read => False,
Timeout => Timeout,
Selector => Selector,
Status => Status);
end if;
-- Check error condition (the asynchronous connect may have terminated -- Check error condition (the asynchronous connect may have terminated
-- with an error, e.g. ECONNREFUSED) if select(2) completed. -- with an error, e.g. ECONNREFUSED) if select(2) completed.
......
gcc/ada/g-socket.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2011, AdaCore -- -- Copyright (C) 2001-2013, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -858,7 +858,9 @@ package GNAT.Sockets is ...@@ -858,7 +858,9 @@ package GNAT.Sockets is
-- whether the operation completed successfully, timed out, or was aborted. -- whether the operation completed successfully, timed out, or was aborted.
-- If Selector is not null, the designated selector is used to wait for the -- If Selector is not null, the designated selector is used to wait for the
-- socket to become available, else a private selector object is created -- socket to become available, else a private selector object is created
-- by this procedure and destroyed before it returns. -- by this procedure and destroyed before it returns. If Timeout is 0.0,
-- no attempt is made to detect whether the connection has succeeded; it
-- is up to the user to determine this using Check_Selector later on.
procedure Control_Socket procedure Control_Socket
(Socket : Socket_Type; (Socket : Socket_Type;
......
gcc/ada/opt.ads
...@@ -597,7 +597,7 @@ package Opt is ...@@ -597,7 +597,7 @@ package Opt is
Fast_Math : Boolean := False; Fast_Math : Boolean := False;
-- GNAT -- GNAT
-- Indicates the current setting of Fast_Math mode, as set by the use -- Indicates the current setting of Fast_Math mode, as set by the use
-- of a Fast_Math pragma (set on by Fast_Math (On)). -- of a Fast_Math pragma (set True by Fast_Math (On)).
Float_Format : Character := ' '; Float_Format : Character := ' ';
-- GNAT -- GNAT
...@@ -1274,8 +1274,8 @@ package Opt is ...@@ -1274,8 +1274,8 @@ package Opt is
-- GNAT -- GNAT
-- Set True if Style_Check was set for the main unit. This is used to -- Set True if Style_Check was set for the main unit. This is used to
-- renable style checks for units in the mail extended source that get -- renable style checks for units in the mail extended source that get
-- with'ed indirectly. It is set on by use of either the -gnatg or -gnaty -- with'ed indirectly. It is set True by use of either the -gnatg or
-- switches, but not by use of the Style_Checks pragma. -- -gnaty switches, but not by use of the Style_Checks pragma.
Suppress_All_Inlining : Boolean := False; Suppress_All_Inlining : Boolean := False;
-- GNAT -- GNAT
...@@ -1411,7 +1411,7 @@ package Opt is ...@@ -1411,7 +1411,7 @@ package Opt is
-- Flag set to force attempt at semantic analysis, even if parser errors -- Flag set to force attempt at semantic analysis, even if parser errors
-- occur. This will probably cause blowups at this stage in the game. On -- occur. This will probably cause blowups at this stage in the game. On
-- the other hand, most such blowups will be caught cleanly and simply -- the other hand, most such blowups will be caught cleanly and simply
-- say compilation abandoned. This flag is set on by -gnatq or -gnatQ. -- say compilation abandoned. This flag is set True by -gnatq or -gnatQ.
Unchecked_Shared_Lib_Imports : Boolean := False; Unchecked_Shared_Lib_Imports : Boolean := False;
-- GPRBUILD -- GPRBUILD
......
gcc/ada/s-fileio.adb
...@@ -696,12 +696,14 @@ package body System.File_IO is ...@@ -696,12 +696,14 @@ package body System.File_IO is
Klen := KImage'Length; Klen := KImage'Length;
To_Lower (KImage); To_Lower (KImage);
if Form (Index .. Index + Klen - 1) = KImage then if Index + Klen - 1 <= Form'Last and then
Form (Index .. Index + Klen - 1) = KImage
then
case Parm is case Parm is
when Force_Record_Mode => when Force_Record_Mode =>
VMS_Form (Pos) := '"'; VMS_Form (Pos) := '"';
Pos := Pos + 1; Pos := Pos + 1;
VMS_Form (Pos .. Pos + 7) := "ctx=rec"; VMS_Form (Pos .. Pos + 6) := "ctx=rec";
Pos := Pos + 7; Pos := Pos + 7;
VMS_Form (Pos) := '"'; VMS_Form (Pos) := '"';
Pos := Pos + 1; Pos := Pos + 1;
...@@ -711,7 +713,7 @@ package body System.File_IO is ...@@ -711,7 +713,7 @@ package body System.File_IO is
when Force_Stream_Mode => when Force_Stream_Mode =>
VMS_Form (Pos) := '"'; VMS_Form (Pos) := '"';
Pos := Pos + 1; Pos := Pos + 1;
VMS_Form (Pos .. Pos + 7) := "ctx=stm"; VMS_Form (Pos .. Pos + 6) := "ctx=stm";
Pos := Pos + 7; Pos := Pos + 7;
VMS_Form (Pos) := '"'; VMS_Form (Pos) := '"';
Pos := Pos + 1; Pos := Pos + 1;
......
gcc/ada/sem.ads
...@@ -429,11 +429,11 @@ package Sem is ...@@ -429,11 +429,11 @@ package Sem is
-- compilation unit. These sections are separated by distinct occurrences -- compilation unit. These sections are separated by distinct occurrences
-- of package Standard. The currently active section of the scope stack -- of package Standard. The currently active section of the scope stack
-- goes from the current scope to the first (innermost) occurrence of -- goes from the current scope to the first (innermost) occurrence of
-- Standard, which is additionally marked with the flag -- Standard, which is additionally marked with flag Is_Active_Stack_Base.
-- Is_Active_Stack_Base. The basic visibility routine (Find_Direct_Name, in -- The basic visibility routine (Find_Direct_Name, in Sem_Ch8) uses this
-- Sem_Ch8) uses this contiguous section of the scope stack to determine -- contiguous section of the scope stack to determine whether a given
-- whether a given entity is or is not visible at a point. In_Open_Scopes -- entity is or is not visible at a point. In_Open_Scopes only examines
-- only examines the currently active section of the scope stack. -- the currently active section of the scope stack.
-- Similar complications arise when processing child instances. These -- Similar complications arise when processing child instances. These
-- must be compiled in the context of parent instances, and therefore the -- must be compiled in the context of parent instances, and therefore the
...@@ -464,7 +464,12 @@ package Sem is ...@@ -464,7 +464,12 @@ package Sem is
-- Save contents of Local_Suppress_Stack on entry to restore on exit -- Save contents of Local_Suppress_Stack on entry to restore on exit
Save_Check_Policy_List : Node_Id; Save_Check_Policy_List : Node_Id;
-- Save contents of Check_Policy_List on entry to restore on exit -- Save contents of Check_Policy_List on entry to restore on exit. The
-- Check_Policy pragmas are chained with Check_Policy_List pointing to
-- the most recent entry. This list is searched starting here, so that
-- the search finds the most recent appicable entry. When we restore
-- Check_Policy_List on exit from the scope, the effect is to remove
-- all entries set in the scope being exited.
Save_Default_Storage_Pool : Node_Id; Save_Default_Storage_Pool : Node_Id;
-- Save contents of Default_Storage_Pool on entry to restore on exit -- Save contents of Default_Storage_Pool on entry to restore on exit
......
gcc/ada/sem_ch6.adb
...@@ -12242,7 +12242,7 @@ package body Sem_Ch6 is ...@@ -12242,7 +12242,7 @@ package body Sem_Ch6 is
while Present (Prag) loop while Present (Prag) loop
if Nkind (Prag) = N_Pragma then if Nkind (Prag) = N_Pragma then
-- If pragma, capture if enabled postcondition, else ignore -- If pragma, capture if postconditions enabled, else ignore
if Pragma_Name (Prag) = Name_Postcondition if Pragma_Name (Prag) = Name_Postcondition
and then Check_Enabled (Name_Postcondition) and then Check_Enabled (Name_Postcondition)
......
gcc/ada/sem_prag.adb
...@@ -7012,7 +7012,7 @@ package body Sem_Prag is ...@@ -7012,7 +7012,7 @@ package body Sem_Prag is
return; return;
end if; end if;
Pack_Id := Defining_Unit_Name (Specification (Par)); Pack_Id := Defining_Entity (Par);
State := Expression (Arg1); State := Expression (Arg1);
-- Multiple abstract states appear as an aggregate -- Multiple abstract states appear as an aggregate
......
gcc/ada/sem_warn.adb
...@@ -645,7 +645,7 @@ package body Sem_Warn is ...@@ -645,7 +645,7 @@ package body Sem_Warn is
end if; end if;
-- If an unconditional exit statement is the last statement in the -- If an unconditional exit statement is the last statement in the
-- loop assume that no warning is needed. without any attempt at -- loop, assume that no warning is needed, without any attempt at
-- checking whether the exit is reachable. -- checking whether the exit is reachable.
elsif Exit_Stmt = Last (Statements (Loop_Statement)) then elsif Exit_Stmt = Last (Statements (Loop_Statement)) then
......
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