[Ada] Exit statement in loops over iterable objects
authorEd Schonberg <schonberg@adacore.com>
Mon, 21 May 2018 14:52:00 +0000 (14:52 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Mon, 21 May 2018 14:52:00 +0000 (14:52 +0000)
This patch fixes an omission in the expansion of loops over GNAT-specific
iterable objects. If the source includes an explicit name for the loop,
that name has to be preserved in the expanded code to allow exit statements
to mention it.

2018-05-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

* exp_ch5.adb (Build_Formal_Container_Iteration): If source has
explicit name for iterator loop, preserve that name in expanded
construct, for possible use in exit statements.

gcc/testsuite/

* gnat.dg/exit1.adb: New testcase.

From-SVN: r260465

gcc/ada/ChangeLog
gcc/ada/exp_ch5.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/exit1.adb [new file with mode: 0644]

index d21a5d95b23ad02ca606f6c017216781dde00262..b29b3abf6d11c1f328064f226fd510c7a9fa5b24 100644 (file)
@@ -1,3 +1,9 @@
+2018-05-21  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch5.adb (Build_Formal_Container_Iteration): If source has
+       explicit name for iterator loop, preserve that name in expanded
+       construct, for possible use in exit statements.
+
 2018-04-04  Javier Miranda  <miranda@adacore.com>
 
        * sem_ch4.adb (Analyze_Membership_Op): Avoid compiler crash when the
index 3407e8556c4471187cbe45842da616937f520de4..ff6bcc6211c6e97eac86cd5a7e087477f51bbeac 100644 (file)
@@ -237,6 +237,15 @@ package body Exp_Ch5 is
                     New_Occurrence_Of (Cursor, Loc)))),
           Statements => Stats,
           End_Label  => Empty);
+
+      --  If the contruct has a specified loop name, preserve it in the
+      --  new loop, for possible use in exit statements.
+
+      if Present (Identifier (N))
+        and then Comes_From_Source (Identifier (N))
+      then
+         Set_Identifier (New_Loop, Identifier (N));
+      end if;
    end Build_Formal_Container_Iteration;
 
    ------------------------------
index 44e581ea1491a6ae7e43fd5b353121a1156cdae9..923c65b09c3f60fdc64c522775171d9d84b14595 100644 (file)
@@ -1,3 +1,7 @@
+2018-04-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/exit1.adb: New testcase.
+
 2018-04-04  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/array30.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/exit1.adb b/gcc/testsuite/gnat.dg/exit1.adb
new file mode 100644 (file)
index 0000000..2598e7e
--- /dev/null
@@ -0,0 +1,45 @@
+--  { dg-do run }
+--  { dg-output "1 2 3 4 5 6 7 \| 1- 1 2 3 2- 1 2 3 3- 1 2 3 4- 1 2 3 5- 1 2 3" }
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Exit1 is
+   type Int_Range is record
+      First, Last : Integer;
+   end record
+      with Iterable => (First => First,
+                        Next => Next,
+                        Previous => Previous,
+                        Last => Last,
+                        Has_Element => Has_Element,
+                        Element => Element);
+
+   function First (IR : Int_Range) return Integer is (IR.First);
+   function Last (IR : Int_Range) return Integer is (IR.Last);
+   function Next (IR : Int_Range; N : Integer) return Integer is (N + 1);
+   function Previous (IR : Int_Range; N : Integer) return Integer is (N - 1);
+   function Has_Element (IR : Int_Range; N : Integer) return Boolean is
+     (N in IR.First ..IR.Last);
+   function Element (IR : Int_Range; N : Integer) return Integer is (N);
+
+   IR : Int_Range := (1, 10);
+
+begin
+A_Loop:   for I of IR loop
+      Put (I'Img);
+      exit A_Loop when I = 7;
+   end loop A_Loop;
+   Put (" | ");
+
+B_Loop:   for I of IR loop
+      Put (I'Img & '-');
+  C_Loop : for J of IR loop
+         Put (J'Img);
+         exit when J = 3;
+      end loop C_Loop;
+
+      exit B_Loop when I = 5;
+   end loop B_Loop;
+   New_Line;
+
+end Exit1;