[Ada] Spurious discriminant check on type with unknown discriminants

[Arnaud Charlet <charlet at adacore dot com>]

This patch removes a spurious discriminant check on an generated assignment
statement in an iterator loop, when the cursor type is a type with unknown
discriminants, when the full view has discriminants with defaults.

Executing:

   gnatmake -f -q -g date_iteration_test.adb
   date_iteration_test

Must yield:

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10

2015-12-31 05:00:00
2016-01-01 05:00:00
2016-01-02 05:00:00
2016-01-03 05:00:00
2016-01-04 05:00:00
2016-01-05 05:00:00
2016-01-06 05:00:00
2016-01-07 05:00:00
2016-01-08 05:00:00
2016-01-09 05:00:00
2016-01-10 05:00:00

---

with Date_Iteration;
with Ada.Calendar.Formatting;
with Ada.Text_IO; use Ada.Text_IO;
procedure Date_Iteration_Test is
   use type Ada.Calendar.Time;
   Day : constant Duration := 86_400.0;
   Number : Natural := 0;
begin
   for D in Date_Iteration.Generator
     (Start_Time => Ada.Calendar.Clock,
      End_Time   => Ada.Calendar.Clock + Day * 10)
   loop
      Number := Number + 1;
      Put_Line (Number'Img);
   end loop;
   New_Line;
   for D of Date_Iteration.Generator
     (Start_Time => Ada.Calendar.Time_Of (2015, 12, 31),
      End_Time   => Ada.Calendar.Time_Of (2015, 12, 31) + Day * 10)
   loop
      Put_Line (Ada.Calendar.Formatting.Image (D));
   end loop;
end Date_Iteration_Test;
---
with Ada.Calendar;
with Ada.Iterator_Interfaces;
package Date_Iteration is

   type Cursor (<>) is private;

   function Has_Element (C : Cursor) return Boolean;
   function Date (C : Cursor) return Ada.Calendar.Time;

   package Iterator_Interfaces
     is new Ada.Iterator_Interfaces (Cursor, Has_Element);

   type Date_Set is new Iterator_Interfaces.Forward_Iterator with private
   with
     Constant_Indexing => Element,
     Default_Iterator  => Iterate,
     Iterator_Element  => Ada.Calendar.Time;

   function Element (Set : Date_Set; C : Cursor) return Ada.Calendar.Time;

   function Iterate (Set : Date_Set)
                    return Iterator_Interfaces.Forward_Iterator'Class;

   function Generator (Start_Time : Ada.Calendar.Time;
                       End_Time   : Ada.Calendar.Time;
                       Interval   : Duration := 86_400.0)
                      return Date_Set;
private
   type Cursor (Valid : Boolean := True) is record
      case Valid is
         when True =>
            Date : Ada.Calendar.Time;
         when False =>
            null;
      end case;
   end record;

   function Has_Element (C : Cursor) return Boolean is (C.Valid);

   function Date (C : Cursor) return Ada.Calendar.Time is (C.Date);

   type Date_Set is new Iterator_Interfaces.Forward_Iterator with record
      Start_Time : Ada.Calendar.Time;
      End_Time   : Ada.Calendar.Time;
      Interval   : Duration;
   end record;

   overriding
   function First (Object : Date_Set) return Cursor;
   overriding
   function Next (Object : Date_Set; Position : Cursor) return Cursor;

   function Element (Set : Date_Set; C : Cursor) return Ada.Calendar.Time
     is (C.Date);

   function Iterate (Set : Date_Set)
                    return Iterator_Interfaces.Forward_Iterator'Class
                      is (Set);
end Date_Iteration;
---
package body Date_Iteration is
   function Generator (Start_Time : Ada.Calendar.Time;
                       End_Time   : Ada.Calendar.Time;
                       Interval   : Duration := 86_400.0)
                      return Date_Set is
   begin
      return D : Date_Set do
         D := (Start_Time   => Start_Time,
               End_Time     => End_Time,
               Interval     => Interval);
      end return;
   end Generator;

   function First (Object : Date_Set) return Cursor is
      use type Ada.Calendar.Time;
   begin
      if Object.End_Time >= Object.Start_Time then
         return (Valid => True, Date => Object.Start_Time);
      else
         return (Valid => False);
      end if;
   end First;

   function Next (Object : Date_Set; Position : Cursor)
                 return Cursor is
      use type Ada.Calendar.Time;
      Next : Ada.Calendar.Time := Position.Date + Object.Interval;
   begin
      if Next > Object.End_Time then
         return (Valid => False);
      else
         return (Valid => True, Date => Next);
      end if;
   end Next;
end Date_Iteration;

Tested on x86_64-pc-linux-gnu, committed on trunk

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Do no generate
	a discriminant check for a type whose partial view has unknown
	discriminants when the full view has discriminants with defaults.

Attachment: difs
Description: Text document