Commit fe4552f4 by Arnaud Charlet

[multiple changes]

2014-02-20  Robert Dewar  <dewar@adacore.com>

	* a-crbtgk.adb, a-cihama.adb, a-coinve.adb, a-ciorse.adb, a-crbtgo.adb,
	a-cidlli.adb, a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-coorse.adb,
	a-chtgke.adb, a-chtgop.adb, a-comutr.adb, a-ciorma.adb, a-cobove.adb,
	a-convec.adb, a-cohase.adb, a-chtgbk.adb, a-chtgbo.adb: Minor
	reformatting.

2014-02-20  Bob Duff  <duff@adacore.com>

	* s-os_lib.ads: Minor: Remove incorrect comment.

2014-02-20  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Check_Elab_Assign): Clearer warning message.

2014-02-20  Vincent Celier  <celier@adacore.com>

	* gnat_rm.texi: Minor syntax error fix.

2014-02-20  Ed Schonberg  <schonberg@adacore.com>

	* a-cborma.adb (Assign): When creating a node without a specified
	element, insert an uninitialized element in the map, because
	the instance may provide an element type with a default
	initialization, e.g a scalar with a Default_Value aspect.
	* a-cbhama.adb (Assign_Key): Remove useless Allocate procedure.
	(Insert): In the version without explicit element, provide an
	uninitialized element, as above.
	* a-cbdlli.adb (Append): In the version without explicit element,
	provide an uninitalized element, as above.
	(Allocate): Remove unused version.

From-SVN: r207945
parent 3730c4a0
2014-02-20 Robert Dewar <dewar@adacore.com> 2014-02-20 Robert Dewar <dewar@adacore.com>
* a-crbtgk.adb, a-cihama.adb, a-coinve.adb, a-ciorse.adb, a-crbtgo.adb,
a-cidlli.adb, a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-coorse.adb,
a-chtgke.adb, a-chtgop.adb, a-comutr.adb, a-ciorma.adb, a-cobove.adb,
a-convec.adb, a-cohase.adb, a-chtgbk.adb, a-chtgbo.adb: Minor
reformatting.
2014-02-20 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Minor: Remove incorrect comment.
2014-02-20 Robert Dewar <dewar@adacore.com>
* sem_elab.adb (Check_Elab_Assign): Clearer warning message.
2014-02-20 Ed Schonberg <schonberg@adacore.com>
* a-cborma.adb (Assign): When creating a node without a specified
element, insert an uninitialized element in the map, because
the instance may provide an element type with a default
initialization, e.g a scalar with a Default_Value aspect.
* a-cbhama.adb (Assign_Key): Remove useless Allocate procedure.
(Insert): In the version without explicit element, provide an
uninitialized element, as above.
* a-cbdlli.adb (Append): In the version without explicit element,
provide an uninitalized element, as above.
(Allocate): Remove unused version.
2014-02-20 Robert Dewar <dewar@adacore.com>
* sem_elab.adb: Minor code reorganization (use Nkind_In). * sem_elab.adb: Minor code reorganization (use Nkind_In).
* stringt.adb: Remove temporary pragma Warnings (Off). * stringt.adb: Remove temporary pragma Warnings (Off).
* stringt.ads: Add pragma Elaborate_Body to ensure initialization * stringt.ads: Add pragma Elaborate_Body to ensure initialization
......
...@@ -42,10 +42,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -42,10 +42,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
procedure Allocate procedure Allocate
(Container : in out List; (Container : in out List;
New_Node : out Count_Type);
procedure Allocate
(Container : in out List;
Stream : not null access Root_Stream_Type'Class; Stream : not null access Root_Stream_Type'Class;
New_Node : out Count_Type); New_Node : out Count_Type);
...@@ -218,26 +214,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -218,26 +214,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
end if; end if;
end Allocate; end Allocate;
procedure Allocate
(Container : in out List;
New_Node : out Count_Type)
is
N : Node_Array renames Container.Nodes;
begin
if Container.Free >= 0 then
New_Node := Container.Free;
Container.Free := N (New_Node).Next;
else
-- As explained above, a negative free store value means that the
-- links for the nodes in the free store have not been initialized.
New_Node := abs Container.Free;
Container.Free := Container.Free - 1;
end if;
end Allocate;
------------ ------------
-- Append -- -- Append --
------------ ------------
...@@ -1145,40 +1121,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -1145,40 +1121,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Position : out Cursor; Position : out Cursor;
Count : Count_Type := 1) Count : Count_Type := 1)
is is
New_Node : Count_Type; New_Item : Element_Type; -- Default initialized.
pragma Warnings (Off, New_Item);
begin begin
if Before.Container /= null then -- There is no explicit element provided, but in an instance the
if Before.Container /= Container'Unrestricted_Access then -- element type may be a scalar with a Default_Value aspect, or a
raise Program_Error with -- composite type with such a scalar component, so we insert the
"Before cursor designates wrong list"; -- specified number of possibly initialized elements at the given
end if; -- position.
pragma Assert (Vet (Before), "bad cursor in Insert");
end if;
if Count = 0 then
Position := Before;
return;
end if;
if Container.Length > Container.Capacity - Count then
raise Constraint_Error with "new length exceeds capacity";
end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is busy)";
end if;
Allocate (Container, New_Node => New_Node);
Insert_Internal (Container, Before.Node, New_Node);
Position := Cursor'(Container'Unchecked_Access, New_Node);
for Index in Count_Type'(2) .. Count loop Insert (Container, Before, New_Item, Position, Count);
Allocate (Container, New_Node => New_Node);
Insert_Internal (Container, Before.Node, New_Node);
end loop;
end Insert; end Insert;
--------------------- ---------------------
......
...@@ -556,15 +556,19 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -556,15 +556,19 @@ package body Ada.Containers.Bounded_Hashed_Maps is
----------------- -----------------
procedure Assign_Key (Node : in out Node_Type) is procedure Assign_Key (Node : in out Node_Type) is
New_Item : Element_Type;
pragma Warnings (Off, New_Item);
-- Default-initialized element (ok to reference, see below)
begin begin
Node.Key := Key; Node.Key := Key;
-- Note that we do not also assign the element component of the node -- There is no explicit element provided, but in an instance the
-- here, because this version of Insert does not accept an element -- element type may be a scalar with a Default_Value aspect, or
-- parameter. -- a composite type with such a scalar component, so we insert
-- a possibly initialized element under the given key.
-- Node.Element := New_Item; Node.Element := New_Item;
-- What is this deleted code about???
end Assign_Key; end Assign_Key;
-------------- --------------
......
...@@ -826,20 +826,19 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -826,20 +826,19 @@ package body Ada.Containers.Bounded_Ordered_Maps is
------------ ------------
procedure Assign (Node : in out Node_Type) is procedure Assign (Node : in out Node_Type) is
New_Item : Element_Type;
pragma Warnings (Off, New_Item);
-- Default-initialized element (ok to reference, see below)
begin begin
Node.Key := Key; Node.Key := Key;
-- Were this insertion operation to accept an element parameter, this -- There is no explicit element provided, but in an instance the
-- is the point where the element value would be used, to update the -- element type may be a scalar with a Default_Value aspect, or
-- element component of the new node. However, this insertion -- a composite type with such a scalar component, so we insert
-- operation is special, in the sense that it does not accept an -- a possibly initialized element under the given key.
-- element parameter. Rather, this version of Insert allocates a node
-- (inserting it among the active nodes of the container in the Node.Element := New_Item;
-- normal way, with the node's position being determined by the Key),
-- and passes back a cursor designating the node. It is then up to
-- the caller to assign a value to the node's element.
-- Node.Element := New_Item;
end Assign; end Assign;
-------------- --------------
......
...@@ -53,6 +53,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is ...@@ -53,6 +53,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is
L := L - 1; L := L - 1;
return Result; return Result;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -84,6 +85,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is ...@@ -84,6 +85,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is
L := L - 1; L := L - 1;
return Result; return Result;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -285,6 +287,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is ...@@ -285,6 +287,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is
declare declare
B : Natural renames HT.Busy; B : Natural renames HT.Busy;
L : Natural renames HT.Lock; L : Natural renames HT.Lock;
begin begin
B := B + 1; B := B + 1;
L := L + 1; L := L + 1;
...@@ -293,6 +296,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is ...@@ -293,6 +296,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
......
...@@ -54,6 +54,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is ...@@ -54,6 +54,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
L := L - 1; L := L - 1;
return Result; return Result;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -378,6 +379,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is ...@@ -378,6 +379,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
L_Node := Next (L.Nodes (L_Node)); L_Node := Next (L.Nodes (L_Node));
if L_Node = 0 then if L_Node = 0 then
-- We have exhausted the nodes in this bucket -- We have exhausted the nodes in this bucket
if N = 0 then if N = 0 then
...@@ -402,6 +404,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is ...@@ -402,6 +404,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
LR := LR - 1; LR := LR - 1;
return Result; return Result;
exception exception
when others => when others =>
BL := BL - 1; BL := BL - 1;
......
...@@ -53,6 +53,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -53,6 +53,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
L := L - 1; L := L - 1;
return Result; return Result;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -84,6 +85,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -84,6 +85,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
L := L - 1; L := L - 1;
return Result; return Result;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -269,6 +271,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -269,6 +271,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
declare declare
B : Natural renames HT.Busy; B : Natural renames HT.Busy;
L : Natural renames HT.Lock; L : Natural renames HT.Lock;
begin begin
B := B + 1; B := B + 1;
L := L + 1; L := L + 1;
...@@ -277,6 +280,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -277,6 +280,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
......
...@@ -145,6 +145,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -145,6 +145,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
L := L - 1; L := L - 1;
return Result; return Result;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -411,6 +412,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -411,6 +412,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
LR := LR - 1; LR := LR - 1;
return Result; return Result;
exception exception
when others => when others =>
BL := BL - 1; BL := BL - 1;
...@@ -738,12 +740,14 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -738,12 +740,14 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
pragma Assert (L > 0); pragma Assert (L > 0);
L := L - 1; L := L - 1;
end loop; end loop;
exception exception
when others => when others =>
-- If there's an error computing a hash value during a -- If there's an error computing a hash value during a
-- rehash, then AI-302 says the nodes "become lost." The -- rehash, then AI-302 says the nodes "become lost." The
-- issue is whether to actually deallocate these lost nodes, -- issue is whether to actually deallocate these lost nodes,
-- since they might be designated by extant cursors. Here -- since they might be designated by extant cursors. Here
-- we decide to deallocate the nodes, since it's better to -- we decide to deallocate the nodes, since it's better to
-- solve real problems (storage consumption) rather than -- solve real problems (storage consumption) rather than
-- imaginary ones (the user might, or might not, dereference -- imaginary ones (the user might, or might not, dereference
......
...@@ -609,6 +609,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -609,6 +609,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Find; end Find;
...@@ -746,6 +747,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -746,6 +747,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Is_Sorted; end Is_Sorted;
...@@ -945,10 +947,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -945,10 +947,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
...@@ -1753,6 +1757,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -1753,6 +1757,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Reverse_Find; end Reverse_Find;
......
...@@ -308,11 +308,9 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -308,11 +308,9 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
function Copy_Node (Node : Node_Access) return Node_Access is function Copy_Node (Node : Node_Access) return Node_Access is
K : Key_Access := new Key_Type'(Node.Key.all); K : Key_Access := new Key_Type'(Node.Key.all);
E : Element_Access; E : Element_Access;
begin begin
E := new Element_Type'(Node.Element.all); E := new Element_Type'(Node.Element.all);
return new Node_Type'(K, E, null); return new Node_Type'(K, E, null);
exception exception
when others => when others =>
Free_Key (K); Free_Key (K);
...@@ -603,6 +601,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -603,6 +601,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
begin begin
Free_Key (X.Key); Free_Key (X.Key);
exception exception
when others => when others =>
X.Key := null; X.Key := null;
...@@ -623,7 +622,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -623,7 +622,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
exception exception
when others => when others =>
X.Element := null; X.Element := null;
Deallocate (X); Deallocate (X);
raise; raise;
end; end;
...@@ -979,10 +977,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -979,10 +977,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
begin begin
Process (K, E); Process (K, E);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
......
...@@ -471,6 +471,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -471,6 +471,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
Bucket := new Node_Type'(Tgt, Bucket); Bucket := new Node_Type'(Tgt, Bucket);
exception exception
when others => when others =>
Free_Element (Tgt); Free_Element (Tgt);
...@@ -485,6 +486,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -485,6 +486,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
Iterate (Left.HT); Iterate (Left.HT);
exception exception
when others => when others =>
HT_Ops.Free_Hash_Table (Buckets); HT_Ops.Free_Hash_Table (Buckets);
...@@ -774,6 +776,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -774,6 +776,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
Free_Element (X.Element); Free_Element (X.Element);
exception exception
when others => when others =>
X.Element := null; X.Element := null;
...@@ -1021,6 +1024,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1021,6 +1024,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
Bucket := new Node_Type'(Tgt, Bucket); Bucket := new Node_Type'(Tgt, Bucket);
exception exception
when others => when others =>
Free_Element (Tgt); Free_Element (Tgt);
...@@ -1035,6 +1039,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1035,6 +1039,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
Iterate (Left.HT); Iterate (Left.HT);
exception exception
when others => when others =>
HT_Ops.Free_Hash_Table (Buckets); HT_Ops.Free_Hash_Table (Buckets);
...@@ -1753,6 +1758,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1753,6 +1758,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
Iterate (Right_HT); Iterate (Right_HT);
exception exception
when others => when others =>
HT_Ops.Free_Hash_Table (Buckets); HT_Ops.Free_Hash_Table (Buckets);
...@@ -1916,6 +1922,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1916,6 +1922,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -1991,6 +1998,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1991,6 +1998,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
LL := LL - 1; LL := LL - 1;
LB := LB - 1; LB := LB - 1;
exception exception
when others => when others =>
RL := RL - 1; RL := RL - 1;
...@@ -2426,10 +2434,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -2426,10 +2434,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Indx := HT_Ops.Index (HT, Position.Node); Indx := HT_Ops.Index (HT, Position.Node);
Process (E); Process (E);
Eq := Equivalent_Keys (K, Key (E)); Eq := Equivalent_Keys (K, Key (E));
exception exception
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2012, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -2746,6 +2746,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -2746,6 +2746,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
end Update_Element; end Update_Element;
......
...@@ -455,6 +455,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -455,6 +455,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Color => Source.Color, Color => Source.Color,
Key => K, Key => K,
Element => E); Element => E);
exception exception
when others => when others =>
Free_Key (K); Free_Key (K);
...@@ -966,6 +967,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -966,6 +967,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
Local_Iterate (Container.Tree); Local_Iterate (Container.Tree);
exception exception
when others => when others =>
B := B - 1; B := B - 1;
...@@ -1305,7 +1307,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1305,7 +1307,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
declare declare
K : Key_Type renames Position.Node.Key.all; K : Key_Type renames Position.Node.Key.all;
E : Element_Type renames Position.Node.Element.all; E : Element_Type renames Position.Node.Element.all;
begin begin
Process (K, E); Process (K, E);
exception exception
...@@ -1683,10 +1684,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1683,10 +1684,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
declare declare
K : Key_Type renames Position.Node.Key.all; K : Key_Type renames Position.Node.Key.all;
E : Element_Type renames Position.Node.Element.all; E : Element_Type renames Position.Node.Element.all;
begin begin
Process (K, E); Process (K, E);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
......
...@@ -440,6 +440,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -440,6 +440,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
Right => null, Right => null,
Color => Source.Color, Color => Source.Color,
Element => Element); Element => Element);
exception exception
when others => when others =>
Free_Element (Element); Free_Element (Element);
...@@ -1908,6 +1909,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -1908,6 +1909,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -1960,6 +1962,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -1960,6 +1962,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
......
...@@ -785,6 +785,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -785,6 +785,7 @@ package body Ada.Containers.Bounded_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Find; end Find;
...@@ -827,6 +828,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -827,6 +828,7 @@ package body Ada.Containers.Bounded_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Find_Index; end Find_Index;
...@@ -937,6 +939,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -937,6 +939,7 @@ package body Ada.Containers.Bounded_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Is_Sorted; end Is_Sorted;
...@@ -1096,6 +1099,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1096,6 +1099,7 @@ package body Ada.Containers.Bounded_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Sort; end Sort;
...@@ -2492,10 +2496,12 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2492,10 +2496,12 @@ package body Ada.Containers.Bounded_Vectors is
else else
return Cursor'(Container'Unrestricted_Access, Result); return Cursor'(Container'Unrestricted_Access, Result);
end if; end if;
exception exception
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Reverse_Find; end Reverse_Find;
...@@ -2541,6 +2547,7 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2541,6 +2547,7 @@ package body Ada.Containers.Bounded_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Reverse_Find_Index; end Reverse_Find_Index;
......
...@@ -887,7 +887,6 @@ package body Ada.Containers.Hashed_Maps is ...@@ -887,7 +887,6 @@ package body Ada.Containers.Hashed_Maps is
declare declare
K : Key_Type renames Position.Node.Key; K : Key_Type renames Position.Node.Key;
E : Element_Type renames Position.Node.Element; E : Element_Type renames Position.Node.Element;
begin begin
Process (K, E); Process (K, E);
exception exception
...@@ -1134,10 +1133,8 @@ package body Ada.Containers.Hashed_Maps is ...@@ -1134,10 +1133,8 @@ package body Ada.Containers.Hashed_Maps is
declare declare
K : Key_Type renames Position.Node.Key; K : Key_Type renames Position.Node.Key;
E : Element_Type renames Position.Node.Element; E : Element_Type renames Position.Node.Element;
begin begin
Process (K, E); Process (K, E);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
......
...@@ -1208,7 +1208,6 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1208,7 +1208,6 @@ package body Ada.Containers.Hashed_Sets is
return Node_Access return Node_Access
is is
Node : Node_Access := new Node_Type; Node : Node_Access := new Node_Type;
begin begin
Element_Type'Read (Stream, Node.Element); Element_Type'Read (Stream, Node.Element);
return Node; return Node;
...@@ -1522,6 +1521,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1522,6 +1521,7 @@ package body Ada.Containers.Hashed_Sets is
begin begin
Iterate (Left_HT); Iterate (Left_HT);
exception exception
when others => when others =>
HT_Ops.Free_Hash_Table (Buckets); HT_Ops.Free_Hash_Table (Buckets);
...@@ -1563,6 +1563,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1563,6 +1563,7 @@ package body Ada.Containers.Hashed_Sets is
begin begin
Iterate (Right_HT); Iterate (Right_HT);
exception exception
when others => when others =>
HT_Ops.Free_Hash_Table (Buckets); HT_Ops.Free_Hash_Table (Buckets);
...@@ -1718,6 +1719,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1718,6 +1719,7 @@ package body Ada.Containers.Hashed_Sets is
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -1785,6 +1787,7 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1785,6 +1787,7 @@ package body Ada.Containers.Hashed_Sets is
LL := LL - 1; LL := LL - 1;
LB := LB - 1; LB := LB - 1;
exception exception
when others => when others =>
RL := RL - 1; RL := RL - 1;
......
...@@ -543,6 +543,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -543,6 +543,7 @@ package body Ada.Containers.Indefinite_Vectors is
LR := LR - 1; LR := LR - 1;
return Result; return Result;
exception exception
when others => when others =>
BL := BL - 1; BL := BL - 1;
...@@ -1280,6 +1281,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1280,6 +1281,7 @@ package body Ada.Containers.Indefinite_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Find_Index; end Find_Index;
...@@ -1421,6 +1423,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1421,6 +1423,7 @@ package body Ada.Containers.Indefinite_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Is_Sorted; end Is_Sorted;
...@@ -1599,6 +1602,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1599,6 +1602,7 @@ package body Ada.Containers.Indefinite_Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Sort; end Sort;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2012, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -1934,6 +1934,7 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1934,6 +1934,7 @@ package body Ada.Containers.Multiway_Trees is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
end Query_Element; end Query_Element;
...@@ -2723,6 +2724,7 @@ package body Ada.Containers.Multiway_Trees is ...@@ -2723,6 +2724,7 @@ package body Ada.Containers.Multiway_Trees is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
end Update_Element; end Update_Element;
......
...@@ -943,6 +943,7 @@ package body Ada.Containers.Vectors is ...@@ -943,6 +943,7 @@ package body Ada.Containers.Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Find; end Find;
...@@ -985,6 +986,7 @@ package body Ada.Containers.Vectors is ...@@ -985,6 +986,7 @@ package body Ada.Containers.Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Find_Index; end Find_Index;
...@@ -1095,6 +1097,7 @@ package body Ada.Containers.Vectors is ...@@ -1095,6 +1097,7 @@ package body Ada.Containers.Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Is_Sorted; end Is_Sorted;
...@@ -1257,6 +1260,7 @@ package body Ada.Containers.Vectors is ...@@ -1257,6 +1260,7 @@ package body Ada.Containers.Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Sort; end Sort;
...@@ -3288,6 +3292,7 @@ package body Ada.Containers.Vectors is ...@@ -3288,6 +3292,7 @@ package body Ada.Containers.Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end; end;
end Reverse_Find; end Reverse_Find;
...@@ -3333,6 +3338,7 @@ package body Ada.Containers.Vectors is ...@@ -3333,6 +3338,7 @@ package body Ada.Containers.Vectors is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Reverse_Find_Index; end Reverse_Find_Index;
......
...@@ -1742,6 +1742,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -1742,6 +1742,7 @@ package body Ada.Containers.Ordered_Sets is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -1783,6 +1784,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -1783,6 +1784,7 @@ package body Ada.Containers.Ordered_Sets is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
......
...@@ -77,6 +77,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -77,6 +77,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Ceiling; end Ceiling;
...@@ -136,6 +137,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -136,6 +137,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Find; end Find;
...@@ -183,6 +185,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -183,6 +185,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
B := B - 1; B := B - 1;
L := L - 1; L := L - 1;
raise; raise;
end Floor; end Floor;
...@@ -252,6 +255,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -252,6 +255,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -297,6 +301,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -297,6 +301,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -374,6 +379,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -374,6 +379,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -419,6 +425,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -419,6 +425,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -445,6 +452,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -445,6 +452,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -483,6 +491,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -483,6 +491,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
...@@ -509,6 +518,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is ...@@ -509,6 +518,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
when others => when others =>
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
raise; raise;
end; end;
......
...@@ -598,6 +598,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is ...@@ -598,6 +598,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
end loop; end loop;
return Target_Root; return Target_Root;
exception exception
when others => when others =>
Delete_Tree (Target_Root); Delete_Tree (Target_Root);
......
...@@ -7381,7 +7381,7 @@ pragma Warnings (On | Off, LOCAL_NAME [,REASON]); ...@@ -7381,7 +7381,7 @@ pragma Warnings (On | Off, LOCAL_NAME [,REASON]);
pragma Warnings (static_string_EXPRESSION [,REASON]); pragma Warnings (static_string_EXPRESSION [,REASON]);
pragma Warnings (On | Off, static_string_EXPRESSION [,REASON]); pragma Warnings (On | Off, static_string_EXPRESSION [,REASON]);
REASON ::= Reason => STRING_LITERAL {& STRING_LITERAL} REASON ::= Reason => STRING_LITERAL @{& STRING_LITERAL@}
@end smallexample @end smallexample
@noindent @noindent
......
...@@ -802,10 +802,8 @@ package System.OS_Lib is ...@@ -802,10 +802,8 @@ package System.OS_Lib is
-- Similar to the procedure above, but saves the output of the command to -- Similar to the procedure above, but saves the output of the command to
-- a file with the name Output_File. -- a file with the name Output_File.
-- --
-- Success is set to True if the command is executed and its output -- Invalid_Pid is returned if the output file could not be created or if
-- successfully written to the file. Invalid_Pid is returned if the output -- the program could not be spawned successfully.
-- file could not be created or if the program could not be spawned
-- successfully.
-- --
-- Spawning processes from tasking programs is not recommended. See -- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below. -- "NOTE: Spawn in tasking programs" below.
......
...@@ -1717,13 +1717,11 @@ package body Sem_Elab is ...@@ -1717,13 +1717,11 @@ package body Sem_Elab is
Error_Msg_Sloc := Sloc (Ent); Error_Msg_Sloc := Sloc (Ent);
Error_Msg_NE Error_Msg_NE
("??elaboration code may access& before it is initialized", ("??& can be accessed by clients before this initialization",
N, Ent); N, Ent);
Error_Msg_NE Error_Msg_NE
("\??suggest adding pragma Elaborate_Body to spec of &", ("\??add Elaborate_Body to spec to ensure & is initialized",
N, Scop); N, Ent);
Error_Msg_N
("\??or an explicit initialization could be added #", N);
end if; end if;
if not All_Errors_Mode then if not All_Errors_Mode 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