source: branches/xpascal/Tests.pas

Last change on this file was 237, checked in by chronos, 2 years ago
  • Added: More tests.
File size: 8.9 KB
Line 
1unit Tests;
2
3interface
4
5uses
6 Classes, SysUtils, TestCase;
7
8function GetTests: TTestCases;
9
10
11implementation
12
13uses
14 Parser, Executor, ParserPascal;
15
16type
17
18 { TTestRun }
19
20 TTestRun = class(TTestCase)
21 private
22 Output: string;
23 Error: string;
24 procedure ExecutorOutput(Text: string);
25 procedure InterpreterError(Pos: TPoint; Text: string);
26 public
27 Source: TStringList;
28 ExpectedOutput: string;
29 procedure Run; override;
30 constructor Create; override;
31 destructor Destroy; override;
32 end;
33
34function GetTests: TTestCases;
35begin
36 Result := TTestCases.Create;
37 with TTestRun(Result.AddNew('Basic program', TTestRun)) do begin
38 Source.Add('program Test;');
39 Source.Add('begin');
40 Source.Add('end.');
41 ExpectedOutput := '';
42 end;
43 with TTestRun(Result.AddNew('WriteLn', TTestRun)) do begin
44 Source.Add('begin');
45 Source.Add(' WriteLn(''Test'');');
46 Source.Add('end.');
47 ExpectedOutput := 'Test' + LineEnding;
48 end;
49 with TTestRun(Result.AddNew('Write', TTestRun)) do begin
50 Source.Add('begin');
51 Source.Add(' Write(''Test'');');
52 Source.Add('end.');
53 ExpectedOutput := 'Test';
54 end;
55 with TTestRun(Result.AddNew('Integer constants summation', TTestRun)) do begin
56 Source.Add('begin');
57 Source.Add(' WriteLn(IntToStr(1 + 2));');
58 Source.Add('end.');
59 ExpectedOutput := '3' + LineEnding;
60 end;
61 with TTestRun(Result.AddNew('String concatenation', TTestRun)) do begin
62 Source.Add('begin');
63 Source.Add(' WriteLn(''Test'' + ''Now'');');
64 Source.Add('end.');
65 ExpectedOutput := 'TestNow' + LineEnding;
66 end;
67 with TTestRun(Result.AddNew('String variable assignment', TTestRun)) do begin
68 Source.Add('var');
69 Source.Add(' A: string;');
70 Source.Add('begin');
71 Source.Add(' A := ''Test'';');
72 Source.Add(' WriteLn(A);');
73 Source.Add('end.');
74 ExpectedOutput := 'Test' + LineEnding;
75 end;
76 with TTestRun(Result.AddNew('String constant', TTestRun)) do begin
77 Source.Add('const');
78 Source.Add(' A: string = ''Test'';');
79 Source.Add('begin');
80 Source.Add(' WriteLn(A);');
81 Source.Add('end.');
82 ExpectedOutput := 'Test' + LineEnding;
83 end;
84 with TTestRun(Result.AddNew('String with single quote', TTestRun)) do begin
85 Source.Add('begin');
86 Source.Add(' Write(''One''''Two'');');
87 Source.Add('end.');
88 ExpectedOutput := 'One''Two';
89 end;
90 with TTestRun(Result.AddNew('if-then true', TTestRun)) do begin
91 Source.Add('begin');
92 Source.Add(' if 1 = 1 then WriteLn(''Yes'');');
93 Source.Add('end.');
94 ExpectedOutput := 'Yes' + LineEnding;
95 end;
96 with TTestRun(Result.AddNew('if-then false', TTestRun)) do begin
97 Source.Add('begin');
98 Source.Add(' if 1 = 2 then WriteLn(''Yes'');');
99 Source.Add('end.');
100 ExpectedOutput := '';
101 end;
102 with TTestRun(Result.AddNew('if-then-else true', TTestRun)) do begin
103 Source.Add('begin');
104 Source.Add(' if 1 = 1 then WriteLn(''Yes'') else WriteLn(''No'');');
105 Source.Add('end.');
106 ExpectedOutput := 'Yes' + LineEnding;
107 end;
108 with TTestRun(Result.AddNew('if-then-else false', TTestRun)) do begin
109 Source.Add('begin');
110 Source.Add(' if 1 = 2 then WriteLn(''Yes'') else WriteLn(''No'');');
111 Source.Add('end.');
112 ExpectedOutput := 'No' + LineEnding;
113 end;
114 with TTestRun(Result.AddNew('for-to-do', TTestRun)) do begin
115 Source.Add('var');
116 Source.Add(' I: Integer;');
117 Source.Add('begin');
118 Source.Add(' for I := 0 to 2 do begin');
119 Source.Add(' WriteLn(IntToStr(I));');
120 Source.Add(' end;');
121 Source.Add('end.');
122 ExpectedOutput := '0' + LineEnding + '1' + LineEnding + '2' + LineEnding;
123 end;
124 with TTestRun(Result.AddNew('while-do', TTestRun)) do begin
125 Source.Add('var');
126 Source.Add(' I: Integer;');
127 Source.Add('begin');
128 Source.Add(' I := 0;');
129 Source.Add(' while I < 3 do begin');
130 Source.Add(' WriteLn(IntToStr(I));');
131 Source.Add(' I := I + 1;');
132 Source.Add(' end;');
133 Source.Add('end.');
134 ExpectedOutput := '0' + LineEnding + '1' + LineEnding + '2' + LineEnding;
135 end;
136 with TTestRun(Result.AddNew('repeat-until', TTestRun)) do begin
137 Source.Add('var');
138 Source.Add(' I: Integer;');
139 Source.Add('begin');
140 Source.Add(' I := 0;');
141 Source.Add(' repeat');
142 Source.Add(' WriteLn(IntToStr(I));');
143 Source.Add(' I := I + 1;');
144 Source.Add(' until I > 2;');
145 Source.Add('end.');
146 ExpectedOutput := '0' + LineEnding + '1' + LineEnding + '2' + LineEnding;
147 end;
148 with TTestRun(Result.AddNew('function', TTestRun)) do begin
149 Source.Add('function IsZero(A: Integer): Boolean;');
150 Source.Add('begin');
151 Source.Add(' Result := A = 0;');
152 Source.Add('end;');
153 Source.Add('');
154 Source.Add('begin');
155 Source.Add(' WriteLn(BoolToStr(IsZero(0)));');
156 Source.Add(' WriteLn(BoolToStr(IsZero(1)));');
157 Source.Add('end.');
158 ExpectedOutput := '-1' + LineEnding + '0' + LineEnding;
159 end;
160 with TTestRun(Result.AddNew('function without result usage', TTestRun)) do begin
161 Source.Add('function IsZero(A: Integer): Boolean;');
162 Source.Add('begin');
163 Source.Add(' Result := A = 0;');
164 Source.Add('end;');
165 Source.Add('');
166 Source.Add('begin');
167 Source.Add(' IsZero(0);');
168 Source.Add('end.');
169 ExpectedOutput := '';
170 end;
171 with TTestRun(Result.AddNew('function var parameter', TTestRun)) do begin
172 Source.Add('function Test(var A: Integer): Boolean;');
173 Source.Add('begin');
174 Source.Add(' A := 10;');
175 Source.Add(' Result := 1 = 1;');
176 Source.Add('end;');
177 Source.Add('');
178 Source.Add('var');
179 Source.Add(' B: Integer;');
180 Source.Add(' C: Boolean;');
181 Source.Add('begin');
182 Source.Add(' B := 1;');
183 Source.Add(' C := Test(B);');
184 Source.Add(' WriteLn(IntToStr(B));');
185 Source.Add('end.');
186 ExpectedOutput := '10' + LineEnding;
187 end;
188 with TTestRun(Result.AddNew('function var', TTestRun)) do begin
189 Source.Add('function Test(A: string): string;');
190 Source.Add('var');
191 Source.Add(' C: string;');
192 Source.Add('begin');
193 Source.Add(' C := A;');
194 Source.Add(' Result := C;');
195 Source.Add('end;');
196 Source.Add('');
197 Source.Add('begin');
198 Source.Add(' WriteLn(Test(''X''));');
199 Source.Add('end.');
200 ExpectedOutput := 'X' + LineEnding;
201 end;
202 with TTestRun(Result.AddNew('function const', TTestRun)) do begin
203 Source.Add('function Test: string;');
204 Source.Add('const');
205 Source.Add(' D: string = ''X'';');
206 Source.Add('begin');
207 Source.Add(' Result := D;');
208 Source.Add('end;');
209 Source.Add('');
210 Source.Add('begin');
211 Source.Add(' WriteLn(Test);');
212 Source.Add('end.');
213 ExpectedOutput := 'X' + LineEnding;
214 end;
215 with TTestRun(Result.AddNew('procedure', TTestRun)) do begin
216 Source.Add('procedure Print(Text: string);');
217 Source.Add('begin');
218 Source.Add(' WriteLn(Text);');
219 Source.Add('end;');
220 Source.Add('');
221 Source.Add('begin');
222 Source.Add(' Print(''Test'');');
223 Source.Add('end.');
224 ExpectedOutput := 'Test' + LineEnding;
225 end;
226 with TTestRun(Result.AddNew('procedure var parameter', TTestRun)) do begin
227 Source.Add('procedure Test(var A: Integer);');
228 Source.Add('begin');
229 Source.Add(' A := 10;');
230 Source.Add('end;');
231 Source.Add('');
232 Source.Add('var');
233 Source.Add(' B: Integer;');
234 Source.Add('begin');
235 Source.Add(' B := 1;');
236 Source.Add(' Test(B);');
237 Source.Add(' WriteLn(IntToStr(B));');
238 Source.Add('end.');
239 ExpectedOutput := '10' + LineEnding;
240 end;
241 with TTestRun(Result.AddNew('Single line comment', TTestRun)) do begin
242 Source.Add('begin');
243 Source.Add(' // WriteLn(''Test'');');
244 Source.Add('end.');
245 ExpectedOutput := '';
246 end;
247end;
248
249{ TTestBasic }
250
251procedure TTestRun.ExecutorOutput(Text: string);
252begin
253 Output := Output + Text;
254end;
255
256procedure TTestRun.InterpreterError(Pos: TPoint; Text: string);
257begin
258 Error := Error + '[' + IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y) + '] ' + Text + LineEnding;
259end;
260
261procedure TTestRun.Run;
262var
263 Parser: TParser;
264 Executor: TExecutor;
265begin
266 Error := '';
267 Output := '';
268 Parser := TParserPascal.Create;
269 try
270 Parser.OnError := InterpreterError;
271 Parser.Source := Source.Text;
272 Parser.Parse;
273 if Assigned(Parser.Prog) then
274 try
275 Executor := TExecutor.Create;
276 Executor.Prog := Parser.Prog;
277 Executor.OnOutput := ExecutorOutput;
278 Executor.Run;
279 Evaluate((ExpectedOutput = Output) and (Error = ''));
280 finally
281 Executor.Free;
282 end else TestResult := trFailed;
283 finally
284 Parser.Prog.Free;
285 Parser.Free;
286 end;
287 Log := 'Source: ' + LineEnding + Source.Text + LineEnding +
288 'Expected: ' + LineEnding + ExpectedOutput + LineEnding +
289 'Returned: ' + LineEnding + Output + LineEnding +
290 'Errors: ' + LineEnding + Error + LineEnding;
291 inherited;
292end;
293
294constructor TTestRun.Create;
295begin
296 inherited;
297 Source := TStringList.Create;
298end;
299
300destructor TTestRun.Destroy;
301begin
302 FreeAndNil(Source);
303 inherited;
304end;
305
306end.
307
Note: See TracBrowser for help on using the repository browser.