PageRenderTime 60ms CodeModel.GetById 34ms app.highlight 7ms RepoModel.GetById 0ms app.codeStats 1ms

/packages/fcl-passrc/tests/tcscanner.pas

https://github.com/slibre/freepascal
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