tcbaseparser.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694
  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. if Allow then ;
  183. end;
  184. procedure TTestParser.SetupParser;
  185. begin
  186. FResolver:=TStreamResolver.Create;
  187. FResolver.OwnsStreams:=True;
  188. FScanner:=TPascalScanner.Create(FResolver);
  189. FScanner.CurrentBoolSwitches:=FScanner.CurrentBoolSwitches+[bsHints,bsNotes,bsWarnings];
  190. CreateEngine(FEngine);
  191. FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
  192. FSource:=TStringList.Create;
  193. FModule:=Nil;
  194. FDeclarations:=Nil;
  195. FEndSource:=False;
  196. FImplementation:=False;
  197. FIsUnit:=False;
  198. FMessageCount:=0;
  199. FLastMessage:='';
  200. FLastErrorNumber:=0;
  201. FErrorCount:=0;
  202. FParser.OnLog:=@DoParserLog;
  203. FParser.OnError:=@DoParserError;
  204. end;
  205. procedure TTestParser.CleanupParser;
  206. begin
  207. {$IFDEF VerbosePasResolverMem}
  208. writeln('TTestParser.CleanupParser START');
  209. {$ENDIF}
  210. if Not Assigned(FModule) then
  211. FreeAndNil(FDeclarations)
  212. else
  213. FDeclarations:=Nil;
  214. FImplementation:=False;
  215. FEndSource:=False;
  216. FIsUnit:=False;
  217. {$IFDEF VerbosePasResolverMem}
  218. writeln('TTestParser.CleanupParser FModule');
  219. {$ENDIF}
  220. FModule:=nil;
  221. {$IFDEF VerbosePasResolverMem}
  222. writeln('TTestParser.CleanupParser FSource');
  223. {$ENDIF}
  224. FreeAndNil(FSource);
  225. {$IFDEF VerbosePasResolverMem}
  226. writeln('TTestParser.CleanupParser FParseResult');
  227. {$ENDIF}
  228. FreeAndNil(FParseResult);
  229. {$IFDEF VerbosePasResolverMem}
  230. writeln('TTestParser.CleanupParser FParser');
  231. {$ENDIF}
  232. FreeAndNil(FParser);
  233. {$IFDEF VerbosePasResolverMem}
  234. writeln('TTestParser.CleanupParser FEngine');
  235. {$ENDIF}
  236. FreeAndNil(FEngine);
  237. {$IFDEF VerbosePasResolverMem}
  238. writeln('TTestParser.CleanupParser FScanner');
  239. {$ENDIF}
  240. FreeAndNil(FScanner);
  241. {$IFDEF VerbosePasResolverMem}
  242. writeln('TTestParser.CleanupParser FResolver');
  243. {$ENDIF}
  244. FreeAndNil(FResolver);
  245. {$IFDEF VerbosePasResolverMem}
  246. writeln('TTestParser.CleanupParser END');
  247. {$ENDIF}
  248. end;
  249. procedure TTestParser.ResetParser;
  250. begin
  251. CleanupParser;
  252. SetupParser;
  253. end;
  254. procedure TTestParser.SetUp;
  255. begin
  256. FMainFilename:=DefaultMainFilename;
  257. Inherited;
  258. SetupParser;
  259. end;
  260. procedure TTestParser.TearDown;
  261. begin
  262. {$IFDEF VerbosePasResolverMem}
  263. writeln('TTestParser.TearDown START CleanupParser');
  264. {$ENDIF}
  265. CleanupParser;
  266. {$IFDEF VerbosePasResolverMem}
  267. writeln('TTestParser.TearDown inherited');
  268. {$ENDIF}
  269. Inherited;
  270. {$IFDEF VerbosePasResolverMem}
  271. writeln('TTestParser.TearDown END');
  272. {$ENDIF}
  273. end;
  274. procedure TTestParser.CreateEngine(var TheEngine: TPasTreeContainer);
  275. begin
  276. TheEngine:=TTestEngine.Create;
  277. end;
  278. procedure TTestParser.StartUnit(AUnitName: String);
  279. begin
  280. FIsUnit:=True;
  281. If (AUnitName='') then
  282. AUnitName:=ExtractFileUnitName(MainFilename);
  283. Add('unit '+aUnitName+';');
  284. Add('');
  285. Add('interface');
  286. Add('');
  287. FFileName:=AUnitName+'.pp';
  288. end;
  289. procedure TTestParser.StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
  290. begin
  291. FIsUnit:=False;
  292. If (AFileName='') then
  293. AFileName:='proga';
  294. FFileName:=AFileName+'.pp';
  295. If (AIn<>'') then
  296. begin
  297. AFileName:=AFileName+'('+AIn;
  298. if (AOut<>'') then
  299. AFileName:=AFileName+','+AOut;
  300. AFileName:=AFileName+')';
  301. end;
  302. Add('program '+AFileName+';');
  303. FImplementation:=True;
  304. end;
  305. procedure TTestParser.StartLibrary(AFileName: String);
  306. begin
  307. FIsUnit:=False;
  308. If (AFileName='') then
  309. AFileName:='liba';
  310. FFileName:=AFileName+'.pp';
  311. Add('library '+AFileName+';');
  312. FImplementation:=True;
  313. end;
  314. procedure TTestParser.UsesClause(Units: array of string);
  315. Var
  316. S : String;
  317. I : integer;
  318. begin
  319. S:='';
  320. For I:=Low(units) to High(units) do
  321. begin
  322. If (S<>'') then
  323. S:=S+', ';
  324. S:=S+Units[i];
  325. end;
  326. Add('uses '+S+';');
  327. Add('');
  328. end;
  329. procedure TTestParser.StartImplementation;
  330. begin
  331. if Not FImplementation then
  332. begin
  333. if UseImplementation then
  334. begin
  335. FSource.Insert(0,'');
  336. FSource.Insert(0,'Implementation');
  337. FSource.Insert(0,'');
  338. end
  339. else
  340. begin
  341. Add('');
  342. Add('Implementation');
  343. Add('');
  344. end;
  345. FImplementation:=True;
  346. end;
  347. end;
  348. procedure TTestParser.EndSource;
  349. begin
  350. if Not FEndSource then
  351. begin
  352. Add('end.');
  353. FEndSource:=True;
  354. end;
  355. end;
  356. procedure TTestParser.Add(const ALine: String);
  357. begin
  358. FSource.Add(ALine);
  359. end;
  360. procedure TTestParser.Add(const Lines: array of String);
  361. var
  362. i: Integer;
  363. begin
  364. for i:=Low(Lines) to High(Lines) do
  365. Add(Lines[i]);
  366. end;
  367. procedure TTestParser.StartParsing;
  368. var
  369. i: Integer;
  370. begin
  371. If FIsUnit then
  372. StartImplementation;
  373. EndSource;
  374. If (FFileName='') then
  375. FFileName:=MainFilename;
  376. FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
  377. FScanner.OpenFile(FFileName);
  378. { $ifndef NOCONSOLE} // JC: To get the tests to run with GUI
  379. Writeln('// Test : ',Self.TestName);
  380. for i:=0 to FSource.Count-1 do
  381. Writeln(Format('%:4d: ',[i+1]),FSource[i]);
  382. { $EndIf}
  383. end;
  384. procedure TTestParser.ParseDeclarations;
  385. begin
  386. if UseImplementation then
  387. StartImplementation;
  388. FSource.Insert(0,'');
  389. FSource.Insert(0,'interface');
  390. FSource.Insert(0,'');
  391. FSource.Insert(0,'unit afile;');
  392. if Not UseImplementation then
  393. StartImplementation;
  394. EndSource;
  395. ParseModule;
  396. if UseImplementation then
  397. FDeclarations:=Module.ImplementationSection
  398. else
  399. FDeclarations:=Module.InterfaceSection;
  400. end;
  401. procedure TTestParser.ParseModule;
  402. begin
  403. StartParsing;
  404. FParser.ParseMain(FModule);
  405. AssertNotNull('Module resulted in Module',FModule);
  406. AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
  407. end;
  408. procedure TTestParser.CheckHint(AHint: TPasMemberHint);
  409. begin
  410. HaveHint(AHint,Definition.Hints);
  411. end;
  412. function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
  413. aKind: TPasExprKind; AClass: TClass): TPasExpr;
  414. begin
  415. AssertNotNull(AExpr);
  416. AssertEquals(Msg+': Correct expression kind',aKind,AExpr.Kind);
  417. AssertEquals(Msg+': Correct expression class',AClass,AExpr.ClassType);
  418. Result:=AExpr;
  419. end;
  420. function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
  421. aKind: TPasExprKind; AValue: String): TPrimitiveExpr;
  422. begin
  423. Result:=AssertExpression(Msg,AExpr,aKind,TPrimitiveExpr) as TPrimitiveExpr;
  424. AssertEquals(Msg+': Primitive expression value',AValue,TPrimitiveExpr(AExpr).Value);
  425. end;
  426. function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
  427. OpCode: TExprOpCode): TBinaryExpr;
  428. begin
  429. Result:=AssertExpression(Msg,AExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
  430. AssertEquals(Msg+': Binary opcode',OpCode,TBinaryExpr(AExpr).OpCode);
  431. end;
  432. procedure TTestParser.AssertExportSymbol(const Msg: String; AIndex: Integer;
  433. AName, AExportName: String; AExportIndex: Integer);
  434. Var
  435. E: TPasExportSymbol;
  436. begin
  437. AssertNotNull(Msg+'Have export symbols list',PasLibrary.LibrarySection.ExportSymbols);
  438. if AIndex>=PasLibrary.LibrarySection.ExportSymbols.Count then
  439. Fail(Format(Msg+'%d not a valid export list symbol',[AIndex]));
  440. AssertNotNull(Msg+'Have export symbol',PasLibrary.LibrarySection.ExportSymbols[Aindex]);
  441. AssertEquals(Msg+'Correct export symbol class',TPasExportSymbol,TObject(PasLibrary.LibrarySection.ExportSymbols[Aindex]).ClassType);
  442. E:=TPasExportSymbol(PasLibrary.LibrarySection.ExportSymbols[Aindex]);
  443. AssertEquals(Msg+'Correct export symbol name',AName,E.Name);
  444. if (AExportName='') then
  445. AssertNull(Msg+'No export name',E.ExportName)
  446. else
  447. begin
  448. AssertNotNull(Msg+'Export name symbol',E.ExportName);
  449. AssertEquals(Msg+'TPrimitiveExpr',TPrimitiveExpr,E.ExportName.CLassType);
  450. AssertEquals(Msg+'Correct export symbol export name ',''''+AExportName+'''',TPrimitiveExpr(E.ExportName).Value);
  451. end;
  452. If AExportIndex=-1 then
  453. AssertNull(Msg+'No export name',E.ExportIndex)
  454. else
  455. begin
  456. AssertNotNull(Msg+'Export name symbol',E.ExportIndex);
  457. AssertEquals(Msg+'TPrimitiveExpr',TPrimitiveExpr,E.ExportIndex.CLassType);
  458. AssertEquals(Msg+'Correct export symbol export index',IntToStr(AExportindex),TPrimitiveExpr(E.ExportIndex).Value);
  459. end;
  460. end;
  461. procedure TTestParser.AssertErrorCount(const aMsg: String; const aExpected: Integer);
  462. begin
  463. AssertEquals(aMsg,aExpected,ErrorCount);
  464. end;
  465. procedure TTestParser.AssertErrorCount(const aExpected: Integer);
  466. begin
  467. AssertEquals('Error count after parse',aExpected,ErrorCount);
  468. end;
  469. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  470. AActual: TPasExprKind);
  471. begin
  472. AssertEquals(Msg,GetEnumName(TypeInfo(TPasExprKind),Ord(AExpected)),
  473. GetEnumName(TypeInfo(TPasExprKind),Ord(AActual)));
  474. end;
  475. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  476. AActual: TLoopType);
  477. begin
  478. AssertEquals(Msg,GetEnumName(TypeInfo(TLoopType),Ord(AExpected)),
  479. GetEnumName(TypeInfo(TLoopType),Ord(AActual)));
  480. end;
  481. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  482. AActual: TPasObjKind);
  483. begin
  484. AssertEquals(Msg,GetEnumName(TypeInfo(TPasObjKind),Ord(AExpected)),
  485. GetEnumName(TypeInfo(TPasObjKind),Ord(AActual)));
  486. end;
  487. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  488. AActual: TExprOpCode);
  489. begin
  490. AssertEquals(Msg,GetEnumName(TypeInfo(TexprOpcode),Ord(AExpected)),
  491. GetEnumName(TypeInfo(TexprOpcode),Ord(AActual)));
  492. end;
  493. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  494. AActual: TPasMemberHint);
  495. begin
  496. AssertEquals(Msg,GetEnumName(TypeInfo(TPasMemberHint),Ord(AExpected)),
  497. GetEnumName(TypeInfo(TPasMemberHint),Ord(AActual)));
  498. end;
  499. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  500. AActual: TCallingConvention);
  501. begin
  502. AssertEquals(Msg,GetEnumName(TypeInfo(TCallingConvention),Ord(AExpected)),
  503. GetEnumName(TypeInfo(TCallingConvention),Ord(AActual)));
  504. end;
  505. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  506. AActual: TArgumentAccess);
  507. begin
  508. AssertEquals(Msg,GetEnumName(TypeInfo(TArgumentAccess),Ord(AExpected)),
  509. GetEnumName(TypeInfo(TArgumentAccess),Ord(AActual)));
  510. end;
  511. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  512. AActual: TVariableModifier);
  513. begin
  514. AssertEquals(Msg,GetEnumName(TypeInfo(TVariableModifier),Ord(AExpected)),
  515. GetEnumName(TypeInfo(TVariableModifier),Ord(AActual)));
  516. end;
  517. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  518. AActual: TVariableModifiers);
  519. Function sn (S : TVariableModifiers) : string;
  520. Var
  521. M : TVariableModifier;
  522. begin
  523. Result:='';
  524. For M:=Low(TVariableModifier) to High(TVariableModifier) do
  525. if M in S then
  526. begin
  527. if (Result<>'') then
  528. Result:=Result+',';
  529. end;
  530. Result:='['+Result+']';
  531. end;
  532. begin
  533. AssertEquals(Msg,Sn(AExpected),Sn(AActual));
  534. end;
  535. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  536. AActual: TPasMemberVisibility);
  537. begin
  538. AssertEquals(Msg,GetEnumName(TypeInfo(TPasMemberVisibility),Ord(AExpected)),
  539. GetEnumName(TypeInfo(TPasMemberVisibility),Ord(AActual)));
  540. end;
  541. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  542. AActual: TProcedureModifier);
  543. begin
  544. AssertEquals(Msg,GetEnumName(TypeInfo(TProcedureModifier),Ord(AExpected)),
  545. GetEnumName(TypeInfo(TProcedureModifier),Ord(AActual)));
  546. end;
  547. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  548. AActual: TProcedureModifiers);
  549. Function Sn (S : TProcedureModifiers) : String;
  550. Var
  551. m : TProcedureModifier;
  552. begin
  553. Result:='';
  554. For M:=Low(TProcedureModifier) to High(TProcedureModifier) do
  555. If (m in S) then
  556. begin
  557. If (Result<>'') then
  558. Result:=Result+',';
  559. Result:=Result+GetEnumName(TypeInfo(TProcedureModifier),Ord(m))
  560. end;
  561. end;
  562. begin
  563. AssertEquals(Msg,Sn(AExpected),SN(AActual));
  564. end;
  565. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  566. AActual: TProcTypeModifiers);
  567. Function Sn (S : TProcTypeModifiers) : String;
  568. Var
  569. m : TProcTypeModifier;
  570. begin
  571. Result:='';
  572. For M:=Low(TProcTypeModifier) to High(TProcTypeModifier) do
  573. If (m in S) then
  574. begin
  575. If (Result<>'') then
  576. Result:=Result+',';
  577. Result:=Result+GetEnumName(TypeInfo(TProcTypeModifier),Ord(m))
  578. end;
  579. end;
  580. begin
  581. AssertEquals(Msg,Sn(AExpected),SN(AActual));
  582. end;
  583. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  584. AActual: TAssignKind);
  585. begin
  586. AssertEquals(Msg,GetEnumName(TypeInfo(TAssignKind),Ord(AExpected)),
  587. GetEnumName(TypeInfo(TAssignKind),Ord(AActual)));
  588. end;
  589. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  590. AActual: TProcedureMessageType);
  591. begin
  592. AssertEquals(Msg,GetEnumName(TypeInfo(TProcedureMessageType),Ord(AExpected)),
  593. GetEnumName(TypeInfo(TProcedureMessageType),Ord(AActual)));
  594. end;
  595. procedure TTestParser.AssertEquals(const Msg: String; AExpected,
  596. AActual: TOperatorType);
  597. begin
  598. AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
  599. GetEnumName(TypeInfo(TOperatorType),Ord(AActual)));
  600. end;
  601. procedure TTestParser.AssertSame(const Msg: String; AExpected,
  602. AActual: TPasElement);
  603. begin
  604. if AExpected=AActual then exit;
  605. AssertEquals(Msg,GetPasElementDesc(AExpected),GetPasElementDesc(AActual));
  606. end;
  607. procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
  608. begin
  609. If not (AHint in AHints) then
  610. Fail(GetEnumName(TypeInfo(TPasMemberHint),Ord(AHint))+'hint expected.');
  611. end;
  612. end.