aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2018-05-21 14:52:00 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-05-21 14:52:00 +0000
commitdef6e435f48990bcf8aebe9432b9b1aea593e4e9 (patch)
treee821f59a8417f74b5874e7b640cc4c83286cb6eb
parent0d8b6803b9abafea59b08702a582605316544245 (diff)
downloadgcc-def6e435f48990bcf8aebe9432b9b1aea593e4e9.zip
gcc-def6e435f48990bcf8aebe9432b9b1aea593e4e9.tar.gz
gcc-def6e435f48990bcf8aebe9432b9b1aea593e4e9.tar.bz2
[Ada] Exit statement in loops over iterable objects
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
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/exp_ch5.adb9
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/exit1.adb45
4 files changed, 64 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d21a5d9..b29b3ab 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 3407e85..ff6bcc6 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -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;
------------------------------
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 44e581e..923c65b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
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.
2018-04-04 Hristian Kirtchev <kirtchev@adacore.com>
diff --git a/gcc/testsuite/gnat.dg/exit1.adb b/gcc/testsuite/gnat.dg/exit1.adb
new file mode 100644
index 0000000..2598e7e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/exit1.adb
@@ -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;