with ada.command_line,
     ada.numerics.discrete_random,
     p9,
     testing;
procedure testp9 is
   use p9, testing;

--  This is a test driver for the extended precision arithmetic functions
--  defined in package "p9".
--  Its only purpose is to "exercise" the package,
--  in hopes of detecting any errors.

--  You may want to add more test cases, or more output to help
--  in isolating bugs.

   subtype randomrange is integer range -10_000 .. 10_000;
   package random is new ada.numerics.discrete_random
    (result_subtype => randomrange);
   g : random.generator;

   random_count     : integer := 0;  --  how many times to run random test

begin
   header("testp9");

   --  check command line for flags
   declare
      i : integer := 1;
      error_limit : integer := 20;
      use ada.command_line;
      function get_integer_argument return integer is
         value : integer;
      begin
         if i < argument_count then
            begin value := integer'value(argument(i+1));
               i := i + 1;
               return value;
            exception when others => null;
            end;
         end if;
         fail("command-line option requires an integer argument: "
             & argument(i) & " " & argument(i+1));
         set_error_limit(0);
         done;
         return 0;  -- to suppress compiler's warning
      end get_integer_argument;
   begin
      while i < argument_count loop
         if argument(i) = "-v" then
            null;  -- "-v" is handled by testing package
         elsif argument(i) = "-r" then
            random_count := get_integer_argument;
         elsif argument(i) = "-e" then
            error_limit := get_integer_argument;
         else fail("unrecognized command line argument: "
            & ada.command_line.argument(i));
            set_error_limit(0);
            done;
         end if;
         i := i + 1;
       end loop;
       set_error_limit(error_limit);
   end;
   
   test("value and image");
   declare
      r : extended_integer;
   begin
      r := value("1");
      require(image(r)="1",image(r)&" =? 1");
      r := value("123456789012345678901");
      require(image(r)="123456789012345678901",
        image(r)&" =? 123456789012345678901");
      r := value("0000000000000000000000000");
      require(image(r)="0",image(r)&" =? 0");
      r := value("-123");
      require(image(r)="-123",image(r)&" =? -123");
   exception
   when e : others => fail(e);
   end;

   test("extend and image");
   declare
      r : extended_integer;
   begin
      r := extend(1);
      require(image(r)="1",image(r)&" =? 1");
      r := extend(1234567890);
      require(image(r)="1234567890",image(r)&" =? 1234567890");
      r := extend(0);
      require(image(r)="0",image(r)&" =? 0");
      r := extend(-123);
      require(image(r)="-123",image(r)&" =? -123");
   exception
   when e : others => fail(e);
   end;

   test("value and shorten");
   declare
      r : extended_integer;
   begin
      r := value("1");
      require(shorten(r)=1,integer'image(shorten(r))&" =? 1");
      r := value("1234567");
      require(shorten(r)=1234567,integer'image(shorten(r))&" =? 1234567");
      r := value("000000000000000000000000");
      require(shorten(r)=0,integer'image(shorten(r))&" =? 0");
      r := value("-123");
      require(shorten(r)=-123,integer'image(shorten(r))&" =? -123");
   exception
   when e : others => fail(e);
   end;

   test("extend and shorten");
   declare
      r : extended_integer;
   begin
      require(shorten(extend(1)) = 1,integer'image(shorten(extend(1)))&" =? 1");
      require(shorten(extend(32)) = 32,integer'image(shorten(extend(32)))
        &" =? 32");
      require(shorten(extend(0)) = 0,integer'image(shorten(extend(0)))&" =? 0");
      require(shorten(extend(-1)) = -1,integer'image(shorten(extend(-1)))
        &" =? -1");
      require(shorten(extend(-32)) = -32,integer'image(shorten(extend(-32)))
        &" =? -32");
      test("extreme cases of shorten");
      r := extend(integer'last);
      require(shorten(r) = integer'last,
        integer'image(shorten(r))&" =? "&integer'image(integer'last));
      r := extend(integer'first);
      require(shorten(r) = integer'first,
        integer'image(shorten(r))&" =? "&integer'image(integer'first));
   exception
   when e : others => fail(e);
   end;

   test("shorten overflows by a lot");
   declare
      r : extended_integer;
   begin
      r := value("1234567890123456789012345678901234567890");
      except("should have overflowed: "&integer'image(shorten(r)));
   exception
   when overflow => null;
   when e : others => fail(e);
   end;

   test("shorten overflows by one");
   declare
      r : extended_integer;
   begin
      r := extend(integer'last) + extend(1);
      begin
         except("should have overflowed: "&integer'image(shorten(r))
           &" >? "&integer'image(integer'last));
      exception
      when overflow => null;
      when e : others => fail(e);
      end;
   exception
   when e : others => fail(e);
   end;

   test("shorten underflows by one");
   declare
      r : extended_integer;
   begin
      r := extend(integer'first) - extend(1);
      begin
         except("should have overflowed: "&integer'image(shorten(r))
           &" <? "&integer'image(integer'first));
      exception
      when overflow => null;
      when e : others => fail(e);
      end;
   exception
   when e : others => fail(e);
   end;

   test("monadic minus");
   declare
      r0 : extended_integer;
      r1 : extended_integer;
      r2 : extended_integer;
      r3 : extended_integer;
   begin
      r0 := extend(0);
      r1 := value("12345678901234567890123456789012341234");
      r2 := extend(3);
      r3 := value("-12345678901234567890123456789012341234");
      require(-r0 = r0,
        "U1: "&integer'image(shorten(-r0))&" =? "&integer'image(shorten(r0)));
      require(-(-r2) = r2,
        "U2: "&integer'image(shorten(-(-(r2))))
        &" =? "&integer'image(shorten(r2)));
      require(-r1 = r3,"U3: "&image(-r1)&" =? "&image(r3));
      require(not(-r1 = r1),"U4: "&image(-r1)&" =? "&image(r1));
      require(-r1 /= r1,"U5: "&image(-r1)&" /=? "&image(r1));
      require(-r3 = r1,"U6: "&image(-r3)&" =? "&image(r1));
      require(r2 = -extend(-3),"U7: "&image(r3)&" =? "&image(-extend(-3)));
   exception
   when e : others => fail(e);
   end;

   test("plus");
   declare
      r : extended_integer;
   begin
      require(not(extend(17)+extend(5) = extend(38)),"P0");
      require(extend(17)+extend(5) = extend(22),"P1");
      require(extend(-17)+extend(-5) = extend(-22),"P2");
      require(extend(5)+extend(17) = extend(22),
        "P3: "&image(extend(5)+extend(17))&" =? extend(22)");
      require(extend(-5)+extend(-17) = extend(-22),"P4");
      require(shorten(extend(1)+extend(1))=2,
        "P5: "&image(extend(1)+extend(1))&" =? 2");
      r := value("10000000000000000000000000000000000000000000");
      require(r+r=value("20000000000000000000000000000000000000000000"),
        "P6: "&image(r+r)&" =? 20000000000000000000000000000000000000000000");
      require(extend(17)+extend(-5) = extend(12),"P7");
      require(extend(-5)+extend(17) = extend(12),"P8");
      require(extend(5)+extend(-17) = extend(-12),"P9");
      require(extend(-17)+extend(5) = extend(-12),"P10");
      require(extend(Integer'Last)+extend(-Integer'Last) = extend(0),"P11");
   exception
   when e : others => fail(e);
   end;

   test("dyadic minus");
   declare
      r : extended_integer;
   begin
      require(not(extend(-5)-extend(-17) = extend(0)),"M0");
      require(extend(-5)-extend(-17) = extend(12),"M1");
      require(extend(17)-extend(5) = extend(12),"M2");
      require(extend(5)-extend(17) = extend(-12),"M3");
      require(extend(-17)-extend(-5) = extend(-12),"M4");
      require(extend(Integer'Last)-extend(Integer'Last) = extend(0),"M5");
      require(shorten(extend(3)-extend(1))=2,
        "M6: "&integer'image(shorten(extend(3)-extend(1)))&" =? 2");
      r := value("123456789012345678901234567890123456789012341234");
      require(r-r=extend(0),"M7: "&image(r-r)&" =?"&image(extend(0)));
   exception
   when e : others => fail(e);
   end;

   test("equality");
   begin
      require(extend(0)=extend(0),"E0");
      require(extend(1)/=extend(0),"E1");
      require(extend(2)=extend(2),"E2");
   exception
   when e : others => fail(e);
   end;

   test("ordering relations");
   declare
      r0 : extended_integer;
      r1 : extended_integer;
      r2 : extended_integer;
      r3 : extended_integer;
   begin
      r0 := extend(2);
      r1 := value("1234567890123456789012345678901234567890");
      r2 := extend(-2);
      r3 := value("-1234567890123456789012345678901234567890");
      require(not((r0<r1) and(r1=r0)), "I0a");
      require(not((r0<r1) and(r1<r0)), "I1a");
      require(not((r0>r1) and(r1>r0)), "I2a");
      require(not((r0>r1) and(r1=r0)), "I3a");
      require(not((r2<r3) and(r3=r2)), "I0b");
      require(not((r2<r3) and(r3<r2)), "I1b");
      require(not((r2>r3) and(r3>r2)), "I2b");
      require(not((r2>r3) and(r3=r2)), "I3b");
      require(not((r1<r3) and(r3=r1)), "I0c");
      require(not((r1<r3) and(r3<r1)), "I1c");
      require(not((r1>r3) and(r3>r1)), "I2c");
      require(not((r1>r3) and(r3=r1)), "I3c");
      require(r0<r1, "I4");
      require(r1>r2, "I5");
      require(r2>r3, "I6");
      require(r0<=r1, "I7");
      require(r0<=r0, "I8");
      require(r1=r1, "I9");
      require(r2<=r1, "I10");
      require(r2<=r2, "I11");
      require(r1>r0, ">I12");
      require(r2<r1, ">I13");
      require(r3<r2, ">I14");
      require(r1>=r0, "I15");
      require(r2<r1, "I16");
      require(r3<=r2, "I17");
      require(r2<=r1, "I18");
      require(extend(1111111)<extend(11111111), "I19");
      require(extend(1111111)<extend(1111112), "I20");
      require(extend(1111111)<extend(1112111), "I21");
      require(extend(1111111)<extend(2111111), "I22");
      require(not(extend(11111111)<extend(1111111)), "I23");
      require(not(extend(1111112)<extend(111111)), "I24");
      require(not(extend(1112111)<extend(1111111)), "I25");
      require(not(extend(2111111)<extend(1111111)), "I26");
      require(extend(-1111111)<extend(1111111), "I27");
      require(not(extend(1111111)<extend(-1111111)), "I28");
      require(not(extend(-1111111)<extend(-1111111)), "I29");
      require(not(extend(1111111)<extend(1111111)), "I30");
   exception
   when e : others => fail(e);
   end;

   test("no negative zeros");
   begin
      require(extend(0) <= extend(0)-extend(0),"Z0");
      require(extend(0) <= extend(-1)-extend(-1),"Z1");
      require(extend(0) <= extend(-1)+extend(1),"Z2");
      require(extend(0) <= -extend(0),"Z3");
      require(extend(0) = extend(0)-extend(0),"Z0");
      require(extend(0) = extend(-1)-extend(-1),"Z1");
      require(extend(0) = extend(-1)+extend(1),"Z2");
      require(extend(0) = -extend(0),"Z3");
   exception
   when e : others => fail(e);
   end;

   test("multiplication");
   declare
      r : extended_integer;
   begin
      r := value("12345678901234567890123456789012345678901234567890");
      r := r * r;
      require(r>extend(0),
        "T0: "&image(r)&" >? 0");
      r := extend(-1) * r;
      require(r<extend(0),
        "T1: "&image(r)&" <? 0");
      r := r * extend(0);
      require(r=extend(0),
        "T2: "&image(r)&" =? 0");
      require(not(extend(7)*extend(10)=extend(0)),
        "T3: "&image(extend(7)*extend(10))&" /=? 0");
      require(extend(7)*extend(10)=extend(70),
        "T4: "&image(extend(7)*extend(10))&" =? 70");
      require(extend(10)*extend(7)=extend(70),
        "T5: "&image(extend(10)*extend(7))&" /=? 0");
      require(extend(999999999)*extend(999999999)/=extend(0),
        "T6: "&image(extend(999999999)*extend(999999999))&" /=? 0");
      require(extend(1)*extend(Integer'Last)=extend(Integer'Last),"T7");
      require(extend(Integer'Last)*extend(1)=extend(Integer'Last),"T8");
   exception
   when e : others => fail(e);
   end;

   test("division by zero");
   declare
      q : extended_integer;
      r : extended_integer;
   begin
      divide(extend(1),extend(0),q,r);
      except;
   exception
   when constraint_error => null;
   when e : others => fail(e);
   end;

   test("division");
   declare
      q : extended_integer;
      r : extended_integer;
   begin
      divide (extend(1),extend(1),q,r);
      require(q=extend(1) and r=extend(0),
        "D0: "&image(q)&" "&image(r));
      divide (extend(1),extend(2),q,r);
      require(q=extend(0) and r=extend(1),
        "D1: "&image(q)&" "&image(r));
      divide (extend(2),extend(1),q,r);
      require(q=extend(2) and r=extend(0),
        "D2: "&image(q)&" "&image(r));
      divide (extend(333333335),extend(3),q,r);
      require(q=extend(111111111) and r=extend(2),
        "D3: "&image(q)&" "&image(r));
      divide (extend(-333333335),extend(-3),q,r);
      require(q=extend(111111111) and r=extend(-2),
        "D4: "&image(q)&" "&image(r));
      divide (extend(-333333335),extend(-3),q,r);
      require(q=extend(111111111) and r=extend(-2),
        "D5: "&image(q)&" "&image(r));
      divide (extend(333333335),extend(-3),q,r);
      require(q=extend(-111111111) and r=extend(2),
        "D6: "&image(q)&" "&image(r));
      divide (extend(Integer'Last),extend(Integer'Last),q,r);
      require(q=extend(1) and r=extend(0),
        "D7: "&image(q)&" "&image(r));
      divide (extend(Integer'First),extend(Integer'First),q,r);
      require(q=extend(1) and r=extend(0),
        "D8: "&image(q)&" "&image(r));
      divide (extend(Integer'Last),extend(1),q,r);
      require(q=extend(Integer'Last) and r=extend(0),
        "D9: "&image(q)&" "&image(r));
      divide (extend(1),extend(Integer'Last),q,r);
      require(q=extend(0) and r=extend(1),
        "D10: "&image(q)&" "&image(r));
   exception
   when e : others => fail(e);
   end;

   if random_count > 0 then
      test("random: " & integer'image(random_count));
      declare
         r, r1, r2, r3, r4 : extended_integer;
         h, i : integer;
         zero : constant extended_integer := extend(0);
         one : constant extended_integer := extend(1);
      begin
         random.reset(gen => g);
         for ct in 1..random_count loop
            begin         
               h := random.random(g);
               i := random.random(g);
               r1 := extend(h);
               r2 := extend(i);
               r := (r1 * r2) -(r2 * r1);
               require(r = zero, "C3: "&image(r));
               r := (r1 + r2) -(r2 + r1);
               require(r = zero, "C4: "&image(r));
               r := (r1 - r2) +(r2 - r1);
               require(r = zero, "C5: "&image(r)
                 &": "&image(r1)
                 &": "&image(r2));
               divide(r1,r2,r3,r4);
               r := r3*r2+r4-r1;
               require(r = zero, "C6: "&image(r)
                 &": "&image(r1)
                 &": "&image(r2)
                 &": "&image(r3)
                 &": "&image(r4));
               if r1 < zero then
                  if r2 < zero then
                     require(r4 <= zero, "C7a: "&image(r4));
                     require(-r4 < -r2, "C8a: "&image(r4));
                  else
                     require(r4 <= zero, "C7b: "&image(r4));
                     require(-r4 < r2, "C8b: "&image(r4));
                  end if;
               elsif r2 < zero then
                  require(r4 >= zero, "C7c: "&image(r4));
                  require(r4 < -r2, "C8c: "&image(r4));
               else
                  require(r4 >= zero, "C7d: "&image(r4));
                  require(r4 < r2, "C8d: "&image(r4));
               end if;
            exception
            when e1 : constraint_error =>
               if i /= 0 then fail(e1,image(r1)&" "&image(r2)); end if;
            when e2 : others => fail(e2,image(r1)&" "&image(r1));
            end;
         end loop;
      end;
   end if;

   done;
exception when e : others => fatal_exception(e);
end testp9;