1 unit tconstparser;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, fpcunit, pastree, pscanner, tcbaseparser, testregistry, pparser;
9
10 Type
11 { TTestConstParser }
12
13 TTestConstParser = Class(TTestParser)
14 private
15 FConst: TPasConst;
16 FExpr: TPasExpr;
17 FHint : string;
18 FTyped: String;
19 procedure DoParseConstUnTypedRange;
20 Protected
ParseConstnull21 Function ParseConst(ASource : String) : TPasConst;
22 Procedure CheckExprNameKindClass(AKind : TPasExprKind; AClass : TClass);
23 Property TheConst : TPasConst Read FConst;
24 Property TheExpr : TPasExpr Read FExpr;
25 Property Hint : string Read FHint Write FHint;
26 Property Typed : String Read FTyped Write FTyped;
27 procedure SetUp; override;
28 Public
29 Procedure DoTestSimpleIntConst;
30 Procedure DoTestSimpleFloatConst;
31 Procedure DoTestSimpleStringConst;
32 Procedure DoTestSimpleNilConst;
33 Procedure DoTestSimpleBoolConst;
34 Procedure DoTestSimpleIdentifierConst;
35 Procedure DoTestSimpleSetConst;
36 Procedure DoTestSimpleExprConst;
37 Published
38 Procedure TestSimpleIntConst;
39 Procedure TestSimpleFloatConst;
40 Procedure TestSimpleStringConst;
41 Procedure TestSimpleNilConst;
42 Procedure TestSimpleBoolConst;
43 Procedure TestSimpleIdentifierConst;
44 Procedure TestSimpleSetConst;
45 Procedure TestSimpleExprConst;
46 Procedure TestSimpleIntConstDeprecatedMsg;
47 Procedure TestSimpleIntConstDeprecated;
48 Procedure TestSimpleFloatConstDeprecated;
49 Procedure TestSimpleStringConstDeprecated;
50 Procedure TestSimpleNilConstDeprecated;
51 Procedure TestSimpleBoolConstDeprecated;
52 Procedure TestSimpleIdentifierConstDeprecated;
53 Procedure TestSimpleSetConstDeprecated;
54 Procedure TestSimpleExprConstDeprecated;
55 Procedure TestSimpleIntConstPlatform;
56 Procedure TestSimpleFloatConstPlatform;
57 Procedure TestSimpleStringConstPlatform;
58 Procedure TestSimpleNilConstPlatform;
59 Procedure TestSimpleBoolConstPlatform;
60 Procedure TestSimpleIdentifierConstPlatform;
61 Procedure TestSimpleSetConstPlatform;
62 Procedure TestSimpleExprConstPlatform;
63 Procedure TestSimpleIntConstExperimental;
64 Procedure TestSimpleFloatConstExperimental;
65 Procedure TestSimpleStringConstExperimental;
66 Procedure TestSimpleNilConstExperimental;
67 Procedure TestSimpleBoolConstExperimental;
68 Procedure TestSimpleIdentifierConstExperimental;
69 Procedure TestSimpleSetConstExperimental;
70 Procedure TestSimpleExprConstExperimental;
71 Procedure TestTypedIntConst;
72 Procedure TestTypedFloatConst;
73 Procedure TestTypedStringConst;
74 Procedure TestTypedNilConst;
75 Procedure TestTypedBoolConst;
76 Procedure TestTypedIdentifierConst;
77 Procedure TestTypedSetConst;
78 Procedure TestTypedExprConst;
79 Procedure TestRecordConst;
80 Procedure TestArrayConst;
81 Procedure TestRangeConst;
82 Procedure TestRangeConstUnTyped;
83 Procedure TestArrayOfRangeConst;
84 end;
85
86 { TTestResourcestringParser }
87
88 TTestResourcestringParser = Class(TTestParser)
89 private
90 FExpr: TPasExpr;
91 FHint : string;
92 FTheStr: TPasResString;
93 Protected
ParseResourcestringnull94 Function ParseResourcestring(ASource : String) : TPasResString;
95 Procedure CheckExprNameKindClass(AKind : TPasExprKind; AClass : TClass);
96 Property Hint : string Read FHint Write FHint;
97 Property TheStr : TPasResString Read FTheStr;
98 Property TheExpr : TPasExpr Read FExpr;
99 Public
100 Procedure DoTestSimple;
101 Procedure DoTestSum;
102 Procedure DoTestSum2;
103 Published
104 Procedure TestSimple;
105 Procedure TestSimpleDeprecated;
106 Procedure TestSimplePlatform;
107 Procedure TestSum1;
108 Procedure TestSum1Deprecated;
109 Procedure TestSum1Platform;
110 Procedure TestSum2;
111 Procedure TestSum2Deprecated;
112 Procedure TestSum2Platform;
113 end;
114
115
116 implementation
117 { TTestConstParser }
118
ParseConstnull119 function TTestConstParser.ParseConst(ASource: String): TPasConst;
120
121 Var
122 D : String;
123 begin
124 Add('Const');
125 D:=' A ';
126 If (Typed<>'') then
127 D:=D+' : '+Typed+' ';
128 D:=D+' = '+ASource;
129 If Hint<>'' then
130 D:=D+' '+Hint;
131 Add(' '+D+';');
132 ParseDeclarations;
133 AssertEquals('One constant definition',1,Declarations.Consts.Count);
134 AssertEquals('First declaration is constant definition.',TPasConst,TObject(Declarations.Consts[0]).ClassType);
135 Result:=TPasConst(Declarations.Consts[0]);
136 AssertNotNull(Result.Expr);
137 FExpr:=Result.Expr;
138 FConst:=Result;
139 Definition:=Result;
140 end;
141
142
143 procedure TTestConstParser.CheckExprNameKindClass(
144 AKind: TPasExprKind; AClass : TClass);
145 begin
146 AssertEquals('Correct name','A',TheConst.Name);
147 AssertExpression('Const', TheExpr,aKind,AClass);
148 end;
149
150 procedure TTestConstParser.SetUp;
151 begin
152 inherited SetUp;
153 Hint:='';
154 end;
155
156 procedure TTestConstParser.DoTestSimpleIntConst;
157
158 begin
159 ParseConst('1');
160 AssertExpression('Integer Const',TheExpr,pekNumber,'1');
161 end;
162
163 procedure TTestConstParser.DoTestSimpleFloatConst;
164 begin
165 ParseConst('1.2');
166 AssertExpression('Float const', TheExpr,pekNumber,'1.2');
167 end;
168
169 procedure TTestConstParser.DoTestSimpleStringConst;
170 begin
171 ParseConst('''test''');
172 AssertExpression('String const', TheExpr,pekString,'''test''');
173 end;
174
175 procedure TTestConstParser.DoTestSimpleNilConst;
176 begin
177 ParseConst('Nil');
178 CheckExprNameKindClass(pekNil,TNilExpr);
179 end;
180
181 procedure TTestConstParser.DoTestSimpleBoolConst;
182 begin
183 ParseConst('True');
184 CheckExprNameKindClass(pekBoolConst,TBoolconstExpr);
185 AssertEquals('Correct expression value',True,TBoolconstExpr(TheExpr).Value);
186 end;
187
188 procedure TTestConstParser.DoTestSimpleIdentifierConst;
189 begin
190 ParseConst('taCenter');
191 AssertExpression('Enumeration const', theExpr,pekIdent,'taCenter');
192 end;
193
194 procedure TTestConstParser.DoTestSimpleSetConst;
195 begin
196 ParseConst('[taLeftJustify,taRightJustify]');
197 CheckExprNameKindClass(pekSet,TParamsExpr);
198 AssertEquals('Correct set count',2,Length(TParamsExpr(TheExpr).Params));
199 AssertExpression('Set element 1',TParamsExpr(TheExpr).Params[0],pekIdent,'taLeftJustify');
200 AssertExpression('Set element 2',TParamsExpr(TheExpr).Params[1],pekIdent,'taRightJustify');
201 end;
202
203 procedure TTestConstParser.DoTestSimpleExprConst;
204
205 Var
206 B : TBinaryExpr;
207
208 begin
209 ParseConst('1 + 2');
210 CheckExprNameKindClass(pekBinary,TBinaryExpr);
211 B:=TBinaryExpr(TheExpr);
212 TAssert.AssertSame('B.Left.Parent=B',B,B.left.Parent);
213 TAssert.AssertSame('B.right.Parent=B',B,B.right.Parent);
214 AssertExpression('Left expression',B.Left,pekNumber,'1');
215 AssertExpression('Right expression',B.Right,pekNumber,'2');
216 end;
217
218 procedure TTestConstParser.TestSimpleIntConst;
219 begin
220 DoTestSimpleIntConst
221 end;
222
223 procedure TTestConstParser.TestSimpleFloatConst;
224 begin
225 DoTestSimpleFloatConst
226 end;
227
228 procedure TTestConstParser.TestSimpleStringConst;
229 begin
230 DoTestSimpleStringConst
231 end;
232
233 procedure TTestConstParser.TestSimpleNilConst;
234 begin
235 DoTestSimpleNilConst
236 end;
237
238 procedure TTestConstParser.TestSimpleBoolConst;
239 begin
240 DoTestSimpleBoolConst
241 end;
242
243 procedure TTestConstParser.TestSimpleIdentifierConst;
244 begin
245 DoTestSimpleIdentifierConst
246 end;
247
248 procedure TTestConstParser.TestSimpleSetConst;
249 begin
250 DoTestSimpleSetConst
251 end;
252
253 procedure TTestConstParser.TestSimpleExprConst;
254 begin
255 DoTestSimpleExprConst;
256 end;
257
258 procedure TTestConstParser.TestSimpleIntConstDeprecatedMsg;
259 begin
260 Hint:='deprecated ''this is old''' ;
261 DoTestSimpleIntConst;
262 CheckHint(hDeprecated);
263 end;
264
265 procedure TTestConstParser.TestSimpleIntConstDeprecated;
266 begin
267 Hint:='deprecated';
268 DoTestSimpleIntConst;
269 CheckHint(hDeprecated);
270 end;
271
272 procedure TTestConstParser.TestSimpleFloatConstDeprecated;
273 begin
274 Hint:='deprecated';
275 DoTestSimpleIntConst;
276 CheckHint(hDeprecated);
277 end;
278
279 procedure TTestConstParser.TestSimpleStringConstDeprecated;
280 begin
281 Hint:='deprecated';
282 DoTestSimpleStringConst;
283 CheckHint(hDeprecated);
284 end;
285
286 procedure TTestConstParser.TestSimpleNilConstDeprecated;
287 begin
288 Hint:='deprecated';
289 DoTestSimpleNilConst;
290 CheckHint(hDeprecated);
291 end;
292
293 procedure TTestConstParser.TestSimpleBoolConstDeprecated;
294 begin
295 Hint:='deprecated';
296 DoTestSimpleBoolConst;
297 CheckHint(hDeprecated);
298 end;
299
300 procedure TTestConstParser.TestSimpleIdentifierConstDeprecated;
301 begin
302 Hint:='deprecated';
303 DoTestSimpleIdentifierConst;
304 CheckHint(hDeprecated);
305 end;
306
307 procedure TTestConstParser.TestSimpleSetConstDeprecated;
308 begin
309 Hint:='deprecated';
310 DoTestSimpleSetConst;
311 CheckHint(hDeprecated);
312 end;
313
314 procedure TTestConstParser.TestSimpleExprConstDeprecated;
315 begin
316 Hint:='deprecated';
317 DoTestSimpleExprConst;
318 CheckHint(hDeprecated);
319 end;
320
321 procedure TTestConstParser.TestSimpleIntConstPlatform;
322 begin
323 Hint:='Platform';
324 DoTestSimpleIntConst;
325 CheckHint(hPlatform);
326 end;
327
328 procedure TTestConstParser.TestSimpleFloatConstPlatform;
329 begin
330 Hint:='Platform';
331 DoTestSimpleIntConst;
332 CheckHint(hPlatform);
333 end;
334
335 procedure TTestConstParser.TestSimpleStringConstPlatform;
336 begin
337 Hint:='Platform';
338 DoTestSimpleStringConst;
339 CheckHint(hPlatform);
340 end;
341
342 procedure TTestConstParser.TestSimpleNilConstPlatform;
343 begin
344 Hint:='Platform';
345 DoTestSimpleNilConst;
346 CheckHint(hPlatform);
347 end;
348
349 procedure TTestConstParser.TestSimpleBoolConstPlatform;
350 begin
351 Hint:='Platform';
352 DoTestSimpleBoolConst;
353 CheckHint(hPlatform);
354 end;
355
356 procedure TTestConstParser.TestSimpleIdentifierConstPlatform;
357 begin
358 Hint:='Platform';
359 DoTestSimpleIdentifierConst;
360 CheckHint(hPlatform);
361 end;
362
363 procedure TTestConstParser.TestSimpleExprConstPlatform;
364 begin
365 Hint:='Platform';
366 DoTestSimpleExprConst;
367 CheckHint(hPlatform);
368 end;
369
370 procedure TTestConstParser.TestSimpleSetConstPlatform;
371 begin
372 Hint:='Platform';
373 DoTestSimpleSetConst;
374 CheckHint(hPlatform);
375 end;
376
377 procedure TTestConstParser.TestSimpleIntConstExperimental;
378 begin
379 Hint:='Experimental';
380 DoTestSimpleIntConst;
381 CheckHint(hExperimental);
382 end;
383
384 procedure TTestConstParser.TestSimpleFloatConstExperimental;
385 begin
386 Hint:='Experimental';
387 DoTestSimpleIntConst;
388 CheckHint(hExperimental);
389 end;
390
391 procedure TTestConstParser.TestSimpleStringConstExperimental;
392 begin
393 Hint:='Experimental';
394 DoTestSimpleStringConst;
395 CheckHint(hExperimental);
396 end;
397
398 procedure TTestConstParser.TestSimpleNilConstExperimental;
399 begin
400 Hint:='Experimental';
401 DoTestSimpleNilConst;
402 CheckHint(hExperimental);
403 end;
404
405 procedure TTestConstParser.TestSimpleBoolConstExperimental;
406 begin
407 Hint:='Experimental';
408 DoTestSimpleBoolConst;
409 CheckHint(hExperimental);
410 end;
411
412 procedure TTestConstParser.TestSimpleIdentifierConstExperimental;
413 begin
414 Hint:='Experimental';
415 DoTestSimpleIdentifierConst;
416 CheckHint(hExperimental);
417 end;
418
419 procedure TTestConstParser.TestSimpleSetConstExperimental;
420 begin
421 Hint:='Experimental';
422 DoTestSimpleSetConst;
423 CheckHint(hExperimental);
424 end;
425
426 procedure TTestConstParser.TestSimpleExprConstExperimental;
427 begin
428 Hint:='Experimental';
429 DoTestSimpleExprConst;
430 CheckHint(hExperimental);
431 end;
432
433 procedure TTestConstParser.TestTypedIntConst;
434 begin
435 Typed:='Integer';
436 DoTestSimpleIntConst
437 end;
438
439 procedure TTestConstParser.TestTypedFloatConst;
440 begin
441 Typed:='Double';
442 DoTestSimpleFloatConst
443 end;
444
445 procedure TTestConstParser.TestTypedStringConst;
446 begin
447 Typed:='shortstring';
448 DoTestSimpleStringConst
449 end;
450
451 procedure TTestConstParser.TestTypedNilConst;
452 begin
453 Typed:='PChar';
454 DoTestSimpleNilConst
455 end;
456
457 procedure TTestConstParser.TestTypedBoolConst;
458 begin
459 Typed:='Boolean';
460 DoTestSimpleBoolConst
461 end;
462
463 procedure TTestConstParser.TestTypedIdentifierConst;
464 begin
465 Typed:='TAlign';
466 DoTestSimpleIdentifierConst
467 end;
468
469 procedure TTestConstParser.TestTypedSetConst;
470 begin
471 Typed:='TAligns';
472 DoTestSimpleSetConst
473 end;
474
475 procedure TTestConstParser.TestTypedExprConst;
476 begin
477 Typed:='ShortInt';
478 DoTestSimpleExprConst;
479 end;
480
481 procedure TTestConstParser.TestRecordConst;
482 Var
483 R : TRecordValues;
484 Fi : TRecordValuesItem;
485 begin
486 Typed := 'TPoint';
487 ParseConst('(x:1;y: 2)');
488 AssertEquals('Record Values',TRecordValues,TheExpr.ClassType);
489 R:=TheExpr as TRecordValues;
490 AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
491 AssertEquals('2 elements',2,Length(R.Fields));
492 FI:=R.Fields[0];
493 AssertEquals('Name field 1','x',Fi.Name);
494 AssertExpression('Field 1 value',Fi.ValueExp,pekNumber,'1');
495 FI:=R.Fields[1];
496 AssertEquals('Name field 2','y',Fi.Name);
497 AssertExpression('Field 2 value',Fi.ValueExp,pekNumber,'2');
498 end;
499
500 procedure TTestConstParser.TestArrayConst;
501
502 Var
503 R : TArrayValues;
504 begin
505 Typed := 'TMyArray';
506 ParseConst('(1 , 2)');
507 AssertEquals('Array Values',TArrayValues,TheExpr.ClassType);
508 R:=TheExpr as TArrayValues;
509 AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
510 AssertEquals('2 elements',2,Length(R.Values));
511 AssertExpression('Element 1 value',R.Values[0],pekNumber,'1');
512 AssertExpression('Element 2 value',R.Values[1],pekNumber,'2');
513 end;
514
515 procedure TTestConstParser.TestRangeConst;
516 begin
517 Typed:='0..1';
518 ParseConst('1');
519 AssertEquals('Range type',TPasRangeType,TheConst.VarType.ClassType);
520 AssertExpression('Float const', TheExpr,pekNumber,'1');
521 end;
522
523 procedure TTestConstParser.DoParseConstUnTypedRange;
524
525 begin
526 ParseConst('1..2');
527 end;
528
529 procedure TTestConstParser.TestRangeConstUnTyped;
530 begin
531 AssertException('Range const is not allowed',EParserError,@DoParseConstUnTypedRange);
532 end;
533
534 procedure TTestConstParser.TestArrayOfRangeConst;
535 Var
536 R : TArrayValues;
537 begin
538 Typed:='array [0..7] of 0..1';
539 ParseConst('(0, 0, 0, 0, 0, 0, 0, 0)');
540 AssertEquals('Array Values',TArrayValues,TheExpr.ClassType);
541 R:=TheExpr as TArrayValues;
542 AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
543 AssertEquals('elements',8,Length(R.Values));
544 // AssertEquals('Range type',TPasRangeType,TheConst.VarType.ClassType);
545 // AssertExpression('Float const', TheExpr,pekNumber,'1');
546 end;
547
548 { TTestResourcestringParser }
549
TTestResourcestringParser.ParseResourcestringnull550 function TTestResourcestringParser.ParseResourcestring(ASource: String
551 ): TPasResString;
552
553 Var
554 D : String;
555 begin
556 Add('Resourcestring');
557 D:=' A = '+ASource;
558 If Hint<>'' then
559 D:=D+' '+Hint;
560 Add(' '+D+';');
561 Add('end.');
562 //Writeln(source.text);
563 ParseDeclarations;
564 AssertEquals('One resourcestring definition',1,Declarations.ResStrings.Count);
565 AssertEquals('First declaration is constant definition.',TPasResString,TObject(Declarations.ResStrings[0]).ClassType);
566 Result:=TPasResString(Declarations.ResStrings[0]);
567 FTheStr:=Result;
568 FExpr:=Result.Expr;
569 Definition:=Result;
570 end;
571
572 procedure TTestResourcestringParser.CheckExprNameKindClass(AKind: TPasExprKind;
573 AClass: TClass);
574 begin
575 AssertEquals('Correct name','A',TheStr.Name);
576 AssertEquals('Correct expression kind',aKind,TheExpr.Kind);
577 AssertEquals('Correct expression class',AClass,TheExpr.ClassType);
578 // Writeln('Delcaration : ',TheStr.GetDeclaration(True));
579 end;
580
581 procedure TTestResourcestringParser.DoTestSimple;
582 begin
583 ParseResourcestring('''Something''');
584 CheckExprNameKindClass(pekString,TPrimitiveExpr);
585 AssertEquals('Correct expression value','''Something''',TPrimitiveExpr(TheExpr).Value);
586 end;
587
588 procedure TTestResourcestringParser.DoTestSum;
589 var
590 B: TBinaryExpr;
591 begin
592 ParseResourcestring('''Something''+'' else''');
593 CheckExprNameKindClass(pekBinary,TBinaryExpr);
594 B:=TBinaryExpr(TheExpr);
595 TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
596 TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
597 AssertEquals('Correct left',TPrimitiveExpr,B.Left.ClassType);
598 AssertEquals('Correct right',TPrimitiveExpr,B.Right.ClassType);
599 AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(B.Left).Value);
600 AssertEquals('Correct right expression value',''' else''',TPrimitiveExpr(B.Right).Value);
601 end;
602
603 procedure TTestResourcestringParser.DoTestSum2;
604 var
605 B: TBinaryExpr;
606 begin
607 ParseResourcestring('''Something''+different');
608 CheckExprNameKindClass(pekBinary,TBinaryExpr);
609 B:=TBinaryExpr(TheExpr);
610 TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
611 TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
612 AssertEquals('Correct left',TPrimitiveExpr,B.Left.ClassType);
613 AssertEquals('Correct right',TPrimitiveExpr,B.Right.ClassType);
614 AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(B.Left).Value);
615 AssertEquals('Correct right expression value','different',TPrimitiveExpr(B.Right).Value);
616 end;
617
618 procedure TTestResourcestringParser.TestSimple;
619 begin
620 DoTestSimple;
621 end;
622
623 procedure TTestResourcestringParser.TestSimpleDeprecated;
624 begin
625 Hint:='deprecated';
626 DoTestSimple;
627 CheckHint(hDeprecated);
628 end;
629
630 procedure TTestResourcestringParser.TestSimplePlatform;
631 begin
632 Hint:='platform';
633 DoTestSimple;
634 CheckHint(hPlatform);
635 end;
636
637 procedure TTestResourcestringParser.TestSum2;
638 begin
639 DoTestSum2;
640 end;
641
642 procedure TTestResourcestringParser.TestSum2Deprecated;
643 begin
644 Hint:='deprecated';
645 DoTestSum2;
646 CheckHint(hDeprecated);
647 end;
648
649 procedure TTestResourcestringParser.TestSum2Platform;
650 begin
651 Hint:='platform';
652 DoTestSum2;
653 CheckHint(hplatform);
654 end;
655 procedure TTestResourcestringParser.TestSum1;
656 begin
657 DoTestSum;
658 end;
659
660 procedure TTestResourcestringParser.TestSum1Deprecated;
661 begin
662 Hint:='deprecated';
663 DoTestSum;
664 CheckHint(hDeprecated);
665 end;
666
667 procedure TTestResourcestringParser.TestSum1Platform;
668 begin
669 Hint:='platform';
670 DoTestSum;
671 CheckHint(hplatform);
672 end;
673
674 initialization
675 RegisterTests([TTestConstParser,TTestResourcestringParser]);
676
677
678 end.
679
680