wl_lib_0.1.3_1c94dc7c/src/wl-unit.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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
with Ada.Exceptions;
with Ada.Text_IO;

package body WL.Unit is

   procedure Append
     (To   : in out Test_Suite;
      Test : Unit_Test'Class)
   is
   begin
      To.List.Append
        (Unit_Test_Record'
           (Test   => Unit_Test_Holders.To_Holder (Test),
            Result => Test_Result_Holders.Empty_Holder));
   end Append;

   ---------------
   -- Run_Tests --
   ---------------

   procedure Run_Tests
     (Suite   : in out Test_Suite;
      Success : out Natural;
      Failure : out Natural;
      Error   : out Natural;
      Not_Run : out Natural)
   is
   begin
      Success := 0;
      Failure := 0;
      Error   := 0;
      Not_Run := 0;
      for Item of Suite.List loop
         begin
            declare
               Result : constant Test_Result :=
                          Item.Test.Element.Try;
            begin
               Item.Result := Test_Result_Holders.To_Holder (Result);
               if Is_Success (Result) then
                  Success := Success + 1;
                  if Suite.Is_Verbose then
                     Ada.Text_IO.Put_Line (Item.Test.Element.Name
                                           & ": OK");
                  end if;
               else
                  Ada.Text_IO.Put_Line (Item.Test.Element.Name
                                        & ": expected "
                                        & Expected (Result));
                  Ada.Text_IO.Put_Line (Item.Test.Element.Name
                                        & ": found "
                                        & Found (Result));
                  Failure := Failure + 1;
               end if;
            end;
         exception
            when E : others =>
               Item.Result :=
                 Test_Result_Holders.To_Holder
                   (Test_Error (Ada.Exceptions.Exception_Message (E)));
               Error := Error + 1;
               Ada.Text_IO.Put_Line (Item.Test.Element.Name
                                     & ": error: "
                                     & Error_Message (Item.Result.Element));
         end;
      end loop;
   end Run_Tests;

   -------------
   -- Verbose --
   -------------

   procedure Verbose
     (Suite   : in out Test_Suite;
      Enabled : Boolean := True)
   is
   begin
      Suite.Is_Verbose := Enabled;
   end Verbose;

end WL.Unit;