[Ada] Make loop labels unique for front-end inlined calls

This patch transforms loop labels in the body of subprograms that are to
be inlined by the front-end, to prevent accidental duplication of loop
labels, which might make the resulting source illegal.

----
Source program:
----
package P is
   procedure Get_Rom_Addr_Offset
     with Inline_Always;
end P;
----
package body P is
   procedure Get_Rom_Addr_Offset is
      X : Integer;
   begin
      Main_Block :
      for I in 1 .. 10 loop
         X := 2;
         exit Main_Block when I > 4;
      other_loop:
         for J in character'('a') .. 'z' loop
            if I < 5 then
               exit Main_Block when J = 'k';
            else
               Exit Other_Loop;
            end if;
         end loop other_loop;
      end loop Main_Block;
   end Get_Rom_Addr_Offset;

   procedure P2 is
   begin
      Main_Block :
      for I in 1 .. 1 loop
         Get_Rom_Addr_Offset;
      end loop Main_Block;
   end P2;
end P;
----
Command:

   gcc -c -gnatN -gnatd.u -gnatDG p.adb

----
Output
----

package body p is

   procedure p__get_rom_addr_offset is
      x : integer;
      other_loop : label
      main_block : label
   begin
      main_block : for i in 1 .. 10 loop
         x := 2;
         exit main_block when i > 4;
         other_loop : for j in 'a' .. 'z' loop
            if i < 5 then
               exit main_block when j = 'k';
            else
               exit other_loop;
            end if;
         end loop other_loop;
      end loop main_block;
      return;
   end p__get_rom_addr_offset;

   procedure p__p2 is
      main_block : label
   begin
      main_block : for i in 1 .. 1 loop
         B6b : declare
            x : integer;
            other_loopL10b : label
            main_blockL9b : label
         begin
            main_blockL9b : for i in 1 .. 10 loop
               x := 2;
               exit main_blockL9b when i > 4;
               other_loopL10b : for j in 'a' .. 'z' loop
                  if i < 5 then
                     exit main_blockL9b when j = 'k';
                  else
                     exit other_loopL10b;
                  end if;
               end loop other_loopL10b;
            end loop main_blockL9b;
         end B6b;
      end loop main_block;
      return;
   end p__p2;
begin
   null;
end p;

2019-07-03  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* inline.adb (Make_Loop_Labels_Unique):  New procedure to modify
	the source code of subprograms that are inlined by the
	front-end, to prevent accidental duplication between loop labels
	in the inlined code and the code surrounding the inlined call.

From-SVN: r272967

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2115a38381569c743fff498e029321d50309f3e3..443947c9c0cb19646d48d1d69b2a77bd26507502 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-03  Ed Schonberg  <schonberg@adacore.com>
+
+       * inline.adb (Make_Loop_Labels_Unique):  New procedure to modify
+       the source code of subprograms that are inlined by the
+       front-end, to prevent accidental duplication between loop labels
+       in the inlined code and the code surrounding the inlined call.
+
 2019-07-03  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * doc/gnat_ugn/elaboration_order_handling_in_gnat.rst: Update

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 709513df08bbe4846a18f50bef4176c889d36ba7..ae1c217c7fbffd845caeacdde0b5f69fdfe202e4 100644 (file)
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -2381,6 +2381,11 @@ package body Inline is
       --  When generating C code, declare _Result, which may be used in the
       --  inlined _Postconditions procedure to verify the return value.
 
+      procedure Make_Loop_Labels_Unique (Stats : Node_Id);
+      --  When compiling for CCG and performing front-end inlining, replace
+      --  loop names and references to them so that they do not conflict
+      --  with homographs in the current subprogram.
+
       procedure Make_Exit_Label;
       --  Build declaration for exit label to be used in Return statements,
       --  sets Exit_Lab (the label node) and Lab_Decl (corresponding implicit
@@ -2474,6 +2479,59 @@ package body Inline is
          end if;
       end Make_Exit_Label;
 
+      -----------------------------
+      -- Make_Loop_Labels_Unique --
+      -----------------------------
+
+      procedure Make_Loop_Labels_Unique (Stats : Node_Id) is
+         S : Node_Id;
+
+         function Process_Loop (N : Node_Id) return Traverse_Result;
+
+         ------------------
+         -- Process_Loop --
+         ------------------
+
+         function Process_Loop (N : Node_Id) return Traverse_Result is
+            Id  : Entity_Id;
+
+         begin
+            if Nkind (N) = N_Loop_Statement
+              and then Present (Identifier (N))
+            then
+
+               --  Create new external name for loop. and update the
+               --  corresponding entity.
+
+               Id := Entity (Identifier (N));
+               Set_Chars (Id, New_External_Name (Chars (Id), 'L', -1));
+               Set_Chars (Identifier (N), Chars (Id));
+
+            elsif Nkind (N) = N_Exit_Statement
+              and then Present (Name (N))
+            then
+
+               --  The exit statement must name an enclosing loop, whose
+               --  name has already been updated.
+
+               Set_Chars (Name (N), Chars (Entity (Name (N))));
+            end if;
+
+            return OK;
+         end Process_Loop;
+
+         procedure Update_Loop_Names is new Traverse_Proc (Process_Loop);
+
+      begin
+         if Modify_Tree_For_C then
+            S := First (Statements (Stats));
+            while Present (S) loop
+               Update_Loop_Names (S);
+               Next (S);
+            end loop;
+         end if;
+      end Make_Loop_Labels_Unique;
+
       ---------------------
       -- Process_Formals --
       ---------------------
@@ -2742,6 +2800,8 @@ package body Inline is
          Fst : constant Node_Id := First (Statements (HSS));
 
       begin
+         Make_Loop_Labels_Unique (HSS);
+
          --  Optimize simple case: function body is a single return statement,
          --  which has been expanded into an assignment.
 
@@ -2829,6 +2889,8 @@ package body Inline is
          HSS  : constant Node_Id := Handled_Statement_Sequence (Blk);
 
       begin
+         Make_Loop_Labels_Unique (HSS);
+
          --  If there is a transient scope for N, this will be the scope of the
          --  actions for N, and the statements in Blk need to be within this
          --  scope. For example, they need to have visibility on the constant