snames.ads-tmpl: Remove entries for attribute Enum_Image.
authorRobert Dewar <dewar@adacore.com>
Tue, 6 Jan 2015 10:01:05 +0000 (10:01 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 6 Jan 2015 10:01:05 +0000 (11:01 +0100)
2015-01-06  Robert Dewar  <dewar@adacore.com>

* snames.ads-tmpl: Remove entries for attribute Enum_Image.
* exp_attr.adb: Remove reference to Attribute_Enum_Image.

2015-01-06  Robert Dewar  <dewar@adacore.com>

* 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  <dewar@adacore.com>

* sem_prag.adb (Process_Inline): Remove redundant construct
warning (-gnatw.r) for an ineffective pragma Inline.

From-SVN: r219244

gcc/ada/ChangeLog
gcc/ada/exp_attr.adb
gcc/ada/s-vallli.adb
gcc/ada/s-valllu.adb
gcc/ada/sem_prag.adb
gcc/ada/snames.ads-tmpl

index 7b2ec9d..7eeb8cc 100644 (file)
@@ -1,5 +1,22 @@
 2015-01-06  Robert Dewar  <dewar@adacore.com>
 
+       * snames.ads-tmpl: Remove entries for attribute Enum_Image.
+       * exp_attr.adb: Remove reference to Attribute_Enum_Image.
+
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+       * 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  <dewar@adacore.com>
+
+       * sem_prag.adb (Process_Inline): Remove redundant construct
+       warning (-gnatw.r) for an ineffective pragma Inline.
+
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
        * s-valint.adb: Fix typo in last checkin.
        * s-valuns.adb (Value_Unsigned): More efficient fix for
        Positive'Last case.
index 5a66e3f..74b013e 100644 (file)
@@ -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                  |
index 203e475..bf0e15d 100644 (file)
@@ -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;
index 3315b1d..90ce099 100644 (file)
@@ -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;
index 2c4d531..3ced30d 100644 (file)
@@ -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);
index 73b1e36..673a753 100644 (file)
@@ -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,