Skip to content

R
riscv-gcc-1
Commit 9a476d75 by Arnaud Charlet
Options

[multiple changes] 

2016-04-20  Yannick Moy  <moy@adacore.com>

	* osint.adb (Relocate_Path): Fix test when Path is shorter than Prefix.
	* einfo.adb (Set_Overridden_Operation): Add assertion.
	* sem_util.adb (Unique_Entity): for renaming-as-body return the spec
	entity.

2016-04-20  Javier Miranda  <miranda@adacore.com>

	* exp_unst.adb (Append_Unique_Call): New subprogram.
	(Unnest_Subprogram): Replace the unique occurrence
	of Call.Append() by Append_Unique_Call() which protects us from
	adding to the Calls table duplicated entries.

2016-04-20  Arnaud Charlet  <charlet@adacore.com>

	* exp_attr.adb (Is_GCC_Target): Fix for C backend.
	* xref_lib.ads (Dependencies_Tables): instantiate
	Table package with types that guarantee its safe use.
	* s-imgllu.adb, s-imgint.adb, s-imguns.adb, s-imglli.adb: Avoid nested
	procedures.

From-SVN: r235248
parent 88438c0e
Showing with 130 additions and 115 deletions
gcc/ada/ChangeLog
2016-04-20 Yannick Moy <moy@adacore.com>
* osint.adb (Relocate_Path): Fix test when Path is shorter than Prefix.
* einfo.adb (Set_Overridden_Operation): Add assertion.
* sem_util.adb (Unique_Entity): for renaming-as-body return the spec
entity.
2016-04-20 Javier Miranda <miranda@adacore.com>
* exp_unst.adb (Append_Unique_Call): New subprogram.
(Unnest_Subprogram): Replace the unique occurrence
of Call.Append() by Append_Unique_Call() which protects us from
adding to the Calls table duplicated entries.
2016-04-20 Arnaud Charlet <charlet@adacore.com>
* exp_attr.adb (Is_GCC_Target): Fix for C backend.
* xref_lib.ads (Dependencies_Tables): instantiate
Table package with types that guarantee its safe use.
* s-imgllu.adb, s-imgint.adb, s-imguns.adb, s-imglli.adb: Avoid nested
procedures.
2016-04-20 Arnaud Charlet <charlet@adacore.com> 2016-04-20 Arnaud Charlet <charlet@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]): * exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]):
......
gcc/ada/einfo.adb
...@@ -5878,6 +5878,7 @@ package body Einfo is ...@@ -5878,6 +5878,7 @@ package body Einfo is
procedure Set_Overridden_Operation (Id : E; V : E) is procedure Set_Overridden_Operation (Id : E; V : E) is
begin begin
pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
Set_Node26 (Id, V); Set_Node26 (Id, V);
end Set_Overridden_Operation; end Set_Overridden_Operation;
......
gcc/ada/exp_attr.adb
...@@ -7988,7 +7988,9 @@ package body Exp_Attr is ...@@ -7988,7 +7988,9 @@ package body Exp_Attr is
function Is_GCC_Target return Boolean is function Is_GCC_Target return Boolean is
begin begin
return not CodePeer_Mode and then not AAMP_On_Target; return not CodePeer_Mode
and then not AAMP_On_Target
and then not Generate_C_Code;
end Is_GCC_Target; end Is_GCC_Target;
-- Start of processing for Exp_Attr -- Start of processing for Exp_Attr
......
gcc/ada/exp_unst.adb
...@@ -80,6 +80,10 @@ package body Exp_Unst is ...@@ -80,6 +80,10 @@ package body Exp_Unst is
-- that are to other subprograms nested within the outer subprogram. These -- that are to other subprograms nested within the outer subprogram. These
-- are the calls that may need an additional parameter. -- are the calls that may need an additional parameter.
procedure Append_Unique_Call (Call : Call_Entry);
-- Append a call entry to the Calls table. A check is made to see if the
-- table already contains this entry and if so it has no effect.
----------- -----------
-- Urefs -- -- Urefs --
----------- -----------
...@@ -119,6 +123,21 @@ package body Exp_Unst is ...@@ -119,6 +123,21 @@ package body Exp_Unst is
Table_Increment => 200, Table_Increment => 200,
Table_Name => "Unnest_Urefs"); Table_Name => "Unnest_Urefs");
------------------------
-- Append_Unique_Call --
------------------------
procedure Append_Unique_Call (Call : Call_Entry) is
begin
for J in Calls.First .. Calls.Last loop
if Calls.Table (J) = Call then
return;
end if;
end loop;
Calls.Append (Call);
end Append_Unique_Call;
----------------------- -----------------------
-- Unnest_Subprogram -- -- Unnest_Subprogram --
----------------------- -----------------------
...@@ -520,7 +539,7 @@ package body Exp_Unst is ...@@ -520,7 +539,7 @@ package body Exp_Unst is
-- Both caller and callee must be subprograms -- Both caller and callee must be subprograms
if Is_Subprogram (Ent) then if Is_Subprogram (Ent) then
Calls.Append ((N, Current_Subprogram, Ent)); Append_Unique_Call ((N, Current_Subprogram, Ent));
end if; end if;
end if; end if;
end if; end if;
......
gcc/ada/osint.adb
...@@ -2752,7 +2752,7 @@ package body Osint is ...@@ -2752,7 +2752,7 @@ package body Osint is
end if; end if;
end if; end if;
if Path (Prefix'Range) = Prefix then if Path'Last >= Prefix'Last and then Path (Prefix'Range) = Prefix then
if Std_Prefix.all /= "" then if Std_Prefix.all /= "" then
S := new String S := new String
(1 .. Std_Prefix'Length + Path'Last - Prefix'Last); (1 .. Std_Prefix'Length + Path'Last - Prefix'Last);
......
gcc/ada/s-imgint.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, 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- --
...@@ -31,6 +31,12 @@ ...@@ -31,6 +31,12 @@
package body System.Img_Int is package body System.Img_Int is
procedure Set_Digits
(T : Integer; S : in out String; P : in out Natural);
-- Set digits of absolute value of T, which is zero or negative. We work
-- with the negative of the value so that the largest negative number is
-- not a special case.
------------------- -------------------
-- Image_Integer -- -- Image_Integer --
------------------- -------------------
...@@ -53,6 +59,23 @@ package body System.Img_Int is ...@@ -53,6 +59,23 @@ package body System.Img_Int is
Set_Image_Integer (V, S, P); Set_Image_Integer (V, S, P);
end Image_Integer; end Image_Integer;
----------------
-- Set_Digits --
----------------
procedure Set_Digits
(T : Integer; S : in out String; P : in out Natural) is
begin
if T <= -10 then
Set_Digits (T / 10, S, P);
P := P + 1;
S (P) := Character'Val (48 - (T rem 10));
else
P := P + 1;
S (P) := Character'Val (48 - T);
end if;
end Set_Digits;
----------------------- -----------------------
-- Set_Image_Integer -- -- Set_Image_Integer --
----------------------- -----------------------
...@@ -60,38 +83,14 @@ package body System.Img_Int is ...@@ -60,38 +83,14 @@ package body System.Img_Int is
procedure Set_Image_Integer procedure Set_Image_Integer
(V : Integer; (V : Integer;
S : in out String; S : in out String;
P : in out Natural) P : in out Natural) is
is
procedure Set_Digits (T : Integer);
-- Set digits of absolute value of T, which is zero or negative. We work
-- with the negative of the value so that the largest negative number is
-- not a special case.
----------------
-- Set_Digits --
----------------
procedure Set_Digits (T : Integer) is
begin
if T <= -10 then
Set_Digits (T / 10);
P := P + 1;
S (P) := Character'Val (48 - (T rem 10));
else
P := P + 1;
S (P) := Character'Val (48 - T);
end if;
end Set_Digits;
-- Start of processing for Set_Image_Integer
begin begin
if V >= 0 then if V >= 0 then
Set_Digits (-V); Set_Digits (-V, S, P);
else else
P := P + 1; P := P + 1;
S (P) := '-'; S (P) := '-';
Set_Digits (V); Set_Digits (V, S, P);
end if; end if;
end Set_Image_Integer; end Set_Image_Integer;
......
gcc/ada/s-imglli.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, 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- --
...@@ -31,6 +31,12 @@ ...@@ -31,6 +31,12 @@
package body System.Img_LLI is package body System.Img_LLI is
procedure Set_Digits
(T : Long_Long_Integer; S : in out String; P : in out Natural);
-- Set digits of absolute value of T, which is zero or negative. We work
-- with the negative of the value so that the largest negative number is
-- not a special case.
----------------------------- -----------------------------
-- Image_Long_Long_Integer -- -- Image_Long_Long_Integer --
----------------------------- -----------------------------
...@@ -53,45 +59,38 @@ package body System.Img_LLI is ...@@ -53,45 +59,38 @@ package body System.Img_LLI is
Set_Image_Long_Long_Integer (V, S, P); Set_Image_Long_Long_Integer (V, S, P);
end Image_Long_Long_Integer; end Image_Long_Long_Integer;
------------------------------ ----------------
-- Set_Digits --
----------------
procedure Set_Digits
(T : Long_Long_Integer; S : in out String; P : in out Natural) is
begin
if T <= -10 then
Set_Digits (T / 10, S, P);
P := P + 1;
S (P) := Character'Val (48 - (T rem 10));
else
P := P + 1;
S (P) := Character'Val (48 - T);
end if;
end Set_Digits;
---------------------------------
-- Set_Image_Long_Long_Integer -- -- Set_Image_Long_Long_Integer --
----------------------------- --------------------------------
procedure Set_Image_Long_Long_Integer procedure Set_Image_Long_Long_Integer
(V : Long_Long_Integer; (V : Long_Long_Integer;
S : in out String; S : in out String;
P : in out Natural) P : in out Natural) is
is
procedure Set_Digits (T : Long_Long_Integer);
-- Set digits of absolute value of T, which is zero or negative. We work
-- with the negative of the value so that the largest negative number is
-- not a special case.
----------------
-- Set_Digits --
----------------
procedure Set_Digits (T : Long_Long_Integer) is
begin
if T <= -10 then
Set_Digits (T / 10);
P := P + 1;
S (P) := Character'Val (48 - (T rem 10));
else
P := P + 1;
S (P) := Character'Val (48 - T);
end if;
end Set_Digits;
-- Start of processing for Set_Image_Long_Long_Integer
begin begin
if V >= 0 then if V >= 0 then
Set_Digits (-V); Set_Digits (-V, S, P);
else else
P := P + 1; P := P + 1;
S (P) := '-'; S (P) := '-';
Set_Digits (V); Set_Digits (V, S, P);
end if; end if;
end Set_Image_Long_Long_Integer; end Set_Image_Long_Long_Integer;
......
gcc/ada/s-imgllu.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, 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- --
...@@ -56,32 +56,17 @@ package body System.Img_LLU is ...@@ -56,32 +56,17 @@ package body System.Img_LLU is
procedure Set_Image_Long_Long_Unsigned procedure Set_Image_Long_Long_Unsigned
(V : Long_Long_Unsigned; (V : Long_Long_Unsigned;
S : in out String; S : in out String;
P : in out Natural) P : in out Natural) is
is
procedure Set_Digits (T : Long_Long_Unsigned);
-- Set digits of absolute value of T
----------------
-- Set_Digits --
----------------
procedure Set_Digits (T : Long_Long_Unsigned) is
begin
if T >= 10 then
Set_Digits (T / 10);
P := P + 1;
S (P) := Character'Val (48 + (T rem 10));
else
P := P + 1;
S (P) := Character'Val (48 + T);
end if;
end Set_Digits;
-- Start of processing for Set_Image_Long_Long_Unsigned
begin begin
Set_Digits (V); if V >= 10 then
Set_Image_Long_Long_Unsigned (V / 10, S, P);
P := P + 1;
S (P) := Character'Val (48 + (V rem 10));
else
P := P + 1;
S (P) := Character'Val (48 + V);
end if;
end Set_Image_Long_Long_Unsigned; end Set_Image_Long_Long_Unsigned;
end System.Img_LLU; end System.Img_LLU;
gcc/ada/s-imguns.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, 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- --
...@@ -56,32 +56,17 @@ package body System.Img_Uns is ...@@ -56,32 +56,17 @@ package body System.Img_Uns is
procedure Set_Image_Unsigned procedure Set_Image_Unsigned
(V : Unsigned; (V : Unsigned;
S : in out String; S : in out String;
P : in out Natural) P : in out Natural) is
is
procedure Set_Digits (T : Unsigned);
-- Set decimal digits of value of T
----------------
-- Set_Digits --
----------------
procedure Set_Digits (T : Unsigned) is
begin
if T >= 10 then
Set_Digits (T / 10);
P := P + 1;
S (P) := Character'Val (48 + (T rem 10));
else
P := P + 1;
S (P) := Character'Val (48 + T);
end if;
end Set_Digits;
-- Start of processing for Set_Image_Unsigned
begin begin
Set_Digits (V); if V >= 10 then
Set_Image_Unsigned (V / 10, S, P);
P := P + 1;
S (P) := Character'Val (48 + (V rem 10));
else
P := P + 1;
S (P) := Character'Val (48 + V);
end if;
end Set_Image_Unsigned; end Set_Image_Unsigned;
end System.Img_Uns; end System.Img_Uns;
gcc/ada/sem_util.adb
...@@ -20138,6 +20138,9 @@ package body Sem_Util is ...@@ -20138,6 +20138,9 @@ package body Sem_Util is
and then Present (Corresponding_Spec_Of_Stub (P)) and then Present (Corresponding_Spec_Of_Stub (P))
then then
U := Corresponding_Spec_Of_Stub (P); U := Corresponding_Spec_Of_Stub (P);
elsif Nkind (P) = N_Subprogram_Renaming_Declaration
then
U := Corresponding_Spec (P);
end if; end if;
when E_Task_Body => when E_Task_Body =>
......
gcc/ada/xref_lib.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1998-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1998-2015, 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- --
...@@ -134,7 +134,7 @@ private ...@@ -134,7 +134,7 @@ private
package Dependencies_Tables is new GNAT.Dynamic_Tables package Dependencies_Tables is new GNAT.Dynamic_Tables
(Table_Component_Type => Xr_Tabls.File_Reference, (Table_Component_Type => Xr_Tabls.File_Reference,
Table_Index_Type => Positive, Table_Index_Type => Natural,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 400, Table_Initial => 400,
Table_Increment => 100); Table_Increment => 100);
......
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