tcbaseparser.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693
  1. unit tcbaseparser;
  2. {$mode objfpc}{$H+}
  3. {$define NOCONSOLE}
  4. interface
  5. uses
  6. Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
  7. const
  8. DefaultMainFilename = 'afile.pp';
  9. Type
  10. { TTestEngine }
  11. TTestEngine = Class(TPasTreeContainer)
  12. Private
  13. FList : TFPList;
  14. public
  15. Destructor Destroy; override;
  16. Function HandleResultOnError(aElement: TPasElement): Boolean; override;
  17. function CreateElement(AClass: TPTreeElement; const AName: String;
  18. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  19. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  20. override;
  21. function FindElement(const AName: String): TPasElement; override;
  22. end;
  23. TTestPasParser = Class(TPasParser);
  24. { TTestParser }
  25. TTestParser = class(TTestCase)
  26. Private
  27. FDeclarations: TPasDeclarations;
  28. FDefinition: TPasElement;
  29. FEngine : TPasTreeContainer;
  30. FErrorCount: integer;
  31. FLastErrorNumber: Integer;
  32. FLastMessage: String;
  33. FMainFilename: string;
  34. FMessagecount: Integer;
  35. FModule: TPasModule;
  36. FParseResult: TPasElement;
  37. FScanner : TPascalScanner;
  38. FResolver : TStreamResolver;
  39. FParser : TTestPasParser;
  40. FSource: TStrings;
  41. FFileName : string;
  42. FIsUnit : Boolean;
  43. FImplementation : Boolean;
  44. FEndSource: Boolean;
  45. FUseImplementation: Boolean;
  46. function GetPL: TPasLibrary;
  47. function GetPP: TPasProgram;
  48. procedure CleanupParser;
  49. procedure SetupParser;
  50. protected
  51. procedure SetUp; override;
  52. procedure TearDown; override;
  53. procedure DoParserError(Sender: TObject; const aContext: TRecoveryContext; var Allow: Boolean); virtual;
  54. procedure DoParserLog(Sender: TObject; const Msg: String); // Virtual;
  55. procedure CreateEngine(var TheEngine: TPasTreeContainer); virtual;
  56. Procedure StartUnit(AUnitName : String);
  57. Procedure StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
  58. Procedure StartLibrary(AFileName : String);
  59. Procedure UsesClause(Units : Array of string);
  60. Procedure StartImplementation;
  61. Procedure EndSource;
  62. Procedure Add(Const ALine : String);
  63. Procedure Add(Const Lines : array of String);
  64. Procedure StartParsing;
  65. Procedure ParseDeclarations;
  66. Procedure ParseModule; virtual;
  67. procedure ResetParser;
  68. Procedure CheckHint(AHint : TPasMemberHint);
  69. Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AClass : TClass) : TPasExpr;
  70. Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AValue : String) : TPrimitiveExpr;
  71. Function AssertExpression(Const Msg: String; AExpr : TPasExpr; OpCode : TExprOpCode) : TBinaryExpr;
  72. Procedure AssertExportSymbol(Const Msg: String; AIndex : Integer; AName,AExportName : String; AExportIndex : Integer = -1);
  73. Procedure AssertErrorCount(Const aMsg : String; const aExpected : Integer); overload;
  74. Procedure AssertErrorCount(Const aExpected : Integer); overload;
  75. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasExprKind); overload;
  76. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TLoopType); overload;
  77. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasObjKind); overload;
  78. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TExprOpCode); overload;
  79. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberHint); overload;
  80. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TCallingConvention); overload;
  81. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TArgumentAccess); overload;
  82. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifier); overload;
  83. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifiers); overload;
  84. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberVisibility); overload;
  85. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifier); overload;
  86. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
  87. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcTypeModifiers); overload;
  88. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
  89. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
  90. Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); overload;
  91. Procedure AssertSame(Const Msg : String; AExpected, AActual: TPasElement); overload;
  92. Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
  93. Property Resolver : TStreamResolver Read FResolver;
  94. Property Scanner : TPascalScanner Read FScanner;
  95. Property Engine : TPasTreeContainer read FEngine;
  96. Property Parser : TTestPasParser read FParser ;
  97. Property Source : TStrings Read FSource;
  98. Property Module : TPasModule Read FModule;
  99. Property PasProgram : TPasProgram Read GetPP;
  100. Property PasLibrary : TPasLibrary Read GetPL;
  101. Property Declarations : TPasDeclarations read FDeclarations Write FDeclarations;
  102. Property Definition : TPasElement Read FDefinition Write FDefinition;
  103. // If set, Will be freed in teardown
  104. Property ParseResult : TPasElement Read FParseResult Write FParseResult;
  105. Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
  106. Property MainFilename: string read FMainFilename write FMainFilename;
  107. Property LastMessage : String Read FLastMessage;
  108. Property MessageCount : Integer Read FMessagecount;
  109. Property ErrorCount : integer Read FErrorCount;
  110. Property LastErrorNumber : Integer Read FLastErrorNumber;
  111. end;
  112. implementation
  113. uses typinfo;
  114. { TTestEngine }
  115. destructor TTestEngine.Destroy;
  116. begin
  117. FreeAndNil(FList);
  118. inherited Destroy;
  119. end;
  120. function TTestEngine.HandleResultOnError(aElement: TPasElement): Boolean;
  121. begin
  122. if aElement=nil then ;
  123. Result:=False;
  124. end;
  125. function TTestEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  126. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  127. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  128. begin
  129. //writeln('TTestEngine.CreateElement ',AName,' ',AClass.ClassName);
  130. Result := AClass.Create(AName, AParent);
  131. FOwnedElements.Add(Result);
  132. {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('CreateElement');{$ENDIF}
  133. Result.Visibility := AVisibility;
  134. Result.SourceFilename := ASourceFilename;
  135. Result.SourceLinenumber := ASourceLinenumber;
  136. if NeedComments and Assigned(CurrentParser) then
  137. begin
  138. // Writeln('Saving comment : ',CurrentParser.SavedComments);
  139. Result.DocComment:=CurrentParser.SavedComments;
  140. end;
  141. if AName<>'' then
  142. begin
  143. If not Assigned(FList) then
  144. FList:=TFPList.Create;
  145. FList.Add(Result);
  146. end;
  147. end;
  148. function TTestEngine.FindElement(const AName: String): TPasElement;
  149. Var
  150. I : Integer;
  151. begin
  152. Result:=Nil;
  153. if Assigned(FList) then
  154. begin
  155. I:=FList.Count-1;
  156. While (Result=Nil) and (I>=0) do
  157. begin
  158. if CompareText(TPasElement(FList[I]).Name,AName)=0 then
  159. Result:=TPasElement(FList[i]);
  160. Dec(i);
  161. end;
  162. end;
  163. end;
  164. function TTestParser.GetPP: TPasProgram;
  165. begin
  166. Result:=Module as TPasProgram;
  167. end;
  168. function TTestParser.GetPL: TPasLibrary;
  169. begin
  170. Result:=Module as TPasLibrary;
  171. end;
  172. procedure TTestParser.DoParserLog(Sender: TObject; const Msg: String);
  173. begin
  174. Inc(FMessageCount);
  175. FLastMessage:=Msg;
  176. end;
  177. procedure TTestParser.DoParserError(Sender: TObject; const aContext: TRecoveryContext; var Allow : Boolean);
  178. begin
  179. Inc(FErrorCount);
  180. if aContext.Error is EParserError then
  181. FLastErrorNumber:=EParserError(aContext.Error).ErrNo;
  182. end;
  183. procedure TTestParser.SetupParser;
  184. begin
  185. FResolver:=TStreamResolver.Create;
  186. FResolver.OwnsStreams:=True;
  187. FScanner:=TPascalScanner.Create(FResolver);
  188. FScanner.CurrentBoolSwitches:=FScanner.CurrentBoolSwitches+[bsHints,bsNotes,bsWarnings];
  189. CreateEngine(FEngine);
  190. FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
  191. FSource:=TStringList.Create;
  192. FModule:=Nil;
  193. FDeclarations:=Nil;
  194. FEndSource:=False;
  195. FImplementation:=False;
  196. FIsUnit:=False;
  197. FMessageCount:=0;
  198. FLastMessage:='';
  199. FLastErrorNumber:=0;
  200. FErrorCount:=0;
  201. FParser.OnLog:=@DoParserLog;
  202. FParser.OnError:=@DoParserError;
  203. end;
  204. procedure TTestParser.CleanupParser;
  205. begin
  206. {$IFDEF VerbosePasResolverMem}
  207. writeln('TTestParser.CleanupParser START');
  208. {$ENDIF}
  209. if Not Assigned(FModule) then
  210. FreeAndNil(FDeclarations)
  211. else
  212. FDeclarations:=Nil;
  213. FImplementation:=False;
  214. FEndSource:=False;
  215. FIsUnit:=False;
  216. {$IFDEF VerbosePasResolverMem}
  217. writeln('TTestParser.CleanupParser FModule');
  218. {$ENDIF}
  219. FModule:=nil;
  220. {$IFDEF VerbosePasResolverMem}
  221. writeln('TTestParser.CleanupParser FSource');
  222. {$ENDIF}
  223. FreeAndNil(FSource);
  224. {$IFDEF VerbosePasResolverMem}
  225. writeln('TTestParser.CleanupParser FParseResult');
  226. {$ENDIF}
  227. FreeAndNil(FParseResult);
  228. {$IFDEF VerbosePasResolverMem}
  229. writeln('TTestParser.CleanupParser FParser');
  230. {$ENDIF}
  231. FreeAndNil(FParser);
  232. {$IFDEF VerbosePasResolverMem}
  233. writeln('TTestParser.CleanupParser FEngine');
  234. {$ENDIF}
  235. FreeAndNil(FEngine);
  236. {$IFDEF VerbosePasResolverMem}
  237. writeln('TTestParser.CleanupParser FScanner');
  238. {$ENDIF}
  239. FreeAndNil(FScanner);
  240. {$IFDEF VerbosePasResolverMem}
  241. writeln('TTestParser.CleanupParser FResolver');
  242. {$ENDIF}
  243. FreeAndNil(FResolver);
  244. {$IFDEF VerbosePasResolverMem}
  245. writeln('TTestParser.CleanupParser END');
  246. {$ENDIF}
  247. end;
  248. procedure TTestParser.ResetParser;
  249. begin
  250. CleanupParser;
  251. SetupParser;
  252. end;
  253. procedure TTestParser.SetUp;
  254. begin
  255. FMainFilename:=DefaultMainFilename;
  256. Inherited;
  257. SetupParser;
  258. end;
  259. procedure TTestParser.TearDown;
  260. begin
  261. {$IFDEF VerbosePasResolverMem}
  262. writeln('TTestParser.TearDown START CleanupParser');
  263. {$ENDIF}
  264. CleanupParser;
  265. {$IFDEF VerbosePasResolverMem}
  266. writeln('TTestParser.TearDown inherited');
  267. {$ENDIF}
  268. Inherited;
  269. {$IFDEF VerbosePasResolverMem}
  270. writeln('TTestParser.TearDown END');
  271. {$ENDIF}
  272. end;
  273. procedure TTestParser.CreateEngine(var TheEngine: TPasTreeContainer);
  274. begin
  275. TheEngine:=TTestEngine.Create;
  276. end;
  277. procedure TTestParser.StartUnit(AUnitName: String);
  278. begin
  279. FIsUnit:=True;
  280. If (AUnitName='') then
  281. AUnitName:=ExtractFileUnitName(MainFilename);
  282. Add('unit '+aUnitName+';');
  283. Add('');
  284. Add('interface');
  285. Add('');
  286. FFileName:=AUnitName+'.pp';
  287. end;
  288. procedure TTestParser.StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
  289. begin
  290. FIsUnit:=False;
  291. If (AFileName='') then
  292. AFileName:='proga';
  293. FFileName:=AFileName+'.pp';
  294. If (AIn<>'') then
  295. begin
  296. AFileName:=AFileName+'('+AIn;
  297. if (AOut<>'') then
  298. AFileName:=AFileName+','+AOut;
  299. AFileName:=AFileName+')';
  300. end;
  301. Add('program '+AFileName+';');
  302. FImplementation:=True;
  303. end;
  304. procedure TTestParser.StartLibrary(AFileName: String);
  305. begin
  306. FIsUnit:=False;
  307. If (AFileName='') then
  308. AFileName:='liba';
  309. FFileName:=AFileName+'.pp';
  310. Add('library '+AFileName+';');
  311. FImplementation:=True;
  312. end;
  313. procedure TTestParser.UsesClause(Units: array of string);
  314. Var
  315. S : String;
  316. I : integer;
  317. begin
  318. S:='';
  319. For I:=Low(units) to High(units) do
  320. begin
  321. If (S<>'') then
  322. S:=S+', ';
  323. S:=S+Units[i];
  324. end;
  325. Add('uses '+S+';');
  326. Add('');
  327. end;
  328. procedure TTestParser.StartImplementation;
  329. begin
  330. if Not FImplementation then
  331. begin
  332. if UseImplementation then
  333. begin
  334. FSource.Insert(0,'');
  335. FSource.Insert(0,'Implementation');
  336. FSource.Insert(0,'');
  337. end
  338. else
  339. begin
  340. Add('');
  341. Add('Implementation');
  342. Add('');
  343. end;
  344. FImplementation:=True;
  345. end;
  346. end;
  347. procedure TTestParser.EndSource;
  348. begin
  349. if Not FEndSource then
  350. begin
  351. Add('end.');
  352. FEndSource:=True;
  353. end;
  354. end;
  355. procedure TTestParser.Add(const ALine: String);
  356. begin
  357. FSource.Add(ALine);
  358. end;
  359. procedure TTestParser.Add(const Lines: array of String);
  360. var
  361. i: Integer;
  362. begin
  363. for i:=Low(Lines) to High(Lines) do
  364. Add(Lines[i]);
  365. end;
  366. procedure TTestParser.StartParsing;
  367. var
  368. i: Integer;
  369. begin
  370. If FIsUnit then
  371. StartImplementation;
  372. EndSource;
  373. If (FFileName='') then
  374. FFileName:=MainFilename;
  375. FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
  376. FScanner.OpenFile(FFileName);
  377. { $ifndef NOCONSOLE} // JC: To get the tests to run with GUI
  378. Writeln('// Test : ',Self.TestName);
  379. for i:=0 to FSource.Count-1 do
  380. Writeln(Format('%:4d: ',[i+1]),FSource[i]);
  381. { $EndIf}
  382. end;
  383. procedure TTestParser.ParseDeclarations;
  384. begin
  385. if UseImplementation then
  386. StartImplementation;
  387. FSource.Insert(0,'');
  388. FSource.Insert(0,'interface');
  389. FSource.Insert(0,'');
  390. FSource.Insert(0,'unit afile;');
  391. if Not UseImplementation then
  392. StartImplementation;
  393. EndSource;
  394. ParseModule;
  395. if UseImplementation then
  396. FDeclarations:=Module.ImplementationSection
  397. else
  398. FDeclarations:=Module.InterfaceSection;
  399. end;
  400. procedure TTestParser.ParseModule;
  401. begin
  402. StartParsing;
  403. FParser.ParseMain(FModule);
  404. AssertNotNull('Module resulted in Module',FModule);
  405. AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
  406. end;
  407. procedure TTestParser.CheckHint(AHint: TPasMemberHint);
  408. begin
  409. HaveHint(AHint,Definition.Hints);
  410. end;
  411. function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
  412. aKind: TPasExprKind; AClass: TClass): TPasExpr;
  413. begin
  414. AssertNotNull(AExpr);
  415. AssertEquals(Msg+': Correct expression kind',aKind,AExpr.Kind);
  416. AssertEquals(Msg+': Correct expression class',AClass,AExpr.ClassType);
  417. Result:=AExpr;
  418. end;
  419. function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
  420. aKind: TPasExprKind; AValue: String): TPrimitiveExpr;
  421. begin
  422. Result:=AssertExpression(Msg,AExpr,aKind,TPrimitiveExpr) as TPrimitiveExpr;
  423. AssertEquals(Msg+': Primitive expression value',AValue,TPrimitiveExpr(AExpr).Value);
  424. end;
  425. function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
  426. OpCode: TExprOpCode): TBinaryExpr;
  427. begin
  428. Result:=AssertExpression(Msg,AExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
  429. AssertEquals(Msg+': Binary opcode',OpCode,TBinaryExpr(AExpr).OpCode);
  430. end;
  431. procedure TTestParser.AssertExportSymbol(const Msg: String; AIndex: Integer;
  432. AName, AExportName: String; AExportIndex: Integer);
  433. Var
  434. E: TPasExportSymbol;
  435. begin
  436. AssertNotNull(Msg+'Have export symbols list',PasLibrary.LibrarySection.ExportSymbols);
  437. if AIndex>=PasLibrary.LibrarySection.ExportSymbols.Count then
  438. Fail(Format(Msg+'%d not a valid export list symbol',[AIndex]));
  439. AssertNotNull(Msg+'Have export symbol',PasLibrary.LibrarySection.ExportSymbols[Aindex]);
  440. AssertEquals(Msg+'Correct export symbol class',TPasExportSymbol,TObject(PasLibrary.LibrarySection.ExportSymbols[Aindex]).ClassType);
  441. E:=TPasExportSymbol(PasLibrary.LibrarySection.ExportSymbols[Aindex]);
  442. AssertEquals(Msg+'Correct export symbol name',AName,E.Name);
  443. if (AExportName='') then
  444. AssertNull(Msg+'No export name',E.ExportName)
  445. else
  446. begin
  447. AssertNotNull(Msg+'Export name symbol',E.ExportName);
  448. AssertEquals(Msg+'TPrimitiveExpr',TPrimitiveExpr,E.ExportName.CLassType);
  449. AssertEquals(Msg+'Correct export symbol export name ',''''+AExportName+'''',TPrimitiveExpr(E.ExportName).Value);
  450. end;
  451. If AExportIndex=-1 then
  452. AssertNull(Msg+'No export name',E.ExportIndex)
  453. else
  454. begin
  455. AssertNotNull(Msg+'Export name symbol',E.ExportIndex);
  456. AssertEquals(Msg+'TPrimitiveExpr',TPrimitiveExpr,E.ExportIndex.CLassType);
  457. AssertEquals(Msg+'Correct export symbol export index',IntToStr(AExportindex),TPrimitiveExpr(E.ExportIndex).Value);
  458. end;
  459. end;
  460. procedure TTestParser.AssertErrorCount(const aMsg: String; const aExpected: Integer);
  461. begin
  462. AssertEquals(aMsg,aExpected,ErrorCount);
  463. end;
  464. procedure TTestParser.AssertErrorCount(const aExpected: Integer);
  465. begin
  466. AssertEquals('Error count after parse',aExpected,ErrorCount);
  467. end;
  468. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  469. AActual: TPasExprKind);
  470. begin
  471. AssertEquals(Msg,GetEnumName(TypeInfo(TPasExprKind),Ord(AExpected)),
  472. GetEnumName(TypeInfo(TPasExprKind),Ord(AActual)));
  473. end;
  474. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  475. AActual: TLoopType);
  476. begin
  477. AssertEquals(Msg,GetEnumName(TypeInfo(TLoopType),Ord(AExpected)),
  478. GetEnumName(TypeInfo(TLoopType),Ord(AActual)));
  479. end;
  480. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  481. AActual: TPasObjKind);
  482. begin
  483. AssertEquals(Msg,GetEnumName(TypeInfo(TPasObjKind),Ord(AExpected)),
  484. GetEnumName(TypeInfo(TPasObjKind),Ord(AActual)));
  485. end;
  486. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  487. AActual: TExprOpCode);
  488. begin
  489. AssertEquals(Msg,GetEnumName(TypeInfo(TexprOpcode),Ord(AExpected)),
  490. GetEnumName(TypeInfo(TexprOpcode),Ord(AActual)));
  491. end;
  492. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  493. AActual: TPasMemberHint);
  494. begin
  495. AssertEquals(Msg,GetEnumName(TypeInfo(TPasMemberHint),Ord(AExpected)),
  496. GetEnumName(TypeInfo(TPasMemberHint),Ord(AActual)));
  497. end;
  498. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  499. AActual: TCallingConvention);
  500. begin
  501. AssertEquals(Msg,GetEnumName(TypeInfo(TCallingConvention),Ord(AExpected)),
  502. GetEnumName(TypeInfo(TCallingConvention),Ord(AActual)));
  503. end;
  504. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  505. AActual: TArgumentAccess);
  506. begin
  507. AssertEquals(Msg,GetEnumName(TypeInfo(TArgumentAccess),Ord(AExpected)),
  508. GetEnumName(TypeInfo(TArgumentAccess),Ord(AActual)));
  509. end;
  510. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  511. AActual: TVariableModifier);
  512. begin
  513. AssertEquals(Msg,GetEnumName(TypeInfo(TVariableModifier),Ord(AExpected)),
  514. GetEnumName(TypeInfo(TVariableModifier),Ord(AActual)));
  515. end;
  516. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  517. AActual: TVariableModifiers);
  518. Function sn (S : TVariableModifiers) : string;
  519. Var
  520. M : TVariableModifier;
  521. begin
  522. Result:='';
  523. For M:=Low(TVariableModifier) to High(TVariableModifier) do
  524. if M in S then
  525. begin
  526. if (Result<>'') then
  527. Result:=Result+',';
  528. end;
  529. Result:='['+Result+']';
  530. end;
  531. begin
  532. AssertEquals(Msg,Sn(AExpected),Sn(AActual));
  533. end;
  534. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  535. AActual: TPasMemberVisibility);
  536. begin
  537. AssertEquals(Msg,GetEnumName(TypeInfo(TPasMemberVisibility),Ord(AExpected)),
  538. GetEnumName(TypeInfo(TPasMemberVisibility),Ord(AActual)));
  539. end;
  540. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  541. AActual: TProcedureModifier);
  542. begin
  543. AssertEquals(Msg,GetEnumName(TypeInfo(TProcedureModifier),Ord(AExpected)),
  544. GetEnumName(TypeInfo(TProcedureModifier),Ord(AActual)));
  545. end;
  546. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  547. AActual: TProcedureModifiers);
  548. Function Sn (S : TProcedureModifiers) : String;
  549. Var
  550. m : TProcedureModifier;
  551. begin
  552. Result:='';
  553. For M:=Low(TProcedureModifier) to High(TProcedureModifier) do
  554. If (m in S) then
  555. begin
  556. If (Result<>'') then
  557. Result:=Result+',';
  558. Result:=Result+GetEnumName(TypeInfo(TProcedureModifier),Ord(m))
  559. end;
  560. end;
  561. begin
  562. AssertEquals(Msg,Sn(AExpected),SN(AActual));
  563. end;
  564. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  565. AActual: TProcTypeModifiers);
  566. Function Sn (S : TProcTypeModifiers) : String;
  567. Var
  568. m : TProcTypeModifier;
  569. begin
  570. Result:='';
  571. For M:=Low(TProcTypeModifier) to High(TProcTypeModifier) do
  572. If (m in S) then
  573. begin
  574. If (Result<>'') then
  575. Result:=Result+',';
  576. Result:=Result+GetEnumName(TypeInfo(TProcTypeModifier),Ord(m))
  577. end;
  578. end;
  579. begin
  580. AssertEquals(Msg,Sn(AExpected),SN(AActual));
  581. end;
  582. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  583. AActual: TAssignKind);
  584. begin
  585. AssertEquals(Msg,GetEnumName(TypeInfo(TAssignKind),Ord(AExpected)),
  586. GetEnumName(TypeInfo(TAssignKind),Ord(AActual)));
  587. end;
  588. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  589. AActual: TProcedureMessageType);
  590. begin
  591. AssertEquals(Msg,GetEnumName(TypeInfo(TProcedureMessageType),Ord(AExpected)),
  592. GetEnumName(TypeInfo(TProcedureMessageType),Ord(AActual)));
  593. end;
  594. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  595. AActual: TOperatorType);
  596. begin
  597. AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
  598. GetEnumName(TypeInfo(TOperatorType),Ord(AActual)));
  599. end;
  600. procedure TTestParser.AssertSame(const Msg: String; AExpected,
  601. AActual: TPasElement);
  602. begin
  603. if AExpected=AActual then exit;
  604. AssertEquals(Msg,GetPasElementDesc(AExpected),GetPasElementDesc(AActual));
  605. end;
  606. procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
  607. begin
  608. If not (AHint in AHints) then
  609. Fail(GetEnumName(TypeInfo(TPasMemberHint),Ord(AHint))+'hint expected.');
  610. end;
  611. end.