From 9a476d752d5693cba41ae966e680b9ae1e03f144 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 20 Apr 2016 11:21:59 +0200 Subject: [PATCH] [multiple changes] 2016-04-20 Yannick Moy * 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 * 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 * 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 --- gcc/ada/ChangeLog | 22 +++++++++++++++++ gcc/ada/einfo.adb | 1 + gcc/ada/exp_attr.adb | 4 ++- gcc/ada/exp_unst.adb | 21 +++++++++++++++- gcc/ada/osint.adb | 2 +- gcc/ada/s-imgint.adb | 55 ++++++++++++++++++++--------------------- gcc/ada/s-imglli.adb | 59 ++++++++++++++++++++++---------------------- gcc/ada/s-imgllu.adb | 37 +++++++++------------------ gcc/ada/s-imguns.adb | 37 +++++++++------------------ gcc/ada/sem_util.adb | 3 +++ gcc/ada/xref_lib.ads | 4 +-- 11 files changed, 130 insertions(+), 115 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b1a363a0542..bb725367941 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2016-04-20 Yannick Moy + + * 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 + + * 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 + + * 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 * exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]): diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index e0a9b174d07..99e52d3b2b8 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 0b0a3951ab5..cfbba775580 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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 diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index eed26e66bc9..c0a34054eed 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -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; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 7567d179c29..22327a0707c 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -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); diff --git a/gcc/ada/s-imgint.adb b/gcc/ada/s-imgint.adb index 88dc5849def..4fad4e66e75 100644 --- a/gcc/ada/s-imgint.adb +++ b/gcc/ada/s-imgint.adb @@ -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; diff --git a/gcc/ada/s-imglli.adb b/gcc/ada/s-imglli.adb index 05154fadc91..9e7199bf528 100644 --- a/gcc/ada/s-imglli.adb +++ b/gcc/ada/s-imglli.adb @@ -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; diff --git a/gcc/ada/s-imgllu.adb b/gcc/ada/s-imgllu.adb index d1e9dd41469..95ff789d96e 100644 --- a/gcc/ada/s-imgllu.adb +++ b/gcc/ada/s-imgllu.adb @@ -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; diff --git a/gcc/ada/s-imguns.adb b/gcc/ada/s-imguns.adb index a2cce144c3c..c6df94c936a 100644 --- a/gcc/ada/s-imguns.adb +++ b/gcc/ada/s-imguns.adb @@ -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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index da7d00a5b65..d0479cf3188 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 => diff --git a/gcc/ada/xref_lib.ads b/gcc/ada/xref_lib.ads index e0db3fdb700..8d8a4ed282b 100644 --- a/gcc/ada/xref_lib.ads +++ b/gcc/ada/xref_lib.ads @@ -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);