/packages/fcl-passrc/tests/tcscanner.pas
Pascal | 1390 lines | 1251 code | 127 blank | 12 comment | 9 complexity | 3e9bcc910adffc33525412c039e787de MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1unit tcscanner; 2 3{$mode objfpc}{$H+} 4 5interface 6 7uses 8 Classes, SysUtils, typinfo, fpcunit, testregistry, pscanner; 9 10type 11 12 { TTestTokenFinder } 13 14 TTestTokenFinder = class(TTestCase) 15 Published 16 Procedure TestFind; 17 end; 18 19 { TTestStreamLineReader } 20 21 22 TTestStreamLineReader = class(TTestCase) 23 Private 24 FReader: TStreamLineReader; 25 Protected 26 procedure NewSource(Const Source : string); 27 Procedure TestLine(Const ALine : String; ExpectEOF : Boolean = True); 28 procedure TearDown; override; 29 Published 30 Procedure TestCreate; 31 Procedure TestEOF; 32 Procedure TestEmptyLine; 33 Procedure TestEmptyLineCR; 34 Procedure TestEmptyLineLF; 35 Procedure TestEmptyLineCRLF; 36 Procedure TestEmptyLineLFCR; 37 Procedure TestOneLine; 38 Procedure TestTwoLines; 39 end; 40 41 { TTestingPascalScanner } 42 43 TTestingPascalScanner = Class(TPascalScanner) 44 private 45 FDoSpecial: Boolean; 46 protected 47 function HandleMacro(AIndex: integer): TToken;override; 48 Public 49 Property DoSpecial : Boolean Read FDoSpecial Write FDoSpecial; 50 end; 51 52 { TTestScanner } 53 TTestScanner= class(TTestCase) 54 Private 55 FLI: String; 56 FScanner : TPascalScanner; 57 FResolver : TStreamResolver; 58 protected 59 procedure SetUp; override; 60 procedure TearDown; override; 61 Function TokenToString(tk : TToken) : string; 62 Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload; 63 procedure NewSource(Const Source : string; DoClear : Boolean = True); 64 Procedure DoTestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True); 65 Procedure TestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True); 66 Procedure TestTokens(t : array of TToken; Const ASource : String; Const CheckEOF : Boolean = True;Const DoClear : Boolean = True); 67 Property LastIDentifier : String Read FLI Write FLi; 68 published 69 procedure TestEOF; 70 procedure TestWhitespace; 71 procedure TestComment1; 72 procedure TestComment2; 73 procedure TestComment3; 74 procedure TestNestedComment1; 75 procedure TestNestedComment2; 76 procedure TestNestedComment3; 77 procedure TestNestedComment4; 78 procedure TestIdentifier; 79 procedure TestString; 80 procedure TestNumber; 81 procedure TestChar; 82 procedure TestBraceOpen; 83 procedure TestBraceClose; 84 procedure TestMul; 85 procedure TestPlus; 86 procedure TestComma; 87 procedure TestMinus; 88 procedure TestDot; 89 procedure TestDivision; 90 procedure TestColon; 91 procedure TestSemicolon; 92 procedure TestLessThan; 93 procedure TestEqual; 94 procedure TestGreaterThan; 95 procedure TestAt; 96 procedure TestSquaredBraceOpen; 97 procedure TestSquaredBraceClose; 98 procedure TestCaret; 99 procedure TestBackslash; 100 procedure TestDotDot; 101 procedure TestAssign; 102 procedure TestAssignPlus; 103 procedure TestAssignMinus; 104 procedure TestAssignMul; 105 procedure TestAssignDivision; 106 procedure TestNotEqual; 107 procedure TestLessEqualThan; 108 procedure TestGreaterEqualThan; 109 procedure TestPower; 110 procedure TestSymmetricalDifference; 111 procedure TestAbsolute; 112 procedure TestAnd; 113 procedure TestArray; 114 procedure TestAs; 115 procedure TestAsm; 116 procedure TestBegin; 117 procedure TestBitpacked; 118 procedure TestCase; 119 procedure TestClass; 120 procedure TestConst; 121 procedure TestConstructor; 122 procedure TestDestructor; 123 procedure TestDiv; 124 procedure TestDo; 125 procedure TestDownto; 126 procedure TestElse; 127 procedure TestEnd; 128 procedure TestExcept; 129 procedure TestExports; 130 procedure TestFalse; 131 procedure TestFile; 132 procedure TestFinalization; 133 procedure TestFinally; 134 procedure TestFor; 135 procedure TestFunction; 136 procedure TestGeneric; 137 procedure TestGoto; 138 Procedure TestHelper; 139 procedure TestIf; 140 procedure TestImplementation; 141 procedure TestIn; 142 procedure TestInherited; 143 procedure TestInitialization; 144 procedure TestInline; 145 procedure TestInterface; 146 procedure TestIs; 147 procedure TestLabel; 148 procedure TestLibrary; 149 procedure TestMod; 150 procedure TestNil; 151 procedure TestNot; 152 procedure TestObject; 153 procedure TestOf; 154 procedure TestOn; 155 procedure TestOperator; 156 procedure TestOr; 157 procedure TestPacked; 158 procedure TestProcedure; 159 procedure TestProgram; 160 procedure TestProperty; 161 procedure TestRaise; 162 procedure TestRecord; 163 procedure TestRepeat; 164 procedure TestResourceString; 165 procedure TestSelf; 166 procedure TestSet; 167 procedure TestShl; 168 procedure TestShr; 169 procedure TestSpecialize; 170 procedure TestThen; 171 procedure TestThreadvar; 172 procedure TestTo; 173 procedure TestTrue; 174 procedure TestTry; 175 procedure TestType; 176 procedure TestUnit; 177 procedure TestUntil; 178 procedure TestUses; 179 procedure TestVar; 180 procedure TestWhile; 181 procedure TestWith; 182 procedure TestXor; 183 procedure TestLineEnding; 184 procedure TestTab; 185 Procedure TestTokenSeries; 186 Procedure TestTokenSeriesNoWhiteSpace; 187 Procedure TestTokenSeriesComments; 188 Procedure TestTokenSeriesNoComments; 189 Procedure TestDefine0; 190 Procedure TestDefine1; 191 Procedure TestDefine2; 192 Procedure TestDefine3; 193 Procedure TestDefine4; 194 Procedure TestDefine5; 195 Procedure TestDefine6; 196 Procedure TestDefine7; 197 Procedure TestDefine8; 198 Procedure TestDefine9; 199 Procedure TestDefine10; 200 Procedure TestDefine11; 201 Procedure TestDefine12; 202 Procedure TestInclude; 203 Procedure TestInclude2; 204 Procedure TestUnDefine1; 205 Procedure TestMacro1; 206 procedure TestMacro2; 207 procedure TestMacro3; 208 procedure TestMacroHandling; 209 end; 210 211implementation 212 213{ TTestingPascalScanner } 214 215function TTestingPascalScanner.HandleMacro(AIndex: integer): TToken; 216begin 217 if DoSpecial then 218 begin 219 Result:=tkIdentifier; 220 SetCurTokenstring('somethingweird'); 221 end 222 else 223 Result:=inherited HandleMacro(AIndex); 224end; 225 226{ TTestTokenFinder } 227 228procedure TTestTokenFinder.TestFind; 229 230Var 231 tk,tkr : TToken; 232 S : string; 233 B : Boolean; 234 235begin 236 For tk:=tkAbsolute to tkXor do 237 begin 238 S:=tokenInfos[tk]; 239 B:=IsNamedToken(S,tkr); 240 AssertEquals('Token '+S+' is a token',true,B); 241 AssertEquals('Token '+S+' returns correct token',Ord(tk),Ord(tkr)); 242 end; 243end; 244 245{ TTestStreamLineReader } 246 247procedure TTestStreamLineReader.NewSource(Const Source: string); 248begin 249 FReader:=TStringStreamLineReader.Create('afile',Source); 250end; 251 252procedure TTestStreamLineReader.TestLine(const ALine: String; ExpectEOF: Boolean); 253begin 254 AssertNotNull('Have reader',FReader); 255 AssertEquals('Reading source line',ALine,FReader.ReadLine); 256 if ExpectEOF then 257 AssertEquals('End of file reached',True,FReader.IsEOF); 258end; 259 260procedure TTestStreamLineReader.TearDown; 261begin 262 inherited TearDown; 263 If Assigned(FReader) then 264 FreeAndNil(Freader); 265end; 266 267procedure TTestStreamLineReader.TestCreate; 268begin 269 FReader:=TStreamLineReader.Create('afile'); 270 AssertEquals('Correct filename','afile',FReader.FileName); 271 AssertEquals('Initially empty',True,FReader.isEOF); 272end; 273 274procedure TTestStreamLineReader.TestEOF; 275begin 276 NewSource(''); 277 AssertEquals('Empty stream',True,FReader.IsEOF); 278end; 279 280procedure TTestStreamLineReader.TestEmptyLine; 281begin 282 NewSource(''); 283 TestLine(''); 284end; 285 286procedure TTestStreamLineReader.TestEmptyLineCR; 287begin 288 NewSource(#13); 289 TestLine(''); 290end; 291 292procedure TTestStreamLineReader.TestEmptyLineLF; 293begin 294 NewSource(#10); 295 TestLine(''); 296end; 297 298procedure TTestStreamLineReader.TestEmptyLineCRLF; 299begin 300 NewSource(#13#10); 301 TestLine(''); 302end; 303 304procedure TTestStreamLineReader.TestEmptyLineLFCR; 305begin 306 NewSource(#10#13); 307 TestLine('',False); 308 TestLine(''); 309end; 310 311procedure TTestStreamLineReader.TestOneLine; 312 313Const 314 S = 'a line with text'; 315begin 316 NewSource(S); 317 TestLine(S); 318end; 319 320procedure TTestStreamLineReader.TestTwoLines; 321Const 322 S = 'a line with text'; 323begin 324 NewSource(S+sLineBreak+S); 325 TestLine(S,False); 326 TestLine(S); 327end; 328 329{ --------------------------------------------------------------------- 330 TTestScanner 331 ---------------------------------------------------------------------} 332 333procedure TTestScanner.SetUp; 334begin 335 FResolver:=TStreamResolver.Create; 336 FResolver.OwnsStreams:=True; 337 FScanner:=TTestingPascalScanner.Create(FResolver); 338 // Do nothing 339end; 340 341procedure TTestScanner.TearDown; 342begin 343 FreeAndNil(FScanner); 344 FreeAndNil(FResolver); 345end; 346 347function TTestScanner.TokenToString(tk: TToken): string; 348begin 349 Result:=GetEnumName(TypeInfo(TToken),Ord(tk)); 350end; 351 352procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TToken); 353begin 354 AssertEquals(Msg,TokenToString(Expected),TokenToString(Actual)); 355end; 356 357procedure TTestScanner.NewSource(const Source: string; DoClear : Boolean = True); 358begin 359 if DoClear then 360 FResolver.Clear; 361 FResolver.AddStream('afile.pp',TStringStream.Create(Source)); 362 FScanner.OpenFile('afile.pp'); 363end; 364 365procedure TTestScanner.DoTestToken(t: TToken; const ASource: String; 366 Const CheckEOF: Boolean); 367 368Var 369 tk : ttoken; 370 371begin 372 NewSource(ASource); 373 tk:=FScanner.FetchToken; 374 AssertEquals('Read token equals expected token.',t,tk); 375 if CheckEOF then 376 begin 377 tk:=FScanner.FetchToken; 378 if (tk=tkLineEnding) and not (t in [tkEOF,tkLineEnding]) then 379 tk:=FScanner.FetchToken; 380 AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken); 381 end; 382end; 383 384procedure TTestScanner.TestToken(t: TToken; const ASource: String; Const CheckEOF: Boolean); 385Var 386 S : String; 387begin 388 DoTestToken(t,ASource); 389 if (ASource<>'') then 390 begin 391 S:=ASource; 392 S[1]:=Upcase(S[1]); 393 DoTestToken(t,S); 394 end; 395 DoTestToken(t,UpperCase(ASource)); 396 DoTestToken(t,LowerCase(ASource)); 397end; 398 399procedure TTestScanner.TestTokens(t: array of TToken; const ASource: String; 400 const CheckEOF: Boolean;Const DoClear : Boolean = True); 401Var 402 tk : ttoken; 403 i : integer; 404 405begin 406 NewSource(ASource,DoClear); 407 For I:=Low(t) to High(t) do 408 begin 409 tk:=FScanner.FetchToken; 410 AssertEquals(Format('Read token %d equals expected token.',[i]),t[i],tk); 411 if tk=tkIdentifier then 412 LastIdentifier:=FScanner.CurtokenString; 413 end; 414 if CheckEOF then 415 begin 416 tk:=FScanner.FetchToken; 417 if (tk=tkLineEnding) then 418 tk:=FScanner.FetchToken; 419 AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken); 420 end; 421end; 422 423procedure TTestScanner.TestEOF; 424begin 425 TestToken(tkEOF,'') 426end; 427 428procedure TTestScanner.TestWhitespace; 429 430begin 431 TestToken(tkWhitespace,' '); 432 TestToken(tkWhitespace,' '); 433end; 434 435 436procedure TTestScanner.TestComment1; 437 438begin 439 TestToken(tkComment,'{ comment }'); 440end; 441 442 443procedure TTestScanner.TestComment2; 444 445begin 446 TestToken(tkComment,'(* comment *)'); 447end; 448 449 450procedure TTestScanner.TestComment3; 451 452begin 453 TestToken(tkComment,'//'); 454end; 455 456procedure TTestScanner.TestNestedComment1; 457begin 458 TestToken(tkComment,'// { comment } '); 459end; 460 461procedure TTestScanner.TestNestedComment2; 462begin 463 TestToken(tkComment,'(* { comment } *)'); 464end; 465 466procedure TTestScanner.TestNestedComment3; 467begin 468 TestToken(tkComment,'{ { comment } }'); 469end; 470 471procedure TTestScanner.TestNestedComment4; 472begin 473 TestToken(tkComment,'{ (* comment *) }'); 474end; 475 476 477procedure TTestScanner.TestIdentifier; 478 479begin 480 TestToken(tkIdentifier,'identifier'); 481end; 482 483 484procedure TTestScanner.TestString; 485 486begin 487 TestToken(pscanner.tkString,'''A string'''); 488end; 489 490 491procedure TTestScanner.TestNumber; 492 493begin 494 TestToken(tkNumber,'123'); 495end; 496 497 498procedure TTestScanner.TestChar; 499 500begin 501 TestToken(pscanner.tkChar,'#65 ', false); 502end; 503 504 505procedure TTestScanner.TestBraceOpen; 506 507begin 508 TestToken(tkBraceOpen,'('); 509end; 510 511 512procedure TTestScanner.TestBraceClose; 513 514begin 515 TestToken(tkBraceClose,')'); 516end; 517 518 519procedure TTestScanner.TestMul; 520 521begin 522 TestToken(tkMul,'*'); 523end; 524 525 526procedure TTestScanner.TestPlus; 527 528begin 529 TestToken(tkPlus,'+'); 530end; 531 532 533procedure TTestScanner.TestComma; 534 535begin 536 TestToken(tkComma,','); 537end; 538 539 540procedure TTestScanner.TestMinus; 541 542begin 543 TestToken(tkMinus,'-'); 544end; 545 546 547procedure TTestScanner.TestDot; 548 549begin 550 TestToken(tkDot,'.'); 551end; 552 553 554procedure TTestScanner.TestDivision; 555 556begin 557 TestToken(tkDivision,'/'); 558end; 559 560 561procedure TTestScanner.TestColon; 562 563begin 564 TestToken(tkColon,':'); 565end; 566 567 568procedure TTestScanner.TestSemicolon; 569 570begin 571 TestToken(tkSemicolon,';'); 572end; 573 574 575procedure TTestScanner.TestLessThan; 576 577begin 578 TestToken(tkLessThan,'<'); 579end; 580 581 582procedure TTestScanner.TestEqual; 583 584begin 585 TestToken(tkEqual,'='); 586end; 587 588 589procedure TTestScanner.TestGreaterThan; 590 591begin 592 TestToken(tkGreaterThan,'>'); 593end; 594 595 596procedure TTestScanner.TestAt; 597 598begin 599 TestToken(tkAt,'@'); 600end; 601 602 603procedure TTestScanner.TestSquaredBraceOpen; 604 605begin 606 TestToken(tkSquaredBraceOpen,'['); 607end; 608 609 610procedure TTestScanner.TestSquaredBraceClose; 611 612begin 613 TestToken(tkSquaredBraceClose,']'); 614end; 615 616 617procedure TTestScanner.TestCaret; 618 619begin 620 TestToken(tkCaret,'^'); 621end; 622 623 624procedure TTestScanner.TestBackslash; 625 626begin 627 TestToken(tkBackslash,'\'); 628end; 629 630 631procedure TTestScanner.TestDotDot; 632 633begin 634 TestToken(tkDotDot,'..'); 635end; 636 637 638procedure TTestScanner.TestAssign; 639 640begin 641 TestToken(tkAssign,':='); 642end; 643 644procedure TTestScanner.TestAssignPlus; 645begin 646 TestTokens([tkPlus,tkEqual],'+='); 647 FScanner.Options:=[po_cassignments]; 648 TestToken(tkAssignPlus,'+='); 649end; 650 651procedure TTestScanner.TestAssignMinus; 652begin 653 TestTokens([tkMinus,tkEqual],'-='); 654 FScanner.Options:=[po_cassignments]; 655 TestToken(tkAssignMinus,'-='); 656end; 657 658procedure TTestScanner.TestAssignMul; 659begin 660 TestTokens([tkMul,tkEqual],'*='); 661 FScanner.Options:=[po_cassignments]; 662 TestToken(tkAssignMul,'*='); 663end; 664 665procedure TTestScanner.TestAssignDivision; 666begin 667 TestTokens([tkDivision,tkEqual],'/='); 668 FScanner.Options:=[po_cassignments]; 669 TestToken(tkAssignDivision,'/='); 670end; 671 672 673procedure TTestScanner.TestNotEqual; 674 675begin 676 TestToken(tkNotEqual,'<>'); 677end; 678 679 680procedure TTestScanner.TestLessEqualThan; 681 682begin 683 TestToken(tkLessEqualThan,'<='); 684end; 685 686 687procedure TTestScanner.TestGreaterEqualThan; 688 689begin 690 TestToken(tkGreaterEqualThan,'>='); 691end; 692 693 694procedure TTestScanner.TestPower; 695 696begin 697 TestToken(tkPower,'**'); 698end; 699 700 701procedure TTestScanner.TestSymmetricalDifference; 702 703begin 704 TestToken(tkSymmetricalDifference,'><'); 705end; 706 707 708procedure TTestScanner.TestAbsolute; 709 710begin 711 TestToken(tkabsolute,'absolute'); 712end; 713 714 715procedure TTestScanner.TestAnd; 716 717begin 718 TestToken(tkand,'and'); 719end; 720 721 722procedure TTestScanner.TestArray; 723 724begin 725 TestToken(tkarray,'array'); 726end; 727 728 729procedure TTestScanner.TestAs; 730 731begin 732 TestToken(tkas,'as'); 733end; 734 735 736procedure TTestScanner.TestAsm; 737 738begin 739 TestToken(tkasm,'asm'); 740end; 741 742 743procedure TTestScanner.TestBegin; 744 745begin 746 TestToken(tkbegin,'begin'); 747end; 748 749 750procedure TTestScanner.TestBitpacked; 751 752begin 753 TestToken(tkbitpacked,'bitpacked'); 754end; 755 756 757procedure TTestScanner.TestCase; 758 759begin 760 TestToken(tkcase,'case'); 761end; 762 763 764procedure TTestScanner.TestClass; 765 766begin 767 TestToken(tkclass,'class'); 768end; 769 770 771procedure TTestScanner.TestConst; 772 773begin 774 TestToken(tkconst,'const'); 775end; 776 777 778procedure TTestScanner.TestConstructor; 779 780begin 781 TestToken(tkconstructor,'constructor'); 782end; 783 784 785procedure TTestScanner.TestDestructor; 786 787begin 788 TestToken(tkdestructor,'destructor'); 789end; 790 791 792procedure TTestScanner.TestDiv; 793 794begin 795 TestToken(tkdiv,'div'); 796end; 797 798 799procedure TTestScanner.TestDo; 800 801begin 802 TestToken(tkdo,'do'); 803end; 804 805 806procedure TTestScanner.TestDownto; 807 808begin 809 TestToken(tkdownto,'downto'); 810end; 811 812 813procedure TTestScanner.TestElse; 814 815begin 816 TestToken(tkelse,'else'); 817end; 818 819 820procedure TTestScanner.TestEnd; 821 822begin 823 TestToken(tkend,'end'); 824end; 825 826 827procedure TTestScanner.TestExcept; 828 829begin 830 TestToken(tkexcept,'except'); 831end; 832 833 834procedure TTestScanner.TestExports; 835 836begin 837 TestToken(tkexports,'exports'); 838end; 839 840 841procedure TTestScanner.TestFalse; 842 843begin 844 TestToken(tkfalse,'false'); 845end; 846 847 848procedure TTestScanner.TestFile; 849 850begin 851 TestToken(tkfile,'file'); 852end; 853 854 855procedure TTestScanner.TestFinalization; 856 857begin 858 TestToken(tkfinalization,'finalization'); 859end; 860 861 862procedure TTestScanner.TestFinally; 863 864begin 865 TestToken(tkfinally,'finally'); 866end; 867 868 869procedure TTestScanner.TestFor; 870 871begin 872 TestToken(tkfor,'for'); 873end; 874 875 876procedure TTestScanner.TestFunction; 877 878begin 879 TestToken(tkfunction,'function'); 880end; 881 882 883procedure TTestScanner.TestGeneric; 884 885begin 886 TestToken(tkgeneric,'generic'); 887end; 888 889 890procedure TTestScanner.TestGoto; 891 892begin 893 TestToken(tkgoto,'goto'); 894end; 895 896procedure TTestScanner.TestHelper; 897begin 898 TestToken(tkHelper,'helper'); 899end; 900 901 902procedure TTestScanner.TestIf; 903 904begin 905 TestToken(tkif,'if'); 906end; 907 908 909procedure TTestScanner.TestImplementation; 910 911begin 912 TestToken(tkimplementation,'implementation'); 913end; 914 915 916procedure TTestScanner.TestIn; 917 918begin 919 TestToken(tkin,'in'); 920end; 921 922 923procedure TTestScanner.TestInherited; 924 925begin 926 TestToken(tkinherited,'inherited'); 927end; 928 929 930procedure TTestScanner.TestInitialization; 931 932begin 933 TestToken(tkinitialization,'initialization'); 934end; 935 936 937procedure TTestScanner.TestInline; 938 939begin 940 TestToken(tkinline,'inline'); 941end; 942 943 944procedure TTestScanner.TestInterface; 945 946begin 947 TestToken(tkinterface,'interface'); 948end; 949 950 951procedure TTestScanner.TestIs; 952 953begin 954 TestToken(tkis,'is'); 955end; 956 957 958procedure TTestScanner.TestLabel; 959 960begin 961 TestToken(tklabel,'label'); 962end; 963 964 965procedure TTestScanner.TestLibrary; 966 967begin 968 TestToken(tklibrary,'library'); 969end; 970 971 972procedure TTestScanner.TestMod; 973 974begin 975 TestToken(tkmod,'mod'); 976end; 977 978 979procedure TTestScanner.TestNil; 980 981begin 982 TestToken(tknil,'nil'); 983end; 984 985 986procedure TTestScanner.TestNot; 987 988begin 989 TestToken(tknot,'not'); 990end; 991 992 993procedure TTestScanner.TestObject; 994 995begin 996 TestToken(tkobject,'object'); 997end; 998 999 1000procedure TTestScanner.TestOf; 1001 1002begin 1003 TestToken(tkof,'of'); 1004end; 1005 1006 1007procedure TTestScanner.TestOn; 1008 1009begin 1010 TestToken(tkon,'on'); 1011end; 1012 1013 1014procedure TTestScanner.TestOperator; 1015 1016begin 1017 TestToken(tkoperator,'operator'); 1018end; 1019 1020 1021procedure TTestScanner.TestOr; 1022 1023begin 1024 TestToken(tkor,'or'); 1025end; 1026 1027 1028procedure TTestScanner.TestPacked; 1029 1030begin 1031 TestToken(tkpacked,'packed'); 1032end; 1033 1034 1035procedure TTestScanner.TestProcedure; 1036 1037begin 1038 TestToken(tkprocedure,'procedure'); 1039end; 1040 1041 1042procedure TTestScanner.TestProgram; 1043 1044begin 1045 TestToken(tkprogram,'program'); 1046end; 1047 1048 1049procedure TTestScanner.TestProperty; 1050 1051begin 1052 TestToken(tkproperty,'property'); 1053end; 1054 1055 1056procedure TTestScanner.TestRaise; 1057 1058begin 1059 TestToken(tkraise,'raise'); 1060end; 1061 1062 1063procedure TTestScanner.TestRecord; 1064 1065begin 1066 TestToken(tkrecord,'record'); 1067end; 1068 1069 1070procedure TTestScanner.TestRepeat; 1071 1072begin 1073 TestToken(tkrepeat,'repeat'); 1074end; 1075 1076 1077procedure TTestScanner.TestResourceString; 1078 1079begin 1080 TestToken(tkResourceString,'resourcestring'); 1081end; 1082 1083 1084procedure TTestScanner.TestSelf; 1085 1086begin 1087 TestToken(tkself,'self'); 1088end; 1089 1090 1091procedure TTestScanner.TestSet; 1092 1093begin 1094 TestToken(tkset,'set'); 1095end; 1096 1097 1098procedure TTestScanner.TestShl; 1099 1100begin 1101 TestToken(tkshl,'shl'); 1102end; 1103 1104 1105procedure TTestScanner.TestShr; 1106 1107begin 1108 TestToken(tkshr,'shr'); 1109end; 1110 1111 1112procedure TTestScanner.TestSpecialize; 1113 1114begin 1115 TestToken(tkspecialize,'specialize'); 1116end; 1117 1118 1119procedure TTestScanner.TestThen; 1120 1121begin 1122 TestToken(tkthen,'then'); 1123end; 1124 1125 1126procedure TTestScanner.TestThreadvar; 1127 1128begin 1129 TestToken(tkthreadvar,'threadvar'); 1130end; 1131 1132 1133procedure TTestScanner.TestTo; 1134 1135begin 1136 TestToken(tkto,'to'); 1137end; 1138 1139 1140procedure TTestScanner.TestTrue; 1141 1142begin 1143 TestToken(tktrue,'true'); 1144end; 1145 1146 1147procedure TTestScanner.TestTry; 1148 1149begin 1150 TestToken(tktry,'try'); 1151end; 1152 1153 1154procedure TTestScanner.TestType; 1155 1156begin 1157 TestToken(tktype,'type'); 1158end; 1159 1160 1161procedure TTestScanner.TestUnit; 1162 1163begin 1164 TestToken(tkunit,'unit'); 1165end; 1166 1167 1168procedure TTestScanner.TestUntil; 1169 1170begin 1171 TestToken(tkuntil,'until'); 1172end; 1173 1174 1175procedure TTestScanner.TestUses; 1176 1177begin 1178 TestToken(tkuses,'uses'); 1179end; 1180 1181 1182procedure TTestScanner.TestVar; 1183 1184begin 1185 TestToken(tkvar,'var'); 1186end; 1187 1188 1189procedure TTestScanner.TestWhile; 1190 1191begin 1192 TestToken(tkwhile,'while'); 1193end; 1194 1195 1196procedure TTestScanner.TestWith; 1197 1198begin 1199 TestToken(tkwith,'with'); 1200end; 1201 1202 1203procedure TTestScanner.TestXor; 1204 1205begin 1206 TestToken(tkxor,'xor'); 1207end; 1208 1209 1210procedure TTestScanner.TestLineEnding; 1211 1212begin 1213 TestToken(tkLineEnding,#10); 1214end; 1215 1216 1217procedure TTestScanner.TestTab; 1218 1219begin 1220 TestToken(tkTab,#9); 1221end; 1222 1223procedure TTestScanner.TestTokenSeries; 1224begin 1225 TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkthen,tkWhiteSpace,tkIdentifier],'in of then aninteger') 1226end; 1227 1228procedure TTestScanner.TestTokenSeriesNoWhiteSpace; 1229begin 1230 FScanner.SkipWhiteSpace:=True; 1231 TestTokens([tkin,tkOf,tkthen,tkIdentifier],'in of then aninteger') 1232end; 1233 1234procedure TTestScanner.TestTokenSeriesComments; 1235begin 1236 TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkComment,tkWhiteSpace,tkIdentifier],'in of {then} aninteger') 1237end; 1238 1239procedure TTestScanner.TestTokenSeriesNoComments; 1240begin 1241 FScanner.SkipComments:=True; 1242 TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkWhiteSpace,tkIdentifier],'in of {then} aninteger') 1243end; 1244 1245procedure TTestScanner.TestDefine0; 1246begin 1247 TestTokens([tkComment],'{$DEFINE NEVER}'); 1248 If FSCanner.Defines.IndexOf('NEVER')=-1 then 1249 Fail('Define not defined'); 1250end; 1251 1252procedure TTestScanner.TestDefine1; 1253begin 1254 TestTokens([tkComment],'{$IFDEF NEVER} of {$ENDIF}'); 1255end; 1256 1257procedure TTestScanner.TestDefine2; 1258 1259begin 1260 FSCanner.Defines.Add('ALWAYS'); 1261 TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ENDIF}'); 1262end; 1263 1264procedure TTestScanner.TestDefine3; 1265begin 1266 FSCanner.Defines.Add('ALWAYS'); 1267 TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}'); 1268end; 1269 1270procedure TTestScanner.TestDefine4; 1271begin 1272 TestTokens([tkComment,tkWhitespace,tkin,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}'); 1273end; 1274 1275procedure TTestScanner.TestDefine5; 1276begin 1277 FScanner.SkipComments:=True; 1278 TestTokens([tkLineEnding],'{$IFDEF NEVER} of {$ENDIF}'); 1279end; 1280 1281procedure TTestScanner.TestDefine6; 1282 1283begin 1284 FSCanner.Defines.Add('ALWAYS'); 1285 FScanner.SkipComments:=True; 1286 TestTokens([tkWhitespace,tkOf,tkWhitespace],'{$IFDEF ALWAYS} of {$ENDIF}'); 1287end; 1288 1289procedure TTestScanner.TestDefine7; 1290begin 1291 FSCanner.Defines.Add('ALWAYS'); 1292 FScanner.SkipComments:=True; 1293 TestTokens([tkWhitespace,tkOf,tkWhitespace],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}'); 1294end; 1295 1296procedure TTestScanner.TestDefine8; 1297begin 1298 FScanner.SkipComments:=True; 1299 TestTokens([tkWhitespace,tkin,tkWhitespace],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}'); 1300end; 1301 1302procedure TTestScanner.TestDefine9; 1303begin 1304 FScanner.SkipWhiteSpace:=True; 1305 TestTokens([],'{$IFDEF NEVER} of {$ENDIF}'); 1306end; 1307 1308procedure TTestScanner.TestDefine10; 1309 1310begin 1311 FSCanner.Defines.Add('ALWAYS'); 1312 FScanner.SkipComments:=True; 1313 TestTokens([tkWhitespace,tkOf,tkWhitespace],'{$IFDEF ALWAYS} of {$ENDIF}'); 1314end; 1315 1316procedure TTestScanner.TestDefine11; 1317begin 1318 FSCanner.Defines.Add('ALWAYS'); 1319 FScanner.SkipComments:=True; 1320 FScanner.SkipWhiteSpace:=True; 1321 TestTokens([tkOf],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}'); 1322end; 1323 1324procedure TTestScanner.TestDefine12; 1325begin 1326 FScanner.SkipComments:=True; 1327 FScanner.SkipWhiteSpace:=True; 1328 TestTokens([tkin],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}'); 1329end; 1330 1331procedure TTestScanner.TestInclude; 1332begin 1333 FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then')); 1334 FScanner.SkipWhiteSpace:=True; 1335 FScanner.SkipComments:=True; 1336 TestTokens([tkIf,tkTrue,tkThen],'{$I myinclude.inc}',True,False); 1337end; 1338 1339procedure TTestScanner.TestInclude2; 1340begin 1341 FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then')); 1342 FScanner.SkipWhiteSpace:=True; 1343 FScanner.SkipComments:=True; 1344 TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I myinclude.inc} else',True,False); 1345end; 1346 1347procedure TTestScanner.TestUnDefine1; 1348begin 1349 FSCanner.Defines.Add('ALWAYS'); 1350 TestTokens([tkComment],'{$UNDEF ALWAYS}'); 1351 AssertEquals('No more define',-1,FScanner.Defines.INdexOf('ALWAYS')); 1352end; 1353 1354procedure TTestScanner.TestMacro1; 1355begin 1356 FScanner.SkipWhiteSpace:=True; 1357 FScanner.SkipComments:=True; 1358 TestTokens([tkbegin,tkend,tkDot],'{$DEFINE MM:=begin end.}'#13#10'MM',True,False); 1359end; 1360 1361procedure TTestScanner.TestMacro2; 1362begin 1363 FScanner.SkipWhiteSpace:=True; 1364 FScanner.SkipComments:=True; 1365 TestTokens([tkbegin,tkend,tkDot],'{$DEFINE MM:=begin end}'#13#10'MM .',True,False); 1366end; 1367 1368procedure TTestScanner.TestMacro3; 1369begin 1370 FScanner.SkipComments:=True; 1371 FScanner.SkipWhiteSpace:=True; 1372 TestTokens([tkof],'{$DEFINE MM:=begin end}'#13#10'{$IFDEF MM} of {$ELSE} in {$ENDIF}'); 1373end; 1374 1375procedure TTestScanner.TestMacroHandling; 1376begin 1377 TTestingPascalScanner(FScanner).DoSpecial:=True; 1378 FScanner.SkipComments:=True; 1379 FScanner.SkipWhiteSpace:=True; 1380 TestTokens([tkIdentifier],'{$DEFINE MM:=begin end}'#13#10'MM'); 1381 AssertEQuals('Correct identifier', 'somethingweird',LastIdentifier); 1382end; 1383 1384 1385 1386 1387initialization 1388 RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]); 1389end. 1390