From: Robert Dewar Date: Tue, 6 Jan 2015 10:01:05 +0000 (+0000) Subject: snames.ads-tmpl: Remove entries for attribute Enum_Image. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=61ae296d2beb645bd0aed720cf408891d67913d9;p=gcc.git snames.ads-tmpl: Remove entries for attribute Enum_Image. 2015-01-06 Robert Dewar * snames.ads-tmpl: Remove entries for attribute Enum_Image. * exp_attr.adb: Remove reference to Attribute_Enum_Image. 2015-01-06 Robert Dewar * s-vallli.adb (Value_Long_Long_Integer): Handle case of Str'Last = Positive'Last. * s-valllu.adb (Value_Long_Long_Unsigned): Handle case of Str'Last = Positive'Last. 2015-01-06 Robert Dewar * sem_prag.adb (Process_Inline): Remove redundant construct warning (-gnatw.r) for an ineffective pragma Inline. From-SVN: r219244 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7b2ec9d551c..7eeb8cce9ff 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2015-01-06 Robert Dewar + + * snames.ads-tmpl: Remove entries for attribute Enum_Image. + * exp_attr.adb: Remove reference to Attribute_Enum_Image. + +2015-01-06 Robert Dewar + + * s-vallli.adb (Value_Long_Long_Integer): Handle case of Str'Last + = Positive'Last. + * s-valllu.adb (Value_Long_Long_Unsigned): Handle case of + Str'Last = Positive'Last. + +2015-01-06 Robert Dewar + + * sem_prag.adb (Process_Inline): Remove redundant construct + warning (-gnatw.r) for an ineffective pragma Inline. + 2015-01-06 Robert Dewar * s-valint.adb: Fix typo in last checkin. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 5a66e3f55a2..74b013ee687 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -7178,7 +7178,6 @@ package body Exp_Attr is Attribute_Digits | Attribute_Emax | Attribute_Enabled | - Attribute_Enum_Image | Attribute_Epsilon | Attribute_Fast_Math | Attribute_First_Valid | diff --git a/gcc/ada/s-vallli.adb b/gcc/ada/s-vallli.adb index 203e475b3cf..bf0e15d1234 100644 --- a/gcc/ada/s-vallli.adb +++ b/gcc/ada/s-vallli.adb @@ -91,12 +91,30 @@ package body System.Val_LLI is ----------------------------- function Value_Long_Long_Integer (Str : String) return Long_Long_Integer is - V : Long_Long_Integer; - P : aliased Integer := Str'First; begin - V := Scan_Long_Long_Integer (Str, P'Access, Str'Last); - Scan_Trailing_Blanks (Str, P); - return V; + -- We have to special case Str'Last = Positive'Last because the normal + -- circuit ends up setting P to Str'Last + 1 which is out of bounds. We + -- deal with this by converting to a subtype which fixes the bounds. + + if Str'Last = Positive'Last then + declare + subtype NT is String (1 .. Str'Length); + begin + return Value_Long_Long_Integer (NT (Str)); + end; + + -- Normal case where Str'Last < Positive'Last + + else + declare + V : Long_Long_Integer; + P : aliased Integer := Str'First; + begin + V := Scan_Long_Long_Integer (Str, P'Access, Str'Last); + Scan_Trailing_Blanks (Str, P); + return V; + end; + end if; end Value_Long_Long_Integer; end System.Val_LLI; diff --git a/gcc/ada/s-valllu.adb b/gcc/ada/s-valllu.adb index 3315b1d7c7f..90ce099c623 100644 --- a/gcc/ada/s-valllu.adb +++ b/gcc/ada/s-valllu.adb @@ -294,12 +294,30 @@ package body System.Val_LLU is function Value_Long_Long_Unsigned (Str : String) return Long_Long_Unsigned is - V : Long_Long_Unsigned; - P : aliased Integer := Str'First; begin - V := Scan_Long_Long_Unsigned (Str, P'Access, Str'Last); - Scan_Trailing_Blanks (Str, P); - return V; + -- We have to special case Str'Last = Positive'Last because the normal + -- circuit ends up setting P to Str'Last + 1 which is out of bounds. We + -- deal with this by converting to a subtype which fixes the bounds. + + if Str'Last = Positive'Last then + declare + subtype NT is String (1 .. Str'Length); + begin + return Value_Long_Long_Unsigned (NT (Str)); + end; + + -- Normal case where Str'Last < Positive'Last + + else + declare + V : Long_Long_Unsigned; + P : aliased Integer := Str'First; + begin + V := Scan_Long_Long_Unsigned (Str, P'Access, Str'Last); + Scan_Trailing_Blanks (Str, P); + return V; + end; + end if; end Value_Long_Long_Unsigned; end System.Val_LLU; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2c4d531f9e0..3ced30d6feb 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8087,10 +8087,6 @@ package body Sem_Prag is Subp : Entity_Id; Applies : Boolean; - Effective : Boolean := False; - -- Set True if inline has some effect, i.e. if there is at least one - -- subprogram set as inlined as a result of the use of the pragma. - procedure Make_Inline (Subp : Entity_Id); -- Subp is the defining unit name of the subprogram declaration. Set -- the flag, as well as the flag in the corresponding body, if there @@ -8348,7 +8344,6 @@ package body Sem_Prag is if not Has_Pragma_Inline (Subp) then Set_Has_Pragma_Inline (Subp); - Effective := True; end if; end if; @@ -8392,7 +8387,6 @@ package body Sem_Prag is Check_Error_Detected; Applies := True; - Effective := True; else Make_Inline (Subp); @@ -8416,20 +8410,6 @@ package body Sem_Prag is if not Applies then Error_Pragma_Arg ("inappropriate argument for pragma%", Assoc); - - elsif not Effective - and then Warn_On_Redundant_Constructs - and then not (Status = Suppressed or else Suppress_All_Inlining) - then - if Inlining_Not_Possible (Subp) then - Error_Msg_NE - ("pragma Inline for& is ignored?r?", - N, Entity (Subp_Id)); - else - Error_Msg_NE - ("pragma Inline for& is redundant?r?", - N, Entity (Subp_Id)); - end if; end if; Next (Assoc); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 73b1e366d7e..673a7530cd2 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -962,7 +962,6 @@ package Snames is Name_Adjacent : constant Name_Id := N + $; Name_Ceiling : constant Name_Id := N + $; Name_Copy_Sign : constant Name_Id := N + $; - Name_Enum_Image : constant Name_Id := N + $; Name_Floor : constant Name_Id := N + $; Name_Fraction : constant Name_Id := N + $; Name_From_Any : constant Name_Id := N + $; -- GNAT @@ -1590,7 +1589,6 @@ package Snames is Attribute_Adjacent, Attribute_Ceiling, Attribute_Copy_Sign, - Attribute_Enum_Image, Attribute_Floor, Attribute_Fraction, Attribute_From_Any,