OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Arnaud Charlet 2016-04-20 11:21:59 +02:00
parent 88438c0e87
commit 9a476d752d
11 changed files with 130 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
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>
* exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]):

1
gcc/ada/einfo.adb
View File

@ -5878,6 +5878,7 @@ package body Einfo is
procedure Set_Overridden_Operation (Id : E; V : E) is
begin
pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
Set_Node26 (Id, V);
end Set_Overridden_Operation;

4
gcc/ada/exp_attr.adb
View File

@ -7988,7 +7988,9 @@ package body Exp_Attr is
function Is_GCC_Target return Boolean is
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;
-- Start of processing for Exp_Attr

21
gcc/ada/exp_unst.adb
View File

@ -80,6 +80,10 @@ package body Exp_Unst is
-- that are to other subprograms nested within the outer subprogram. These
-- 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 --
-----------
@ -119,6 +123,21 @@ package body Exp_Unst is
Table_Increment => 200,
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 --
-----------------------
@ -520,7 +539,7 @@ package body Exp_Unst is
-- Both caller and callee must be subprograms
if Is_Subprogram (Ent) then
Calls.Append ((N, Current_Subprogram, Ent));
Append_Unique_Call ((N, Current_Subprogram, Ent));
end if;
end if;
end if;

2
gcc/ada/osint.adb
View File

@ -2752,7 +2752,7 @@ package body Osint is
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
S := new String
(1 .. Std_Prefix'Length + Path'Last - Prefix'Last);

55
gcc/ada/s-imgint.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -31,6 +31,12 @@
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 --
-------------------
@ -53,6 +59,23 @@ package body System.Img_Int is
Set_Image_Integer (V, S, P);
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 --
-----------------------
@ -60,38 +83,14 @@ package body System.Img_Int is
procedure Set_Image_Integer
(V : Integer;
S : in out String;
P : in out Natural)
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
P : in out Natural) is
begin
if V >= 0 then
Set_Digits (-V);
Set_Digits (-V, S, P);
else
P := P + 1;
S (P) := '-';
Set_Digits (V);
Set_Digits (V, S, P);
end if;
end Set_Image_Integer;

59
gcc/ada/s-imglli.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -31,6 +31,12 @@
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 --
-----------------------------
@ -53,45 +59,38 @@ package body System.Img_LLI is
Set_Image_Long_Long_Integer (V, S, P);
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 --
-----------------------------
--------------------------------
procedure Set_Image_Long_Long_Integer
(V : Long_Long_Integer;
S : in out String;
P : in out Natural)
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
P : in out Natural) is
begin
if V >= 0 then
Set_Digits (-V);
Set_Digits (-V, S, P);
else
P := P + 1;
S (P) := '-';
Set_Digits (V);
Set_Digits (V, S, P);
end if;
end Set_Image_Long_Long_Integer;

37
gcc/ada/s-imgllu.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -56,32 +56,17 @@ package body System.Img_LLU is
procedure Set_Image_Long_Long_Unsigned
(V : Long_Long_Unsigned;
S : in out String;
P : in out Natural)
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
P : in out Natural) is
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 System.Img_LLU;

37
gcc/ada/s-imguns.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -56,32 +56,17 @@ package body System.Img_Uns is
procedure Set_Image_Unsigned
(V : Unsigned;
S : in out String;
P : in out Natural)
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
P : in out Natural) is
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 System.Img_Uns;

3
gcc/ada/sem_util.adb
View File

@ -20138,6 +20138,9 @@ package body Sem_Util is
and then Present (Corresponding_Spec_Of_Stub (P))
then
U := Corresponding_Spec_Of_Stub (P);
elsif Nkind (P) = N_Subprogram_Renaming_Declaration
then
U := Corresponding_Spec (P);
end if;
when E_Task_Body =>

4
gcc/ada/xref_lib.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -134,7 +134,7 @@ private
package Dependencies_Tables is new GNAT.Dynamic_Tables
(Table_Component_Type => Xr_Tabls.File_Reference,
Table_Index_Type => Positive,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 400,
Table_Increment => 100);