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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
------------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- --
-- --
-- --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package body Test_Assert is
package IO renames Ada.Text_IO;
------------
-- Assert --
------------
procedure Assert
(Success : Boolean;
Msg : String := "";
Location : String := SI.Source_Location)
is
begin
IO.Put (Location & ": ");
if Success then
IO.Put ("PASSED:");
else
IO.Put ("FAILED:");
Final_Status := 1;
end if;
if Msg'Length > 0 then
IO.Put (" ");
IO.Put (Msg);
end if;
IO.New_Line;
end Assert;
------------
-- Assert --
------------
procedure Assert
(Left, Right : String;
Msg : String := "";
Location : String := SI.Source_Location)
is
Success : constant Boolean := Left = Right;
begin
Assert (Success, Msg, Location);
if not Success then
if Right'Length > 0 then
IO.Put_Line ("expected: " & Right);
else
IO.Put_Line ("expected empty string");
end if;
if Left'Length > 0 then
IO.Put_Line ("got: " & Left);
else
IO.Put_Line ("got empty string");
end if;
end if;
end Assert;
------------
-- Assert --
------------
procedure Assert
(Left, Right : VFS.Virtual_File;
Msg : String := "";
Location : String := SI.Source_Location)
is
use type VFS.Virtual_File;
Success : constant Boolean := Left = Right;
begin
Assert (Success, Msg, Location);
if not Success then
IO.Put_Line ("expected: " & VFS.Display_Full_Name (Right));
IO.Put_Line ("got: " & VFS.Display_Full_Name (Left));
end if;
end Assert;
------------
-- Report --
------------
function Report return Natural is
begin
if Final_Status = 0 then
IO.Put_Line ("<=== TEST PASSED ===>");
else
IO.PUT_Line ("<=== TEST FAILED ===>");
end if;
return Final_Status;
end Report;
end Test_Assert;
|
