sem_ch6.adb (Is_Inline_Pragma): The pragma argument can be a selected component...

2016-04-18  Bob Duff  <duff@adacore.com>

	* sem_ch6.adb (Is_Inline_Pragma): The pragma
	argument can be a selected component, which has no Chars field,
	so we need to deal with that case (use the Selector_Name).
	(Check_Inline_Pragma): We need to test Is_List_Member before
	calling In_Same_List, because in case of a library unit, they're
	not in lists, so In_Same_List fails an assertion.

2016-04-18  Bob Duff  <duff@adacore.com>

	* namet.ads, namet.adb: Add an Append that appends a
	Bounded_String onto a Bounded_String. Probably a little more
	efficient than "Append(X, +Y);". Also minor cleanup.
	(Append_Decoded, Append_Decoded_With_Brackets, Append_Unqualified,
	Append_Unqualified_Decoded): Make sure these work with non-empty
	buffers.
	* casing.ads, casing.adb (Set_Casing): Pass a Bounded_String
	parameter, defaulting to Global_Name_Buffer.
	* errout.ads, errout.adb (Adjust_Name_Case): Pass a
	Bounded_String parameter, no default.
	* exp_ch11.adb (Expand_N_Raise_Statement): Use local
	Bounded_String instead of Global_Name_Buffer.
	* exp_intr.ads, exp_intr.adb (Write_Entity_Name): Rename it
	to Append_Entity_Name, and pass a Bounded_String parameter,
	instead of using globals.
	(Add_Source_Info): Pass a Bounded_String parameter, instead of
	using globals.
	(Expand_Source_Info): Use local instead of globals.
	* stringt.ads, stringt.adb (Append): Add an Append procedure
	for appending a String_Id onto a Bounded_String.
	(String_To_Name_Buffer, Add_String_To_Name_Buffer): Rewrite in
	terms of Append.
	* sem_prag.adb (Set_Error_Msg_To_Profile_Name): Adjust for new
	Adjust_Name_Case parameter.
	* erroutc.adb, uname.adb: Don't pass D => Mixed_Case to
	Set_Casing; that's the default.
	* lib-xref-spark_specific.adb (Add_SPARK_Scope): Pretend that calls to
	protected subprograms are entry calls; otherwise it is not possible to
	distinguish them from regular subprogram calls.

From-SVN: r235129

1 files changed, 113 insertions, 94 deletions

diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 4ba68df..9972aa9 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -137,6 +137,11 @@ package body Namet is
       end loop;
    end Append;
 
+   procedure Append (Buf : in out Bounded_String; Buf2 : Bounded_String) is
+   begin
+      Append (Buf, Buf2.Chars (1 .. Buf2.Length));
+   end Append;
+
    procedure Append (Buf : in out Bounded_String; Id : Name_Id) is
       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
       S : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
@@ -154,26 +159,27 @@ package body Namet is
    procedure Append_Decoded (Buf : in out Bounded_String; Id : Name_Id) is
       C : Character;
       P : Natural;
+      Temp : Bounded_String;
 
    begin
-      Append (Buf, Id);
+      Append (Temp, Id);
 
       --  Skip scan if we already know there are no encodings
 
       if Name_Entries.Table (Id).Name_Has_No_Encodings then
-         return;
+         goto Done;
       end if;
 
       --  Quick loop to see if there is anything special to do
 
       P := 1;
       loop
-         if P = Buf.Length then
+         if P = Temp.Length then
             Name_Entries.Table (Id).Name_Has_No_Encodings := True;
-            return;
+            goto Done;
 
          else
-            C := Buf.Chars (P);
+            C := Temp.Chars (P);
 
             exit when
               C = 'U' or else
@@ -190,10 +196,10 @@ package body Namet is
       Decode : declare
          New_Len : Natural;
          Old     : Positive;
-         New_Buf : String (1 .. Buf.Chars'Last);
+         New_Buf : String (1 .. Temp.Chars'Last);
 
          procedure Copy_One_Character;
-         --  Copy a character from Buf.Chars to New_Buf. Includes case
+         --  Copy a character from Temp.Chars to New_Buf. Includes case
          --  of copying a Uhh,Whhhh,WWhhhhhhhh sequence and decoding it.
 
          function Hex (N : Natural) return Word;
@@ -210,14 +216,14 @@ package body Namet is
             C : Character;
 
          begin
-            C := Buf.Chars (Old);
+            C := Temp.Chars (Old);
 
             --  U (upper half insertion case)
 
             if C = 'U'
-              and then Old < Buf.Length
-              and then Buf.Chars (Old + 1) not in 'A' .. 'Z'
-              and then Buf.Chars (Old + 1) /= '_'
+              and then Old < Temp.Length
+              and then Temp.Chars (Old + 1) not in 'A' .. 'Z'
+              and then Temp.Chars (Old + 1) /= '_'
             then
                Old := Old + 1;
 
@@ -237,8 +243,8 @@ package body Namet is
             --  WW (wide wide character insertion)
 
             elsif C = 'W'
-              and then Old < Buf.Length
-              and then Buf.Chars (Old + 1) = 'W'
+              and then Old < Temp.Length
+              and then Temp.Chars (Old + 1) = 'W'
             then
                Old := Old + 2;
                Widechar.Set_Wide (Char_Code (Hex (8)), New_Buf, New_Len);
@@ -246,9 +252,9 @@ package body Namet is
             --  W (wide character insertion)
 
             elsif C = 'W'
-              and then Old < Buf.Length
-              and then Buf.Chars (Old + 1) not in 'A' .. 'Z'
-              and then Buf.Chars (Old + 1) /= '_'
+              and then Old < Temp.Length
+              and then Temp.Chars (Old + 1) not in 'A' .. 'Z'
+              and then Temp.Chars (Old + 1) /= '_'
             then
                Old := Old + 1;
                Widechar.Set_Wide (Char_Code (Hex (4)), New_Buf, New_Len);
@@ -271,7 +277,7 @@ package body Namet is
 
          begin
             for J in 1 .. N loop
-               C := Buf.Chars (Old);
+               C := Temp.Chars (Old);
                Old := Old + 1;
 
                pragma Assert (C in '0' .. '9' or else C in 'a' .. 'f');
@@ -304,12 +310,12 @@ package body Namet is
 
          --  Loop through characters of name
 
-         while Old <= Buf.Length loop
+         while Old <= Temp.Length loop
 
             --  Case of character literal, put apostrophes around character
 
-            if Buf.Chars (Old) = 'Q'
-              and then Old < Buf.Length
+            if Temp.Chars (Old) = 'Q'
+              and then Old < Temp.Length
             then
                Old := Old + 1;
                Insert_Character (''');
@@ -318,10 +324,10 @@ package body Namet is
 
             --  Case of operator name
 
-            elsif Buf.Chars (Old) = 'O'
-              and then Old < Buf.Length
-              and then Buf.Chars (Old + 1) not in 'A' .. 'Z'
-              and then Buf.Chars (Old + 1) /= '_'
+            elsif Temp.Chars (Old) = 'O'
+              and then Old < Temp.Length
+              and then Temp.Chars (Old + 1) not in 'A' .. 'Z'
+              and then Temp.Chars (Old + 1) /= '_'
             then
                Old := Old + 1;
 
@@ -362,8 +368,8 @@ package body Namet is
 
                   J := Map'First;
                   loop
-                     exit when Buf.Chars (Old) = Map (J)
-                       and then Buf.Chars (Old + 1) = Map (J + 1);
+                     exit when Temp.Chars (Old) = Map (J)
+                       and then Temp.Chars (Old + 1) = Map (J + 1);
                      J := J + 4;
                   end loop;
 
@@ -380,8 +386,8 @@ package body Namet is
 
                      --  Skip past original operator name in input
 
-                     while Old <= Buf.Length
-                       and then Buf.Chars (Old) in 'a' .. 'z'
+                     while Old <= Temp.Length
+                       and then Temp.Chars (Old) in 'a' .. 'z'
                      loop
                         Old := Old + 1;
                      end loop;
@@ -392,8 +398,8 @@ package body Namet is
                   else
                      --  Copy original operator name from input to output
 
-                     while Old <= Buf.Length
-                        and then Buf.Chars (Old) in 'a' .. 'z'
+                     while Old <= Temp.Length
+                        and then Temp.Chars (Old) in 'a' .. 'z'
                      loop
                         Copy_One_Character;
                      end loop;
@@ -411,9 +417,12 @@ package body Namet is
 
          --  Copy new buffer as result
 
-         Buf.Length := New_Len;
-         Buf.Chars (1 .. New_Len) := New_Buf (1 .. New_Len);
+         Temp.Length := New_Len;
+         Temp.Chars (1 .. New_Len) := New_Buf (1 .. New_Len);
       end Decode;
+
+      <<Done>>
+      Append (Buf, Temp);
    end Append_Decoded;
 
    ----------------------------------
@@ -440,67 +449,73 @@ package body Namet is
       --  Only remaining issue is U/W/WW sequences
 
       else
-         Append (Buf, Id);
+         declare
+            Temp : Bounded_String;
+         begin
+            Append (Temp, Id);
 
-         P := 1;
-         while P < Buf.Length loop
-            if Buf.Chars (P + 1) in 'A' .. 'Z' then
-               P := P + 1;
+            P := 1;
+            while P < Temp.Length loop
+               if Temp.Chars (P + 1) in 'A' .. 'Z' then
+                  P := P + 1;
 
-            --  Uhh encoding
+               --  Uhh encoding
 
-            elsif Buf.Chars (P) = 'U' then
-               for J in reverse P + 3 .. P + Buf.Length loop
-                  Buf.Chars (J + 3) := Buf.Chars (J);
-               end loop;
+               elsif Temp.Chars (P) = 'U' then
+                  for J in reverse P + 3 .. P + Temp.Length loop
+                     Temp.Chars (J + 3) := Temp.Chars (J);
+                  end loop;
 
-               Buf.Length := Buf.Length + 3;
-               Buf.Chars (P + 3) := Buf.Chars (P + 2);
-               Buf.Chars (P + 2) := Buf.Chars (P + 1);
-               Buf.Chars (P)     := '[';
-               Buf.Chars (P + 1) := '"';
-               Buf.Chars (P + 4) := '"';
-               Buf.Chars (P + 5) := ']';
-               P := P + 6;
-
-            --  WWhhhhhhhh encoding
-
-            elsif Buf.Chars (P) = 'W'
-              and then P + 9 <= Buf.Length
-              and then Buf.Chars (P + 1) = 'W'
-              and then Buf.Chars (P + 2) not in 'A' .. 'Z'
-              and then Buf.Chars (P + 2) /= '_'
-            then
-               Buf.Chars (P + 12 .. Buf.Length + 2) :=
-                 Buf.Chars (P + 10 .. Buf.Length);
-               Buf.Chars (P)     := '[';
-               Buf.Chars (P + 1) := '"';
-               Buf.Chars (P + 10) := '"';
-               Buf.Chars (P + 11) := ']';
-               Buf.Length := Buf.Length + 2;
-               P := P + 12;
-
-            --  Whhhh encoding
-
-            elsif Buf.Chars (P) = 'W'
-              and then P < Buf.Length
-              and then Buf.Chars (P + 1) not in 'A' .. 'Z'
-              and then Buf.Chars (P + 1) /= '_'
-            then
-               Buf.Chars (P + 8 .. P + Buf.Length + 3) :=
-                 Buf.Chars (P + 5 .. Buf.Length);
-               Buf.Chars (P + 2 .. P + 5) := Buf.Chars (P + 1 .. P + 4);
-               Buf.Chars (P)     := '[';
-               Buf.Chars (P + 1) := '"';
-               Buf.Chars (P + 6) := '"';
-               Buf.Chars (P + 7) := ']';
-               Buf.Length := Buf.Length + 3;
-               P := P + 8;
+                  Temp.Length := Temp.Length + 3;
+                  Temp.Chars (P + 3) := Temp.Chars (P + 2);
+                  Temp.Chars (P + 2) := Temp.Chars (P + 1);
+                  Temp.Chars (P)     := '[';
+                  Temp.Chars (P + 1) := '"';
+                  Temp.Chars (P + 4) := '"';
+                  Temp.Chars (P + 5) := ']';
+                  P := P + 6;
+
+               --  WWhhhhhhhh encoding
+
+               elsif Temp.Chars (P) = 'W'
+                 and then P + 9 <= Temp.Length
+                 and then Temp.Chars (P + 1) = 'W'
+                 and then Temp.Chars (P + 2) not in 'A' .. 'Z'
+                 and then Temp.Chars (P + 2) /= '_'
+               then
+                  Temp.Chars (P + 12 .. Temp.Length + 2) :=
+                    Temp.Chars (P + 10 .. Temp.Length);
+                  Temp.Chars (P)     := '[';
+                  Temp.Chars (P + 1) := '"';
+                  Temp.Chars (P + 10) := '"';
+                  Temp.Chars (P + 11) := ']';
+                  Temp.Length := Temp.Length + 2;
+                  P := P + 12;
+
+               --  Whhhh encoding
+
+               elsif Temp.Chars (P) = 'W'
+                 and then P < Temp.Length
+                 and then Temp.Chars (P + 1) not in 'A' .. 'Z'
+                 and then Temp.Chars (P + 1) /= '_'
+               then
+                  Temp.Chars (P + 8 .. P + Temp.Length + 3) :=
+                    Temp.Chars (P + 5 .. Temp.Length);
+                  Temp.Chars (P + 2 .. P + 5) := Temp.Chars (P + 1 .. P + 4);
+                  Temp.Chars (P)     := '[';
+                  Temp.Chars (P + 1) := '"';
+                  Temp.Chars (P + 6) := '"';
+                  Temp.Chars (P + 7) := ']';
+                  Temp.Length := Temp.Length + 3;
+                  P := P + 8;
 
-            else
-               P := P + 1;
-            end if;
-         end loop;
+               else
+                  P := P + 1;
+               end if;
+            end loop;
+
+            Append (Buf, Temp);
+         end;
       end if;
    end Append_Decoded_With_Brackets;
 
@@ -564,9 +579,11 @@ package body Namet is
    ------------------------
 
    procedure Append_Unqualified (Buf : in out Bounded_String; Id : Name_Id) is
+      Temp : Bounded_String;
    begin
-      Append (Buf, Id);
-      Strip_Qualification_And_Suffixes (Buf);
+      Append (Temp, Id);
+      Strip_Qualification_And_Suffixes (Temp);
+      Append (Buf, Temp);
    end Append_Unqualified;
 
    --------------------------------
@@ -577,9 +594,11 @@ package body Namet is
      (Buf : in out Bounded_String;
       Id  : Name_Id)
    is
+      Temp : Bounded_String;
    begin
-      Append_Decoded (Buf, Id);
-      Strip_Qualification_And_Suffixes (Buf);
+      Append_Decoded (Temp, Id);
+      Strip_Qualification_And_Suffixes (Temp);
+      Append (Buf, Temp);
    end Append_Unqualified_Decoded;
 
    --------------
@@ -1625,9 +1644,9 @@ package body Namet is
    -- To_String --
    ---------------
 
-   function To_String (X : Bounded_String) return String is
+   function To_String (Buf : Bounded_String) return String is
    begin
-      return X.Chars (1 .. X.Length);
+      return Buf.Chars (1 .. Buf.Length);
    end To_String;
 
    ---------------