[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> 2009-04-09 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Expand_Concatenate): Add circuitry to properly handle * exp_ch4.adb (Expand_Concatenate): Add circuitry to properly handle

View File

@ -86,8 +86,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
-- Local Instantiations -- -- Local Instantiations --
-------------------------- --------------------------
package HT_Ops is package HT_Ops is new Ada.Containers.Hash_Tables.Generic_Operations
new Ada.Containers.Hash_Tables.Generic_Operations
(HT_Types => HT_Types, (HT_Types => HT_Types,
Hash_Node => Hash_Node, Hash_Node => Hash_Node,
Next => Next, Next => Next,
@ -95,8 +94,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
Copy_Node => Copy_Node, Copy_Node => Copy_Node,
Free => Free); Free => Free);
package Key_Ops is package Key_Ops is new Hash_Tables.Generic_Keys
new Hash_Tables.Generic_Keys
(HT_Types => HT_Types, (HT_Types => HT_Types,
Next => Next, Next => Next,
Set_Next => Set_Next, Set_Next => Set_Next,

View File

@ -276,9 +276,8 @@ private
Next : Node_Access; Next : Node_Access;
end record; end record;
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types package HT_Types is
(Node_Type, new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
Node_Access);
type Map is new Ada.Finalization.Controlled with record type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type; HT : HT_Types.Hash_Table_Type;
@ -297,8 +296,7 @@ private
type Map_Access is access constant Map; type Map_Access is access constant Map;
for Map_Access'Storage_Size use 0; for Map_Access'Storage_Size use 0;
type Cursor is type Cursor is record
record
Container : Map_Access; Container : Map_Access;
Node : Node_Access; Node : Node_Access;
end record; end record;

View File

@ -104,8 +104,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
procedure Free_Element 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 package HT_Ops is new Hash_Tables.Generic_Operations
new Hash_Tables.Generic_Operations
(HT_Types => HT_Types, (HT_Types => HT_Types,
Hash_Node => Hash_Node, Hash_Node => Hash_Node,
Next => Next, Next => Next,
@ -113,8 +112,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Copy_Node => Copy_Node, Copy_Node => Copy_Node,
Free => Free); Free => Free);
package Element_Keys is package Element_Keys is new Hash_Tables.Generic_Keys
new Hash_Tables.Generic_Keys
(HT_Types => HT_Types, (HT_Types => HT_Types,
Next => Next, Next => Next,
Set_Next => Set_Next, Set_Next => Set_Next,

View File

@ -402,15 +402,13 @@ private
type Element_Access is access Element_Type; type Element_Access is access Element_Type;
type Node_Type is type Node_Type is limited record
limited record
Element : Element_Access; Element : Element_Access;
Next : Node_Access; Next : Node_Access;
end record; end record;
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types package HT_Types is
(Node_Type, new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
Node_Access);
type Set is new Ada.Finalization.Controlled with record type Set is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type; HT : HT_Types.Hash_Table_Type;
@ -429,8 +427,7 @@ private
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
type Cursor is type Cursor is record
record
Container : Set_Access; Container : Set_Access;
Node : Node_Access; Node : Node_Access;
end record; end record;
@ -447,9 +444,7 @@ private
for Cursor'Read use Read; for Cursor'Read use Read;
No_Element : constant Cursor := No_Element : constant Cursor := (Container => null, Node => null);
(Container => null,
Node => null);
procedure Write procedure Write
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
@ -82,8 +82,7 @@ package body Ada.Containers.Hashed_Maps is
-- Local Instantiations -- -- Local Instantiations --
-------------------------- --------------------------
package HT_Ops is package HT_Ops is new Hash_Tables.Generic_Operations
new Hash_Tables.Generic_Operations
(HT_Types => HT_Types, (HT_Types => HT_Types,
Hash_Node => Hash_Node, Hash_Node => Hash_Node,
Next => Next, Next => Next,
@ -91,8 +90,7 @@ package body Ada.Containers.Hashed_Maps is
Copy_Node => Copy_Node, Copy_Node => Copy_Node,
Free => Free); Free => Free);
package Key_Ops is package Key_Ops is new Hash_Tables.Generic_Keys
new Hash_Tables.Generic_Keys
(HT_Types => HT_Types, (HT_Types => HT_Types,
Next => Next, Next => Next,
Set_Next => Set_Next, Set_Next => Set_Next,

View File

@ -281,9 +281,8 @@ private
Next : Node_Access; Next : Node_Access;
end record; end record;
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types package HT_Types is
(Node_Type, new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
Node_Access);
type Map is new Ada.Finalization.Controlled with record type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type; HT : HT_Types.Hash_Table_Type;
@ -315,8 +314,7 @@ private
type Map_Access is access constant Map; type Map_Access is access constant Map;
for Map_Access'Storage_Size use 0; for Map_Access'Storage_Size use 0;
type Cursor is type Cursor is record
record
Container : Map_Access; Container : Map_Access;
Node : Node_Access; Node : Node_Access;
end record; end record;

View File

@ -103,8 +103,7 @@ package body Ada.Containers.Hashed_Sets is
-- Local Instantiations -- -- Local Instantiations --
-------------------------- --------------------------
package HT_Ops is package HT_Ops is new Hash_Tables.Generic_Operations
new Hash_Tables.Generic_Operations
(HT_Types => HT_Types, (HT_Types => HT_Types,
Hash_Node => Hash_Node, Hash_Node => Hash_Node,
Next => Next, Next => Next,
@ -112,8 +111,7 @@ package body Ada.Containers.Hashed_Sets is
Copy_Node => Copy_Node, Copy_Node => Copy_Node,
Free => Free); Free => Free);
package Element_Keys is package Element_Keys is new Hash_Tables.Generic_Keys
new Hash_Tables.Generic_Keys
(HT_Types => HT_Types, (HT_Types => HT_Types,
Next => Next, Next => Next,
Set_Next => Set_Next, Set_Next => Set_Next,

View File

@ -42,8 +42,8 @@ generic
with function Hash (Element : Element_Type) return Hash_Type; with function Hash (Element : Element_Type) return Hash_Type;
with function Equivalent_Elements (Left, Right : Element_Type) with function Equivalent_Elements
return Boolean; (Left, Right : Element_Type) return Boolean;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
@ -402,15 +402,13 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
type Node_Type is type Node_Type is limited record
limited record
Element : Element_Type; Element : Element_Type;
Next : Node_Access; Next : Node_Access;
end record; end record;
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types package HT_Types is
(Node_Type, new Hash_Tables.Generic_Hash_Table_Types (Node_Type, Node_Access);
Node_Access);
type Set is new Ada.Finalization.Controlled with record type Set is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type; HT : HT_Types.Hash_Table_Type;
@ -429,8 +427,7 @@ private
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
type Cursor is type Cursor is record
record
Container : Set_Access; Container : Set_Access;
Node : Node_Access; Node : Node_Access;
end record; end record;

View File

@ -26,7 +26,7 @@
-- however invalidate any other reasons why the executable file might be -- -- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. -- -- 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; with Ada.Containers.Generic_Array_Sort;
@ -996,10 +996,9 @@ package body Ada.Containers.Indefinite_Vectors is
-- Sort -- -- Sort --
---------- ----------
procedure Sort (Container : in out Vector) procedure Sort (Container : in out Vector) is
is
procedure Sort is procedure Sort is new Generic_Array_Sort
new Generic_Array_Sort
(Index_Type => Index_Type, (Index_Type => Index_Type,
Element_Type => Element_Access, Element_Type => Element_Access,
Array_Type => Elements_Array, Array_Type => Elements_Array,

View File

@ -197,9 +197,8 @@ private
Element : Element_Type; Element : Element_Type;
end record; end record;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types package Tree_Types is
(Node_Type, new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access);
Node_Access);
type Map is new Ada.Finalization.Controlled with record type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type; Tree : Tree_Types.Tree_Type;

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
@ -261,8 +261,7 @@ package body Ada.Containers.Ordered_Multisets is
-- Adjust -- -- Adjust --
------------ ------------
procedure Adjust is procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
new Tree_Operations.Generic_Adjust (Copy_Tree);
procedure Adjust (Container : in out Set) is procedure Adjust (Container : in out Set) is
begin begin

View File

@ -436,9 +436,8 @@ private
Element : Element_Type; Element : Element_Type;
end record; end record;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types package Tree_Types is
(Node_Type, new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access);
Node_Access);
type Set is new Ada.Finalization.Controlled with record type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type; Tree : Tree_Types.Tree_Type;

View File

@ -258,8 +258,7 @@ package body Ada.Containers.Ordered_Sets is
-- Adjust -- -- Adjust --
------------ ------------
procedure Adjust is procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
new Tree_Operations.Generic_Adjust (Copy_Tree);
procedure Adjust (Container : in out Set) is procedure Adjust (Container : in out Set) is
begin begin
@ -286,8 +285,7 @@ package body Ada.Containers.Ordered_Sets is
-- Clear -- -- Clear --
----------- -----------
procedure Clear is procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
new Tree_Operations.Generic_Clear (Delete_Tree);
procedure Clear (Container : in out Set) is procedure Clear (Container : in out Set) is
begin begin

View File

@ -248,9 +248,8 @@ private
Element : Element_Type; Element : Element_Type;
end record; end record;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types package Tree_Types is
(Node_Type, new Red_Black_Trees.Generic_Tree_Types (Node_Type, Node_Access);
Node_Access);
type Set is new Ada.Finalization.Controlled with record type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type; Tree : Tree_Types.Tree_Type;

View File

@ -4196,7 +4196,15 @@ package body Sem_Ch6 is
Set_Is_Overriding_Operation (Subp); Set_Is_Overriding_Operation (Subp);
end if; 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); Style.Missing_Overriding (Decl, Subp);
end if; end if;