wl_lib_0.1.3_1c94dc7c/src/wl-unit-compare_test.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
with Ada.Containers.Indefinite_Holders;

package body WL.Unit.Compare_Test is

   package Result_Holders is
     new Ada.Containers.Indefinite_Holders (Result_Type, "=");

   type Compare_Test_Type (Name_Length : Natural) is new Unit_Test with
      record
         Name     : String (1 .. Name_Length);
         Test     : Test_Runner;
         Expected : Result_Holders.Holder;
      end record;

   overriding function Name
     (This : Compare_Test_Type)
      return String
   is (This.Name);

   overriding function Try
     (This : Compare_Test_Type)
      return Test_Result;

   ----------
   -- Test --
   ----------

   function Test
     (Name     : String;
      Run_Test : Test_Runner;
      Expected : Result_Type)
      return Unit_Test'Class
   is
   begin
      return Compare_Test_Type'
        (Name_Length => Name'Length, Name => Name,
         Test        => Run_Test,
         Expected    => Result_Holders.To_Holder (Expected));
   end Test;

   ---------
   -- Try --
   ---------

   overriding function Try
     (This : Compare_Test_Type)
      return Test_Result
   is
      Expected : constant Result_Type := This.Expected.Element;
      Result   : constant Result_Type := This.Test.all;
   begin
      if Result = Expected then
         return Test_Success;
      else
         return Test_Failure (Image (Expected), Image (Result));
      end if;
   end Try;

end WL.Unit.Compare_Test;