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.1.1 - (hide annotations) (download) (as text) (vendor branch)
Sat Aug 9 13:51:06 2003 UTC (20 years, 8 months ago) by hi_
Branch: MAIN, hi
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_56_0_715, v1_59_0_778, v1_63_1_819, b49, b48, v1_57_0_737, v1_62_0_812, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_50_2_606, v1_51_0_612, v1_50_0_581, v1_50_0_580, v1_50_0_587, v1_50_0_586, v1_57_0_739, v1_57_0_738, v1_59_1_765, v1_51_1_639, v1_53_0_671, v1_50_0_595, v1_60_0_788, v1_60_0_789, v1_54_0_677, v1_54_0_676, v1_50_0_572, v1_58_0_748, marged-Bb50, v1_58_0_745, v1_60_0_781, v1_60_0_782, v1_58_0_746, v1_60_0_784, v1_54_0_678, v1_60_0_786, v1_60_0_787, v1_56_0_707, v1_59_0_767, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_59_1_778, v1_51_0_626, v1_57_0_723, b51, v1_52_1_658, v1_51_0_622, v1_59_0_768, v1_59_0_769, v1_50_0_598, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_1_744, v1_50_0_590, bv1_49_0_564, v1_50_0_593, v1_57_0_728, v1_57_0_729, v1_50_0_596, bv1_49_0_563, v1_52_0_646, v1_50_0_557, b37, v1_57_0_736, v1_50_0_585, v1_51_0_611, v1_51_0_620, v1_52_0_644, v1_58_0_752, v1_58_0_750, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_52_0_643, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_54_0_687, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_51_0_634, v1_51_0_635, v1_51_0_636, v1_51_0_637, v1_54_0_688, v1_54_0_689, v1_51_0_632, v1_51_0_633, v1_49_0_548, v1_50_0_603, v1_54_0_684, c33_4, v1_50_0_582, v1_54_0_685, v1_49_0_540, v1_49_0_542, v1_49_0_545, v1_49_0_544, v1_49_0_547, v1_53_0_664, v1_61_0_796, v1_61_0_797, b47, v1_61_0_795, v1_52_0_647, v1_61_0_798, v1_61_0_799, v1_50_0_604, b34, v1_51_0_638, v1_52_0_648, b35, v1_53_0_661, v1_53_0_663, v1_53_0_662, v1_53_0_665, v1_53_0_667, v1_53_0_666, v1_53_0_669, v1_53_0_668, b36, v1_48_0_530, b33, v1_55_0_692, v1_55_0_693, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, b44, v1_49_0_554, merged-remodeling, v1_50_0_577, b41, v1_49_0_551, v1_52_0_645, v1_52_0_651, v1_54_1_691, v1_52_0_650, v1_56_2_724, v1_50_0_606, v1_56_2_722, v1_50_0_588, v1_52_0_652, v1_55_1_697, b40, v1_52_0_642, v1_52_0_654, v1_51_0_616, v1_56_0_714, v1_51_0_614, v1_51_0_615, v1_53_0_672, v1_51_0_613, v1_53_0_670, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_48_0_510, v1_51_1_640, v1_54_0_686, v1_51_0_618, v1_51_0_619, bv1_49_0_565, v1_54_0_680, b43, v1_54_0_681, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, b50, v1_56_0_712, v1_62_0_803, v1_62_0_802, v1_48_0_535, v1_49_0_552, v1_56_0_713, v1_62_0_809, v1_50_0_574, v1_54_0_682, v1_49_0_553, v1_50_0_584, v_step1, v1_56_0_721, v1_49_0_546, v1_50_0_573, v1_48_0_539, v1_48_0_538, b46, v1_50_0_600, v1_51_0_630, v1_48_0_533, v1_50_0_571, v1_54_0_683, v1_48_0_537, v1_51_0_631, v1_49_2_569, v1_60_0_780, v1_60_0_779, v1_62_0_810, v1_62_0_811, v1_58_0_747, v1_60_0_783, root-of-draw, v1_50_0_576, v1_54_0_679, v1_59_2_785, marged_bRESPOPUP, v1_50_2_604, v1_50_0_578, v1_54_0_675, v1_51_0_628, v1_50_0_579, v1_51_0_617, v1_48_0_536, root-of-Bb50, root-of-Bb51, v1_56_0_706, root-of-remodel, root-of-Bb53, v1_50_0_594, v1_49_0_541, v1_52_1_657, v1_54_0_674, v1_52_0_660, v1_60_1_793, v1_50_0_602, v1_51_0_629, v1_54_0_690, v1_51_0_627, v1_50_0_601, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760, v1_51_0_625, v1_62_1_813, v1_51_0_623, v1_57_2_749, v1_50_0_605, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_52_0_655, v1_56_0_709, v1_57_0_744, v1_52_0_656, v1_56_0_708, v1_52_0_649, v1_61_0_800, v1_53_1_673, v1_50_0_599, v1_56_0_699, v1_56_0_698, v1_50_0_561, v1_51_0_624, v1_51_1_641, v1_51_0_621, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb57, Bb56, Bb55, Bb53, Bb52, Bb51, Bb62, Bb63, Bb60, Bb61, remodeling, Bb59, Bb58, Bb50, bRESPOPUP, bListSU, BRANCH_TORA, Bb49, Bb54, stable, Bdraw
Changes since 1.1: +0 -0 lines
File MIME type: text/x-pascal
ソキオャコ?ョ

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ツて堕滅つ篠仰てセツづ?ね伉ね敖て堋て堕修ツ税?/span>
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