Skip to content

R
riscv-gcc-1
Commit 3c25856a by Arnaud Charlet
Options

[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
parent 76c597a1
Showing with 142 additions and 148 deletions
gcc/ada/ChangeLog
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
gcc/ada/a-cihama.adb
...@@ -86,23 +86,21 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -86,23 +86,21 @@ 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, Set_Next => Set_Next,
Set_Next => Set_Next, Copy_Node => Copy_Node,
Copy_Node => Copy_Node, Free => Free);
Free => Free);
package Key_Ops is new Hash_Tables.Generic_Keys
package Key_Ops is (HT_Types => HT_Types,
new Hash_Tables.Generic_Keys Next => Next,
(HT_Types => HT_Types, Set_Next => Set_Next,
Next => Next, Key_Type => Key_Type,
Set_Next => Set_Next, Hash => Hash,
Key_Type => Key_Type, Equivalent_Keys => Equivalent_Key_Node);
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
--------- ---------
-- "=" -- -- "=" --
......
gcc/ada/a-cihama.ads
...@@ -276,9 +276,8 @@ private ...@@ -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,11 +296,10 @@ private ...@@ -297,11 +296,10 @@ 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;
procedure Write procedure Write
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
......
gcc/ada/a-cihase.adb
...@@ -102,25 +102,23 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -102,25 +102,23 @@ 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, Set_Next => Set_Next,
Set_Next => Set_Next, Copy_Node => Copy_Node,
Copy_Node => Copy_Node, Free => Free);
Free => Free);
package Element_Keys is new Hash_Tables.Generic_Keys
package Element_Keys is (HT_Types => HT_Types,
new Hash_Tables.Generic_Keys Next => Next,
(HT_Types => HT_Types, Set_Next => Set_Next,
Next => Next, Key_Type => Element_Type,
Set_Next => Set_Next, Hash => Hash,
Key_Type => Element_Type, Equivalent_Keys => Equivalent_Keys);
Hash => Hash,
Equivalent_Keys => Equivalent_Keys);
function Is_Equal is function Is_Equal is
new HT_Ops.Generic_Equal (Find_Equal_Key); new HT_Ops.Generic_Equal (Find_Equal_Key);
......
gcc/ada/a-cihase.ads
...@@ -402,15 +402,13 @@ private ...@@ -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,11 +427,10 @@ private ...@@ -429,11 +427,10 @@ 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;
procedure Write procedure Write
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
...@@ -447,9 +444,7 @@ private ...@@ -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;
......
gcc/ada/a-cohama.adb
...@@ -6,7 +6,7 @@ ...@@ -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,23 +82,21 @@ package body Ada.Containers.Hashed_Maps is ...@@ -82,23 +82,21 @@ 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, Set_Next => Set_Next,
Set_Next => Set_Next, Copy_Node => Copy_Node,
Copy_Node => Copy_Node, Free => Free);
Free => Free);
package Key_Ops is new Hash_Tables.Generic_Keys
package Key_Ops is (HT_Types => HT_Types,
new Hash_Tables.Generic_Keys Next => Next,
(HT_Types => HT_Types, Set_Next => Set_Next,
Next => Next, Key_Type => Key_Type,
Set_Next => Set_Next, Hash => Hash,
Key_Type => Key_Type, Equivalent_Keys => Equivalent_Key_Node);
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key); function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key);
......
gcc/ada/a-cohama.ads
...@@ -281,9 +281,8 @@ private ...@@ -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,11 +314,10 @@ private ...@@ -315,11 +314,10 @@ 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;
procedure Read procedure Read
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
......
gcc/ada/a-cohase.adb
...@@ -103,23 +103,21 @@ package body Ada.Containers.Hashed_Sets is ...@@ -103,23 +103,21 @@ 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, Set_Next => Set_Next,
Set_Next => Set_Next, Copy_Node => Copy_Node,
Copy_Node => Copy_Node, Free => Free);
Free => Free);
package Element_Keys is new Hash_Tables.Generic_Keys
package Element_Keys is (HT_Types => HT_Types,
new Hash_Tables.Generic_Keys Next => Next,
(HT_Types => HT_Types, Set_Next => Set_Next,
Next => Next, Key_Type => Element_Type,
Set_Next => Set_Next, Hash => Hash,
Key_Type => Element_Type, Equivalent_Keys => Equivalent_Keys);
Hash => Hash,
Equivalent_Keys => Equivalent_Keys);
function Is_Equal is function Is_Equal is
new HT_Ops.Generic_Equal (Find_Equal_Key); new HT_Ops.Generic_Equal (Find_Equal_Key);
......
gcc/ada/a-cohase.ads
...@@ -42,8 +42,8 @@ generic ...@@ -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 ...@@ -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,11 +427,10 @@ private ...@@ -429,11 +427,10 @@ 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;
procedure Write procedure Write
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
......
gcc/ada/a-coinve.adb
...@@ -26,7 +26,7 @@ ...@@ -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,14 +996,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -996,14 +996,13 @@ 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, "<" => Is_Less);
"<" => Is_Less);
-- Start of processing for Sort -- Start of processing for Sort
...@@ -1045,7 +1044,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1045,7 +1044,7 @@ package body Ada.Containers.Indefinite_Vectors is
New_Item : Element_Type; New_Item : Element_Type;
Count : Count_Type := 1) Count : Count_Type := 1)
is is
N : constant Int := Int (Count); N : constant Int := Int (Count);
First : constant Int := Int (Index_Type'First); First : constant Int := Int (Index_Type'First);
New_Last_As_Int : Int'Base; New_Last_As_Int : Int'Base;
...@@ -1053,7 +1052,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1053,7 +1052,7 @@ package body Ada.Containers.Indefinite_Vectors is
New_Length : UInt; New_Length : UInt;
Max_Length : constant UInt := UInt (Count_Type'Last); Max_Length : constant UInt := UInt (Count_Type'Last);
Dst : Elements_Access; Dst : Elements_Access;
begin begin
if Before < Index_Type'First then if Before < Index_Type'First then
...@@ -1507,7 +1506,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1507,7 +1506,7 @@ package body Ada.Containers.Indefinite_Vectors is
Before : Extended_Index; Before : Extended_Index;
Count : Count_Type := 1) Count : Count_Type := 1)
is is
N : constant Int := Int (Count); N : constant Int := Int (Count);
First : constant Int := Int (Index_Type'First); First : constant Int := Int (Index_Type'First);
New_Last_As_Int : Int'Base; New_Last_As_Int : Int'Base;
...@@ -1515,7 +1514,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1515,7 +1514,7 @@ package body Ada.Containers.Indefinite_Vectors is
New_Length : UInt; New_Length : UInt;
Max_Length : constant UInt := UInt (Count_Type'Last); Max_Length : constant UInt := UInt (Count_Type'Last);
Dst : Elements_Access; Dst : Elements_Access;
begin begin
if Before < Index_Type'First then if Before < Index_Type'First then
......
gcc/ada/a-coorma.ads
...@@ -197,9 +197,8 @@ private ...@@ -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;
......
gcc/ada/a-coormu.adb
...@@ -6,7 +6,7 @@ ...@@ -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 ...@@ -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
......
gcc/ada/a-coormu.ads
...@@ -436,9 +436,8 @@ private ...@@ -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;
......
gcc/ada/a-coorse.adb
...@@ -258,8 +258,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -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 ...@@ -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
......
gcc/ada/a-coorse.ads
...@@ -248,9 +248,8 @@ private ...@@ -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;
......
gcc/ada/sem_ch6.adb
...@@ -4196,7 +4196,15 @@ package body Sem_Ch6 is ...@@ -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;
......
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