tcbaseparser.pas 21 KB

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