This patch handles properly Ada 2012 loops whose iterator specification is
a qualified expression whose type is derived from an iterator type.
Executing
gnatmake -q ice_primes_2.adb
ice_primes_2
must yield:
3
5
7
11
13
17
19
23
29
31
---
with Ada.Text_IO;
with F552A00_Prime_Numbers; use F552A00_Prime_Numbers;
procedure ICE_Primes_2 is
It : constant Prime_Number_Set
:= Prime_Number_Set'(Max_Value => 32);
begin
for P in It
loop
Ada.Text_IO.Put_Line (P'Img);
end loop;
end ICE_Primes_2;
---
with Ada.Iterator_Interfaces;
with Ada.Strings.Unbounded; use Ada;
package F552A00_Prime_Numbers is
-- This package defines a simple Iterator Type that represents a
-- set of prime numbers from 1 to N.
function Is_Prime (Value : Natural) return Boolean;
package Prime_Number_Iterator is new Ada.Iterator_Interfaces (
Cursor => Natural,
Has_Element => Is_Prime);
type Prime_Number_Set (Max_Value : Natural) is new
Prime_Number_Iterator.Forward_Iterator with null record;
-- A Prime_Number_Set represents all the prime numbers between
-- 1 and Max_Value. Two is not considered to be a prime number.
-- Max_Value may or may not be a prime number
overriding function First (Object : Prime_Number_Set) return Natural;
overriding function Next
(Object : Prime_Number_Set;
Value : Natural)
return Natural;
function Iterate
(Set : Prime_Number_Set)
return Prime_Number_Iterator.Forward_Iterator'Class;
TC_Call_History : Strings.Unbounded.Unbounded_String;
--
-- A string capturing the call sequence to the above subprogams.
-- The following gets appended to the history for the above calls;
-- Iterate => I
-- First => 1
-- Next => N( nn) where nn is the next prime number
-- Is_Prime => H:{T|F}( nn) H is the Has_Element function
-- T means Has_Element returned True
-- F means Has_Element returns False
-- nn is the current prime number
end F552A00_Prime_Numbers;
---
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
package body F552A00_Prime_Numbers is
Disable_History : Boolean := False;
-- Used to disable call history for calls to Is_Prime that are internal
-- and not called as a result of loop iteration.
function First (Object : Prime_Number_Set) return Natural is
begin
-- The first prime number is 3, unless the Prime_Number_Set only
-- goes up to 2 or less, in which case a non-prime number is returned
-- since the set does not contain a prime number.
Ada.Strings.Unbounded.Append (Source => TC_Call_History,
New_Item => '1');
return (if Object.Max_Value >= 3 then 3 else Object.Max_Value);
end First;
function Next
(Object : Prime_Number_Set;
Value : Natural)
return Natural is
begin
-- Disable logging of calls to Is_Prime inside this loop, since these
-- calls are not directly related to iterator types.
Disable_History := True;
for I in Value + 1 .. Object.Max_Value loop
if Is_Prime (I) then
Ada.Strings.Unbounded.Append
(Source => TC_Call_History,
New_Item => "N(" & Integer'Image (I) & ')');
Disable_History := False;
return I;
end if;
end loop;
Disable_History := False;
Ada.Strings.Unbounded.Append
(Source => TC_Call_History,
New_Item => "N(" & Integer'Image (Value + 1) & ')');
return Value + 1;
end Next;
function Is_Prime (Value : Natural) return Boolean is
begin
for I in 2 .. Integer (Sqrt (Float (Value))) loop
if Value mod I = 0 then
-- Not a prime number
if not Disable_History then
Ada.Strings.Unbounded.Append
(Source => TC_Call_History,
New_Item => "H:F(" & Integer'Image (Value) & ')');
end if;
return False;
end if;
end loop;
-- Is a prime number if the value is > 2.
if not Disable_History then
Ada.Strings.Unbounded.Append
(Source => TC_Call_History,
New_Item => "H:" &
(if Value > 2 then "T(" else "F(") &
Integer'Image (Value) &
')');
end if;
return (Value > 2);
end Is_Prime;
function Iterate
(Set : Prime_Number_Set)
return Prime_Number_Iterator.Forward_Iterator'Class is
begin
Ada.Strings.Unbounded.Append (Source => TC_Call_History,
New_Item => 'I');
return Result : Prime_Number_Set (Set.Max_Value) do
null;
end return;
end Iterate;
end F552A00_Prime_Numbers;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-04-18 Ed Schonberg <schonb...@adacore.com>
* sem_ch5.adb (Get_Cursor_Type): If iterator type is a derived
type, the cursor is declared in the scope of the parent type.
(Analyze_Parameter_Specification): A qualified expression with an
iterator type indicates an iteration over a container (explicit
or implicit).
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 235093)
+++ sem_ch5.adb (working copy)
@@ -1795,7 +1795,15 @@
Ent : Entity_Id;
begin
- Ent := First_Entity (Scope (Typ));
+ -- If iterator type is derived, the cursor is declared in the scope
+ -- of the parent type.
+
+ if Is_Derived_Type (Typ) then
+ Ent := First_Entity (Scope (Etype (Typ)));
+ else
+ Ent := First_Entity (Scope (Typ));
+ end if;
+
while Present (Ent) loop
exit when Chars (Ent) = Name_Cursor;
Next_Entity (Ent);
@@ -2747,8 +2755,9 @@
-- a) a function call,
-- b) an identifier that is not a type,
- -- c) an attribute reference 'Old (within a postcondition)
- -- d) an unchecked conversion
+ -- c) an attribute reference 'Old (within a postcondition),
+ -- d) an unchecked conversion or a qualified expression with
+ -- the proper iterator type.
-- then it is an iteration over a container. It was classified as
-- a loop specification by the parser, and must be rewritten now
@@ -2758,13 +2767,19 @@
-- conversion is always an object.
if Nkind (DS_Copy) = N_Function_Call
+
or else (Is_Entity_Name (DS_Copy)
and then not Is_Type (Entity (DS_Copy)))
+
or else (Nkind (DS_Copy) = N_Attribute_Reference
and then Nam_In (Attribute_Name (DS_Copy),
- Name_Old, Name_Loop_Entry))
+ Name_Loop_Entry, Name_Old))
+
+ or else Has_Aspect (Etype (DS_Copy), Aspect_Iterable)
+
or else Nkind (DS_Copy) = N_Unchecked_Type_Conversion
- or else Has_Aspect (Etype (DS_Copy), Aspect_Iterable)
+ or else (Nkind (DS_Copy) = N_Qualified_Expression
+ and then Is_Iterator (Etype (DS_Copy)))
then
-- This is an iterator specification. Rewrite it as such and
-- analyze it to capture function calls that may require
@@ -3138,11 +3153,13 @@
Set_Parent (DS_Copy, Parent (DS));
Preanalyze_Range (DS_Copy);
- -- Check for a call to Iterate ()
+ -- Check for a call to Iterate () or an expression with
+ -- an iterator type.
return
- Nkind (DS_Copy) = N_Function_Call
- and then Needs_Finalization (Etype (DS_Copy));
+ (Nkind (DS_Copy) = N_Function_Call
+ and then Needs_Finalization (Etype (DS_Copy)))
+ or else Is_Iterator (Etype (DS_Copy));
end;
end if;
end Is_Container_Iterator;
