-- disc.adb

-- The following procedure compiles without error yet dies in execution
-- on most compilers, when Integer is used in place of type My_Range.

with Ada.Text_IO ; use Ada.Text_IO ;
procedure Disc is

  I : Integer ;
  subtype My_Range is Integer range 1..20 ;

  type My_Array is array ( My_Range range <> ) of Integer ;

  type Variable(Size : My_Range := 5) is -- NOT Integer or Positive !!
    record
      Changes : My_Array(1..Size) ;
    end record ;

  Five : Variable := ( 5 ,( 1 , 2 , 3 , 4 , 5 )) ; -- actual = default
  Four : Variable(4) := ( 4 ,( 1 , 2 , 3 , 4 )) ; -- smaller
  Any  : Variable ; -- default until (complete) Variable initialized

begin
  Put_Line("Running Disc");

  I := Five.Changes(5) ; -- get fifth element of array from record Five
  Put_Line(Integer'Image(I) & " = 5"); -- just checking

  I := Four.Changes(4) ;
  Put_Line(Integer'Image(I) & " = 4"); -- just checking

  Any.Changes(5) := 99;        -- just chacking that default in place.
  Any := ( 3 ,( 1 , 2 , 3 )) ; --(complete) value redefines constraints
  I := Any.Changes(3) ;
  Put_Line(Integer'Image(I) & " = 3"); -- check it made it
  Put_Line(Integer'Image(Any.Size) & " = 3"); -- check discriminant

  Any := ( 10 ,( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 )) ;
  I := Any.Changes(10) ;
  Put_Line(Integer'Image(I) & " = 10") ; -- be sure larger than default

  Any := ( 2 ,( 1 , 2 )) ; -- redefined small again
  Put_Line("Expect Constraint Error");
  I := Any.Changes(5);  -- should get constraint error here

  Put_Line(Integer'Image(I) & " = error !") ;
exception
  when Constraint_Error =>
    Put_Line("Got Constraint Error");
    Put_Line("size in bytes of Any  = " & Integer'Image(Any'Size));
    Put_Line("size in bytes of Four = " & Integer'Image(Four'Size));
    Put_Line("size in bytes of Five = " & Integer'Image(Five'Size));
    Put_Line("size in bytes of Variable = " & Integer'Image(Variable'Size));
end Disc;