[multiple changes]
2009-04-09 Pascal Obry <obry@adacore.com> * a-cihama.adb, a-cihama.ads, a-coinve.adb, a-coorma.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads, a-coorse.adb, a-coorse.ads, a-coormu.adb, a-coormu.ads, a-cohase.adb, a-cohase.ads: Minor reformatting. 2009-04-09 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Check_Overriding_Indicator): Do not generate warning on missing overriding indicator if the new declaration is not seen as primitive. From-SVN: r145804
This commit is contained in:
parent
76c597a1fc
commit
3c25856afe
@ -1,3 +1,16 @@
|
||||
2009-04-09 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* a-cihama.adb, a-cihama.ads, a-coinve.adb, a-coorma.ads, a-cihase.adb,
|
||||
a-cihase.ads, a-cohama.adb, a-cohama.ads, a-coorse.adb, a-coorse.ads,
|
||||
a-coormu.adb, a-coormu.ads, a-cohase.adb, a-cohase.ads: Minor
|
||||
reformatting.
|
||||
|
||||
2009-04-09 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Check_Overriding_Indicator): Do not generate warning on
|
||||
missing overriding indicator if the new declaration is not seen as
|
||||
primitive.
|
||||
|
||||
2009-04-09 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_Concatenate): Add circuitry to properly handle
|
||||
|
@ -86,23 +86,21 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
||||
-- Local Instantiations --
|
||||
--------------------------
|
||||
|
||||
package HT_Ops is
|
||||
new Ada.Containers.Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
package HT_Ops is new Ada.Containers.Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
|
||||
package Key_Ops is
|
||||
new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Key_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Key_Node);
|
||||
package Key_Ops is new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Key_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Key_Node);
|
||||
|
||||
---------
|
||||
-- "=" --
|
||||
|
@ -276,9 +276,8 @@ private
|
||||
Next : Node_Access;
|
||||
end record;
|
||||
|
||||
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package HT_Types is
|
||||
new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
|
||||
|
||||
type Map is new Ada.Finalization.Controlled with record
|
||||
HT : HT_Types.Hash_Table_Type;
|
||||
@ -297,11 +296,10 @@ private
|
||||
type Map_Access is access constant Map;
|
||||
for Map_Access'Storage_Size use 0;
|
||||
|
||||
type Cursor is
|
||||
record
|
||||
Container : Map_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
type Cursor is record
|
||||
Container : Map_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
|
@ -102,25 +102,23 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||
--------------------------
|
||||
|
||||
procedure Free_Element is
|
||||
new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
|
||||
new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
|
||||
|
||||
package HT_Ops is
|
||||
new Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
package HT_Ops is new Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
|
||||
package Element_Keys is
|
||||
new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Element_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Keys);
|
||||
package Element_Keys is new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Element_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Keys);
|
||||
|
||||
function Is_Equal is
|
||||
new HT_Ops.Generic_Equal (Find_Equal_Key);
|
||||
|
@ -402,15 +402,13 @@ private
|
||||
|
||||
type Element_Access is access Element_Type;
|
||||
|
||||
type Node_Type is
|
||||
limited record
|
||||
Element : Element_Access;
|
||||
Next : Node_Access;
|
||||
end record;
|
||||
type Node_Type is limited record
|
||||
Element : Element_Access;
|
||||
Next : Node_Access;
|
||||
end record;
|
||||
|
||||
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package HT_Types is
|
||||
new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
|
||||
|
||||
type Set is new Ada.Finalization.Controlled with record
|
||||
HT : HT_Types.Hash_Table_Type;
|
||||
@ -429,11 +427,10 @@ private
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
||||
type Cursor is
|
||||
record
|
||||
Container : Set_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
type Cursor is record
|
||||
Container : Set_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
@ -447,9 +444,7 @@ private
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor :=
|
||||
(Container => null,
|
||||
Node => null);
|
||||
No_Element : constant Cursor := (Container => null, Node => null);
|
||||
|
||||
procedure Write
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2008, 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- --
|
||||
@ -82,23 +82,21 @@ package body Ada.Containers.Hashed_Maps is
|
||||
-- Local Instantiations --
|
||||
--------------------------
|
||||
|
||||
package HT_Ops is
|
||||
new Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
package HT_Ops is new Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
|
||||
package Key_Ops is
|
||||
new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Key_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Key_Node);
|
||||
package Key_Ops is new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Key_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Key_Node);
|
||||
|
||||
function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key);
|
||||
|
||||
|
@ -281,9 +281,8 @@ private
|
||||
Next : Node_Access;
|
||||
end record;
|
||||
|
||||
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package HT_Types is
|
||||
new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
|
||||
|
||||
type Map is new Ada.Finalization.Controlled with record
|
||||
HT : HT_Types.Hash_Table_Type;
|
||||
@ -315,11 +314,10 @@ private
|
||||
type Map_Access is access constant Map;
|
||||
for Map_Access'Storage_Size use 0;
|
||||
|
||||
type Cursor is
|
||||
record
|
||||
Container : Map_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
type Cursor is record
|
||||
Container : Map_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Read
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
|
@ -103,23 +103,21 @@ package body Ada.Containers.Hashed_Sets is
|
||||
-- Local Instantiations --
|
||||
--------------------------
|
||||
|
||||
package HT_Ops is
|
||||
new Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
package HT_Ops is new Hash_Tables.Generic_Operations
|
||||
(HT_Types => HT_Types,
|
||||
Hash_Node => Hash_Node,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Copy_Node => Copy_Node,
|
||||
Free => Free);
|
||||
|
||||
package Element_Keys is
|
||||
new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Element_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Keys);
|
||||
package Element_Keys is new Hash_Tables.Generic_Keys
|
||||
(HT_Types => HT_Types,
|
||||
Next => Next,
|
||||
Set_Next => Set_Next,
|
||||
Key_Type => Element_Type,
|
||||
Hash => Hash,
|
||||
Equivalent_Keys => Equivalent_Keys);
|
||||
|
||||
function Is_Equal is
|
||||
new HT_Ops.Generic_Equal (Find_Equal_Key);
|
||||
|
@ -42,8 +42,8 @@ generic
|
||||
|
||||
with function Hash (Element : Element_Type) return Hash_Type;
|
||||
|
||||
with function Equivalent_Elements (Left, Right : Element_Type)
|
||||
return Boolean;
|
||||
with function Equivalent_Elements
|
||||
(Left, Right : Element_Type) return Boolean;
|
||||
|
||||
with function "=" (Left, Right : Element_Type) return Boolean is <>;
|
||||
|
||||
@ -402,15 +402,13 @@ private
|
||||
type Node_Type;
|
||||
type Node_Access is access Node_Type;
|
||||
|
||||
type Node_Type is
|
||||
limited record
|
||||
Element : Element_Type;
|
||||
Next : Node_Access;
|
||||
end record;
|
||||
type Node_Type is limited record
|
||||
Element : Element_Type;
|
||||
Next : Node_Access;
|
||||
end record;
|
||||
|
||||
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package HT_Types is
|
||||
new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
|
||||
|
||||
type Set is new Ada.Finalization.Controlled with record
|
||||
HT : HT_Types.Hash_Table_Type;
|
||||
@ -429,11 +427,10 @@ private
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
||||
type Cursor is
|
||||
record
|
||||
Container : Set_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
type Cursor is record
|
||||
Container : Set_Access;
|
||||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
|
@ -26,7 +26,7 @@
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- This unit has originally being developed by Matthew J Heaney. --
|
||||
-- This unit was originally developed by Matthew J Heaney. --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Containers.Generic_Array_Sort;
|
||||
@ -996,14 +996,13 @@ package body Ada.Containers.Indefinite_Vectors is
|
||||
-- Sort --
|
||||
----------
|
||||
|
||||
procedure Sort (Container : in out Vector)
|
||||
is
|
||||
procedure Sort is
|
||||
new Generic_Array_Sort
|
||||
(Index_Type => Index_Type,
|
||||
Element_Type => Element_Access,
|
||||
Array_Type => Elements_Array,
|
||||
"<" => Is_Less);
|
||||
procedure Sort (Container : in out Vector) is
|
||||
|
||||
procedure Sort is new Generic_Array_Sort
|
||||
(Index_Type => Index_Type,
|
||||
Element_Type => Element_Access,
|
||||
Array_Type => Elements_Array,
|
||||
"<" => Is_Less);
|
||||
|
||||
-- Start of processing for Sort
|
||||
|
||||
@ -1045,7 +1044,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1)
|
||||
is
|
||||
N : constant Int := Int (Count);
|
||||
N : constant Int := Int (Count);
|
||||
|
||||
First : constant Int := Int (Index_Type'First);
|
||||
New_Last_As_Int : Int'Base;
|
||||
@ -1053,7 +1052,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
||||
New_Length : UInt;
|
||||
Max_Length : constant UInt := UInt (Count_Type'Last);
|
||||
|
||||
Dst : Elements_Access;
|
||||
Dst : Elements_Access;
|
||||
|
||||
begin
|
||||
if Before < Index_Type'First then
|
||||
@ -1507,7 +1506,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
||||
Before : Extended_Index;
|
||||
Count : Count_Type := 1)
|
||||
is
|
||||
N : constant Int := Int (Count);
|
||||
N : constant Int := Int (Count);
|
||||
|
||||
First : constant Int := Int (Index_Type'First);
|
||||
New_Last_As_Int : Int'Base;
|
||||
@ -1515,7 +1514,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
||||
New_Length : UInt;
|
||||
Max_Length : constant UInt := UInt (Count_Type'Last);
|
||||
|
||||
Dst : Elements_Access;
|
||||
Dst : Elements_Access;
|
||||
|
||||
begin
|
||||
if Before < Index_Type'First then
|
||||
|
@ -197,9 +197,8 @@ private
|
||||
Element : Element_Type;
|
||||
end record;
|
||||
|
||||
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package Tree_Types is
|
||||
new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access);
|
||||
|
||||
type Map is new Ada.Finalization.Controlled with record
|
||||
Tree : Tree_Types.Tree_Type;
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2008, 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- --
|
||||
@ -261,8 +261,7 @@ package body Ada.Containers.Ordered_Multisets is
|
||||
-- Adjust --
|
||||
------------
|
||||
|
||||
procedure Adjust is
|
||||
new Tree_Operations.Generic_Adjust (Copy_Tree);
|
||||
procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
|
||||
|
||||
procedure Adjust (Container : in out Set) is
|
||||
begin
|
||||
|
@ -436,9 +436,8 @@ private
|
||||
Element : Element_Type;
|
||||
end record;
|
||||
|
||||
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package Tree_Types is
|
||||
new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access);
|
||||
|
||||
type Set is new Ada.Finalization.Controlled with record
|
||||
Tree : Tree_Types.Tree_Type;
|
||||
|
@ -258,8 +258,7 @@ package body Ada.Containers.Ordered_Sets is
|
||||
-- Adjust --
|
||||
------------
|
||||
|
||||
procedure Adjust is
|
||||
new Tree_Operations.Generic_Adjust (Copy_Tree);
|
||||
procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
|
||||
|
||||
procedure Adjust (Container : in out Set) is
|
||||
begin
|
||||
@ -286,8 +285,7 @@ package body Ada.Containers.Ordered_Sets is
|
||||
-- Clear --
|
||||
-----------
|
||||
|
||||
procedure Clear is
|
||||
new Tree_Operations.Generic_Clear (Delete_Tree);
|
||||
procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
|
||||
|
||||
procedure Clear (Container : in out Set) is
|
||||
begin
|
||||
|
@ -248,9 +248,8 @@ private
|
||||
Element : Element_Type;
|
||||
end record;
|
||||
|
||||
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
|
||||
(Node_Type,
|
||||
Node_Access);
|
||||
package Tree_Types is
|
||||
new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access);
|
||||
|
||||
type Set is new Ada.Finalization.Controlled with record
|
||||
Tree : Tree_Types.Tree_Type;
|
||||
|
@ -4196,7 +4196,15 @@ package body Sem_Ch6 is
|
||||
Set_Is_Overriding_Operation (Subp);
|
||||
end if;
|
||||
|
||||
if Style_Check and then not Must_Override (Spec) then
|
||||
-- If primitive flag is set, operation is overriding at the
|
||||
-- point of its declaration, so warn if necessary. Otherwise
|
||||
-- it may have been declared before the operation it overrides
|
||||
-- and no check is required.
|
||||
|
||||
if Style_Check
|
||||
and then not Must_Override (Spec)
|
||||
and then Is_Primitive
|
||||
then
|
||||
Style.Missing_Overriding (Decl, Subp);
|
||||
end if;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user