+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]):
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;
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
-- 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 --
-----------
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 --
-----------------------
-- 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;
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);
-- --
-- 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- --
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 --
-------------------
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 --
-----------------------
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;
-- --
-- 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- --
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 --
-----------------------------
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;
-- --
-- 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- --
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;
-- --
-- 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- --
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;
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 =>
-- --
-- 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- --
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);
projects / gcc.git / commitdiff