Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/MonaTest.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download) (as text)
Sat Aug 9 13:51:06 2003 UTC (20 years, 8 months ago) by hi_
Branch point for: MAIN, hi
File MIME type: text/x-pascal
Initial revision

1 hi_ 1.1 {$D-,Y-}
2     {----------------------------------------------------------
3     MonaTest
4    
5     History
6     2001.03.07 Check String”ō쐬
7     2001.03.08 Check Integer”ō쐬
8     2001.03.08 Check Int64”ō쐬
9     2001.03.08 Check SingleěŹ
10     2001.03.08 Check Double”ō쐬
11     2001.03.08 Check Extended”ō쐬
12     2001.03.10 TestResultěŹ
13     2001.03.10 Check Boolean”ō쐬
14     2001.03.10 msg‚𖳎‹‚ľ‚Ä‚˘‚˝‚Ě‚đCł
15     2001.03.10 ErrorŽč‘ą‚ŤěŹ
16     2001.03.11 Check Condition: Boolean”ō쐬
17     ----------------------------------------------------------}
18     unit MonaTest;
19    
20     interface
21     uses
22     SysUtils, Classes;
23    
24     type
25     ETestFailure = class(Exception);
26     ETestError = class(Exception);
27    
28     procedure ClearTestResult;
29    
30     var
31     TestResult: record
32     Success: Integer;
33     Failure: Integer;
34     Error: Integer;
35     end;
36    
37     procedure Success;
38     procedure Fail(msg: String); overload;
39     procedure Fail(format: String; args: array of const); overload;
40     procedure Error(msg: String); overload;
41     procedure Error(format: String; args: array of const); overload;
42     procedure Error(E: Exception); overload;
43    
44     procedure Check(Condition: Boolean; msg: String = ''); overload;
45     procedure Check(Actual, Required: String; msg: String = ''); overload;
46     procedure Check(Actual, Required: Integer; msg: String = ''); overload;
47     procedure Check(Actual, Required: Int64; msg: String = ''); overload;
48     procedure Check(Actual, Required: Single; msg: String = ''); overload;
49     procedure Check(Actual, Required: Double; msg: String = ''); overload;
50     procedure Check(Actual, Required: Extended; msg: String = ''); overload;
51     procedure Check(Actual, Required: Boolean; msg: String = ''); overload;
52    
53     implementation
54    
55     procedure ClearTestResult;
56     begin
57     with TestResult do
58     begin
59     Success := 0;
60     Failure := 0;
61     Error := 0;
62     end;
63     end;
64    
65     procedure Success;
66     begin
67     Inc(TestResult.Success);
68     end;
69    
70     procedure Fail(msg: String);
71     begin
72     Inc(TestResult.Failure);
73     raise ETestFailure.CreateFmt('test failure: %s', [msg]);
74     end;
75    
76     procedure Fail(format: String; args: array of const);
77     begin
78     Fail(SysUtils.Format(format, args));
79     end;
80    
81     procedure Error(msg: String);
82     begin
83     Inc(TestResult.Error);
84     raise ETestFailure.CreateFmt('test error: %s', [msg]);
85     end;
86    
87     procedure Error(format: String; args: array of const);
88     begin
89     Error(SysUtils.Format(format, args));
90     end;
91    
92     procedure Error(E: Exception);
93     begin
94     Error('test error: %s: %s', [E.Message, E.ClassName]);
95     end;
96    
97     procedure Check(Condition: Boolean; msg: String);
98     begin
99     if not Condition then
100     Fail('Condition = False, %s', [msg])
101     else
102     Success;
103     end;
104    
105     procedure Check(Actual, Required: String; msg: String);
106     begin
107     if Actual <> Required then
108     Fail('''%s''=''%s'', String, %s', [Actual, Required, msg])
109     else
110     Success;
111     end;
112    
113     procedure Check(Actual, Required: Integer; msg: String);
114     begin
115     if Actual <> Required then
116     Fail('''%d''=''%d'', Integer, %s', [Actual, Required, msg]);
117     end;
118    
119     procedure Check(Actual, Required: Int64; msg: String);
120     begin
121     if Actual <> Required then
122     Fail('''%d''=''%d'', Int64, %s', [Actual, Required, msg]);
123     end;
124    
125     procedure Check(Actual, Required: Single; msg: String);
126     begin
127     if Actual <> Required then
128     Fail('''%f''=''%f'', Single, %s', [Actual, Required, msg]);
129     end;
130    
131     procedure Check(Actual, Required: Double; msg: String);
132     begin
133     if Actual <> Required then
134     Fail('''%f''=''%f'', Double, %s', [Actual, Required, msg]);
135     end;
136    
137     procedure Check(Actual, Required: Extended; msg: String);
138     begin
139     if Actual <> Required then
140     Fail('''%f''=''%f'', Extended, %s', [Actual, Required, msg]);
141     end;
142    
143     procedure Check(Actual, Required: Boolean; msg: String);
144     begin
145     if Actual <> Required then
146     Fail('''%f''=''%f'', Boolean, %s', [Actual, Required, msg]);
147     end;
148    
149     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26