[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:
Arnaud Charlet 2009-04-09 10:25:13 +02:00
parent 76c597a1fc
commit 3c25856afe
16 changed files with 137 additions and 143 deletions

View File

@ -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

View File

@ -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);
---------
-- "=" --

View File

@ -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;

View File

@ -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);

View File

@ -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;

View File

@ -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);

View File

@ -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;

View File

@ -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);

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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;