tcunitsearch.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2018 by Michael Van Canneyt
  4. Unit tests for Pascal-to-Javascript converter class.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. Examples:
  12. ./testpas2js --suite=TestCLI_UnitSearch.
  13. ./testpas2js --suite=TestUS_Program
  14. ./testpas2js --suite=TestUS_UsesEmptyFileFail
  15. }
  16. unit tcunitsearch;
  17. {$mode objfpc}{$H+}
  18. interface
  19. uses
  20. Classes, SysUtils, contnrs,
  21. fpcunit, testregistry,
  22. PScanner, PasTree,
  23. {$IFDEF CheckPasTreeRefCount}PasResolveEval,{$ENDIF}
  24. Pas2jsFileUtils, Pas2jsCompiler, Pas2jsfsCompiler, Pas2jsFileCache, Pas2jsLogger,
  25. tcmodules;
  26. type
  27. { TTestCompiler }
  28. TTestCompiler = class(TPas2jsFSCompiler)
  29. private
  30. FExitCode: longint;
  31. protected
  32. function GetExitCode: Longint; override;
  33. procedure SetExitCode(Value: Longint); override;
  34. end;
  35. { TCLIFile }
  36. TCLIFile = class
  37. public
  38. Filename: string;
  39. Source: string;
  40. Age: TPas2jsFileAgeTime;
  41. Attr: TPas2jsFileAttr;
  42. constructor Create(const aFilename, Src: string; aAge: TPas2jsFileAgeTime;
  43. aAttr: TPas2jsFileAttr);
  44. end;
  45. { TCLILogMsg }
  46. TCLILogMsg = class
  47. public
  48. Msg: string;
  49. MsgTxt: string;
  50. MsgType: TMessageType;
  51. MsgNumber: integer;
  52. MsgFile: string;
  53. MsgLine: integer;
  54. MsgCol: integer;
  55. end;
  56. { TCustomTestCLI }
  57. TCustomTestCLI = class(TTestCase)
  58. private
  59. FCurDate: TDateTime;
  60. FErrorCol: integer;
  61. FErrorFile: string;
  62. FErrorLine: integer;
  63. FErrorMsg: string;
  64. FErrorNumber: integer;
  65. FWorkDir: string;
  66. FCompilerExe: string;
  67. FCompiler: TTestCompiler;
  68. FDefaultFileAge: longint;
  69. FFiles: TObjectList; // list of TCLIFile
  70. FLogMsgs: TObjectList; // list ot TCLILogMsg
  71. FParams: TStringList;
  72. {$IFDEF EnablePasTreeGlobalRefCount}
  73. FElementRefCountAtSetup: int64;
  74. {$ENDIF}
  75. function GetExitCode: integer;
  76. function GetFiles(Index: integer): TCLIFile;
  77. function GetLogMsgs(Index: integer): TCLILogMsg;
  78. procedure SetExitCode(const AValue: integer);
  79. procedure SetWorkDir(const AValue: string);
  80. protected
  81. procedure SetUp; override;
  82. procedure TearDown; override;
  83. procedure DoLog(Sender: TObject; const Msg: String);
  84. Function OnReadDirectory(Dir: TPas2jsCachedDirectory): boolean; virtual;
  85. Function OnReadFile(aFilename: string; var aSource: string): boolean; virtual;
  86. procedure OnWriteFile(aFilename: string; Source: string); virtual;
  87. procedure WriteSources;
  88. public
  89. constructor Create; override;
  90. destructor Destroy; override;
  91. procedure Compile(const Args: array of string; ExpectedExitCode: longint = 0);
  92. property Compiler: TTestCompiler read FCompiler;
  93. property CompilerExe: string read FCompilerExe write FCompilerExe;
  94. property Params: TStringList read FParams;
  95. property Files[Index: integer]: TCLIFile read GetFiles; // files an directories
  96. function FileCount: integer;
  97. function FindFile(Filename: string): TCLIFile; // files and directories
  98. function ExpandFilename(const Filename: string): string;
  99. function AddFile(Filename, Source: string): TCLIFile;
  100. function AddFile(Filename: string; const SourceLines: array of string): TCLIFile;
  101. function AddUnit(Filename: string; const Intf, Impl: array of string): TCLIFile;
  102. function AddDir(Filename: string): TCLIFile;
  103. procedure AssertFileExists(Filename: string);
  104. property WorkDir: string read FWorkDir write SetWorkDir;
  105. property DefaultFileAge: longint read FDefaultFileAge write FDefaultFileAge;
  106. property ExitCode: integer read GetExitCode write SetExitCode;
  107. property LogMsgs[Index: integer]: TCLILogMsg read GetLogMsgs;
  108. function GetLogCount: integer;
  109. property ErrorMsg: string read FErrorMsg write FErrorMsg;
  110. property ErrorFile: string read FErrorFile write FErrorFile;
  111. property ErrorLine: integer read FErrorLine write FErrorLine;
  112. property ErrorCol: integer read FErrorCol write FErrorCol;
  113. property ErrorNumber: integer read FErrorNumber write FErrorNumber;
  114. property CurDate: TDateTime read FCurDate write FCurDate;
  115. end;
  116. { TTestCLI_UnitSearch }
  117. TTestCLI_UnitSearch = class(TCustomTestCLI)
  118. published
  119. procedure TestUS_Program;
  120. procedure TestUS_UsesEmptyFileFail;
  121. procedure TestUS_Program_o;
  122. procedure TestUS_Program_FU;
  123. procedure TestUS_Program_FU_o;
  124. procedure TestUS_Program_FE_o;
  125. procedure TestUS_UsesInFile;
  126. procedure TestUS_UsesInFile_Duplicate;
  127. procedure TestUS_UsesInFile_IndirectDuplicate;
  128. end;
  129. function LinesToStr(const Lines: array of string): string;
  130. implementation
  131. function LinesToStr(const Lines: array of string): string;
  132. var
  133. i: Integer;
  134. begin
  135. Result:='';
  136. for i:=low(Lines) to high(Lines) do
  137. Result:=Result+Lines[i]+LineEnding;
  138. end;
  139. { TCLIFile }
  140. constructor TCLIFile.Create(const aFilename, Src: string;
  141. aAge: TPas2jsFileAgeTime; aAttr: TPas2jsFileAttr);
  142. begin
  143. Filename:=aFilename;
  144. Source:=Src;
  145. Age:=aAge;
  146. Attr:=aAttr;
  147. end;
  148. { TTestCompiler }
  149. function TTestCompiler.GetExitCode: Longint;
  150. begin
  151. Result:=FExitCode;
  152. end;
  153. procedure TTestCompiler.SetExitCode(Value: Longint);
  154. begin
  155. FExitCode:=Value;
  156. end;
  157. { TCustomTestCLI }
  158. function TCustomTestCLI.GetFiles(Index: integer): TCLIFile;
  159. begin
  160. Result:=TCLIFile(FFiles[Index]);
  161. end;
  162. function TCustomTestCLI.GetExitCode: integer;
  163. begin
  164. Result:=Compiler.ExitCode;
  165. end;
  166. function TCustomTestCLI.GetLogMsgs(Index: integer): TCLILogMsg;
  167. begin
  168. Result:=TCLILogMsg(FLogMsgs[Index]);
  169. end;
  170. procedure TCustomTestCLI.SetExitCode(const AValue: integer);
  171. begin
  172. Compiler.ExitCode:=AValue;
  173. end;
  174. procedure TCustomTestCLI.SetWorkDir(const AValue: string);
  175. var
  176. NewValue: String;
  177. begin
  178. NewValue:=IncludeTrailingPathDelimiter(ResolveDots(AValue));
  179. if FWorkDir=NewValue then Exit;
  180. FWorkDir:=NewValue;
  181. end;
  182. procedure TCustomTestCLI.SetUp;
  183. begin
  184. {$IFDEF EnablePasTreeGlobalRefCount}
  185. FElementRefCountAtSetup:=TPasElement.GlobalRefCount;
  186. {$ENDIF}
  187. inherited SetUp;
  188. FDefaultFileAge:=DateTimeToFileDate(Now);
  189. WorkDir:=ExtractFilePath(ParamStr(0));
  190. {$IFDEF Windows}
  191. CompilerExe:='P:\bin\pas2js.exe';
  192. {$ELSE}
  193. CompilerExe:='/usr/bin/pas2js';
  194. {$ENDIF}
  195. FCompiler:=TTestCompiler.Create;
  196. Compiler.Log.OnLog:=@DoLog;
  197. Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
  198. Compiler.FileCache.OnReadFile:=@OnReadFile;
  199. Compiler.FileCache.OnWriteFile:=@OnWriteFile;
  200. end;
  201. procedure TCustomTestCLI.TearDown;
  202. {$IFDEF CheckPasTreeRefCount}
  203. var
  204. El: TPasElement;
  205. i: integer;
  206. {$ENDIF}
  207. begin
  208. FreeAndNil(FCompiler);
  209. FParams.Clear;
  210. FFiles.Clear;
  211. FLogMsgs.Clear;
  212. FErrorMsg:='';
  213. FErrorFile:='';
  214. FErrorLine:=0;
  215. FErrorCol:=0;
  216. FErrorNumber:=0;
  217. inherited TearDown;
  218. {$IFDEF EnablePasTreeGlobalRefCount}
  219. if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
  220. begin
  221. writeln('TCustomTestCLI.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  222. {$IFDEF CheckPasTreeRefCount}
  223. El:=TPasElement.FirstRefEl;
  224. while El<>nil do
  225. begin
  226. writeln(' ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
  227. for i:=0 to El.RefIds.Count-1 do
  228. writeln(' ',El.RefIds[i]);
  229. El:=El.NextRefEl;
  230. end;
  231. {$ENDIF}
  232. Halt;
  233. Fail('TCustomTestCLI.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  234. end;
  235. {$ENDIF}
  236. end;
  237. procedure TCustomTestCLI.DoLog(Sender: TObject; const Msg: String);
  238. var
  239. LogMsg: TCLILogMsg;
  240. begin
  241. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  242. writeln('TCustomTestCLI.DoLog ',Msg,' File=',Compiler.Log.LastMsgFile,' Line=',Compiler.Log.LastMsgLine);
  243. {$ENDIF}
  244. LogMsg:=TCLILogMsg.Create;
  245. LogMsg.Msg:=Msg;
  246. LogMsg.MsgTxt:=Compiler.Log.LastMsgTxt;
  247. LogMsg.MsgType:=Compiler.Log.LastMsgType;
  248. LogMsg.MsgFile:=Compiler.Log.LastMsgFile;
  249. LogMsg.MsgLine:=Compiler.Log.LastMsgLine;
  250. LogMsg.MsgCol:=Compiler.Log.LastMsgCol;
  251. LogMsg.MsgNumber:=Compiler.Log.LastMsgNumber;
  252. FLogMsgs.Add(LogMsg);
  253. if (LogMsg.MsgType<=mtError) then
  254. begin
  255. if (ErrorFile='')
  256. or ((ErrorLine<1) and (LogMsg.MsgLine>0)) then
  257. begin
  258. ErrorMsg:=LogMsg.MsgTxt;
  259. ErrorFile:=LogMsg.MsgFile;
  260. ErrorLine:=LogMsg.MsgLine;
  261. ErrorCol:=LogMsg.MsgCol;
  262. end;
  263. end;
  264. end;
  265. function TCustomTestCLI.OnReadDirectory(Dir: TPas2jsCachedDirectory): boolean;
  266. var
  267. i: Integer;
  268. aFile: TCLIFile;
  269. Path: String;
  270. begin
  271. Path:=Dir.Path;
  272. //writeln('TCustomTestCLI.ReadDirectory START ',Path,' ',Dir.Count);
  273. Dir.Add('.',DefaultFileAge,faDirectory,4096);
  274. Dir.Add('..',DefaultFileAge,faDirectory,4096);
  275. for i:=0 to FileCount-1 do
  276. begin
  277. aFile:=Files[i];
  278. if CompareFilenames(ExtractFilePath(aFile.Filename),Path)<>0 then continue;
  279. //writeln('TCustomTestCLI.ReadDirectory ',aFile.Filename);
  280. Dir.Add(ExtractFileName(aFile.Filename),aFile.Age,aFile.Attr,length(aFile.Source));
  281. end;
  282. //writeln('TCustomTestCLI.ReadDirectory END ',Path,' ',Dir.Count);
  283. Result:=true;
  284. end;
  285. function TCustomTestCLI.OnReadFile(aFilename: string; var aSource: string
  286. ): boolean;
  287. var
  288. aFile: TCLIFile;
  289. begin
  290. aFile:=FindFile(aFilename);
  291. //writeln('TCustomTestCLI.ReadFile ',aFilename,' Found=',aFile<>nil);
  292. if aFile=nil then exit(false);
  293. if (faDirectory and aFile.Attr)>0 then
  294. begin
  295. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  296. writeln('[20180224000557] TCustomTestCLI.OnReadFile ',aFilename);
  297. {$ENDIF}
  298. EPas2jsFileCache.Create('TCustomTestCLI.OnReadFile: reading directory '+aFilename);
  299. end;
  300. aSource:=aFile.Source;
  301. //writeln('TCustomTestCLI.OnReadFile ',aFile.Filename,' "',LeftStr(aFile.Source,50),'"');
  302. Result:=true;
  303. end;
  304. procedure TCustomTestCLI.OnWriteFile(aFilename: string; Source: string);
  305. var
  306. aFile: TCLIFile;
  307. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  308. //i: Integer;
  309. {$ENDIF}
  310. begin
  311. aFile:=FindFile(aFilename);
  312. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  313. writeln('TCustomTestCLI.WriteFile ',aFilename,' Found=',aFile<>nil,' SrcLen=',length(Source));
  314. {$ENDIF}
  315. if aFile<>nil then
  316. begin
  317. if (faDirectory and aFile.Attr)>0 then
  318. begin
  319. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  320. writeln('[20180223175616] TCustomTestCLI.OnWriteFile ',aFilename);
  321. {$ENDIF}
  322. raise EPas2jsFileCache.Create('unable to write file to directory "'+aFilename+'"');
  323. end;
  324. end else
  325. begin
  326. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  327. //writeln('TCustomTestCLI.OnWriteFile FFiles: ',FFiles.Count);
  328. //for i:=0 to FFiles.Count-1 do
  329. //begin
  330. // aFile:=TCLIFile(FFiles[i]);
  331. // writeln(' ',i,': Filename=',aFile.Filename,' ',CompareFilenames(aFile.Filename,aFilename),' Dir=',(aFile.Attr and faDirectory)>0,' Len=',length(aFile.Source));
  332. //end;
  333. {$ENDIF}
  334. aFile:=TCLIFile.Create(aFilename,'',0,0);
  335. FFiles.Add(aFile);
  336. end;
  337. aFile.Source:=Source;
  338. aFile.Attr:=faNormal;
  339. aFile.Age:=DateTimeToFileDate(CurDate);
  340. writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',LeftStr(aFile.Source,50),'" ');
  341. end;
  342. procedure TCustomTestCLI.WriteSources;
  343. var
  344. i, j, aRow, aCol: Integer;
  345. aFile: TCLIFile;
  346. SrcLines: TStringList;
  347. Line, aFilename: String;
  348. IsSrc: Boolean;
  349. begin
  350. writeln('TCustomTestCLI.WriteSources START');
  351. aFilename:=ErrorFile;
  352. aRow:=ErrorLine;
  353. aCol:=ErrorCol;
  354. SrcLines:=TStringList.Create;
  355. try
  356. for i:=0 to FileCount-1 do
  357. begin
  358. aFile:=Files[i];
  359. if (faDirectory and aFile.Attr)>0 then continue;
  360. writeln('Testcode:-File="',aFile.Filename,'"----------------------------------:');
  361. SrcLines.Text:=aFile.Source;
  362. IsSrc:=ExtractFilename(aFile.Filename)=ExtractFileName(aFilename);
  363. for j:=1 to SrcLines.Count do
  364. begin
  365. Line:=SrcLines[j-1];
  366. if IsSrc and (j=aRow) then
  367. begin
  368. write('*');
  369. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  370. end;
  371. writeln(Format('%:4d: ',[j]),Line);
  372. end;
  373. end;
  374. finally
  375. SrcLines.Free;
  376. end;
  377. end;
  378. constructor TCustomTestCLI.Create;
  379. begin
  380. inherited Create;
  381. FFiles:=TObjectList.Create(true);
  382. FLogMsgs:=TObjectList.Create(true);
  383. FParams:=TStringList.Create;
  384. CurDate:=Now;
  385. end;
  386. destructor TCustomTestCLI.Destroy;
  387. begin
  388. FreeAndNil(FFiles);
  389. FreeAndNil(FLogMsgs);
  390. FreeAndNil(FParams);
  391. inherited Destroy;
  392. end;
  393. procedure TCustomTestCLI.Compile(const Args: array of string;
  394. ExpectedExitCode: longint);
  395. var
  396. i: Integer;
  397. begin
  398. AssertEquals('Initial System.ExitCode',0,system.ExitCode);
  399. for i:=low(Args) to High(Args) do
  400. Params.Add(Args[i]);
  401. try
  402. try
  403. //writeln('TCustomTestCLI.Compile WorkDir=',WorkDir);
  404. Compiler.Run(CompilerExe,WorkDir,Params,false);
  405. except
  406. on E: ECompilerTerminate do
  407. begin
  408. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  409. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  410. {$ENDIF}
  411. end;
  412. on E: Exception do
  413. begin
  414. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  415. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  416. {$ENDIF}
  417. Fail('TCustomTestCLI.Compile '+E.ClassName+':'+E.Message);
  418. end;
  419. end;
  420. finally
  421. Compiler.Log.CloseOutputFile;
  422. end;
  423. if ExpectedExitCode<>ExitCode then
  424. begin
  425. WriteSources;
  426. AssertEquals('ExitCode',ExpectedExitCode,ExitCode);
  427. end;
  428. end;
  429. function TCustomTestCLI.FileCount: integer;
  430. begin
  431. Result:=FFiles.Count;
  432. end;
  433. function TCustomTestCLI.FindFile(Filename: string): TCLIFile;
  434. var
  435. i: Integer;
  436. begin
  437. Filename:=ExpandFilename(Filename);
  438. for i:=0 to FileCount-1 do
  439. if CompareFilenames(Files[i].Filename,Filename)=0 then
  440. exit(Files[i]);
  441. Result:=nil;
  442. end;
  443. function TCustomTestCLI.ExpandFilename(const Filename: string): string;
  444. begin
  445. Result:=SetDirSeparators(Filename);
  446. if not FilenameIsAbsolute(Result) then
  447. Result:=WorkDir+Result;
  448. Result:=ResolveDots(Result);
  449. end;
  450. function TCustomTestCLI.AddFile(Filename, Source: string): TCLIFile;
  451. begin
  452. Filename:=ExpandFilename(Filename);
  453. {$IFDEF VerbosePCUFiler}
  454. writeln('TCustomTestCLI.AddFile ',Filename);
  455. {$ENDIF}
  456. Result:=FindFile(Filename);
  457. if Result<>nil then
  458. raise Exception.Create('[20180224001050] TCustomTestCLI.AddFile already exists: '+Filename);
  459. Result:=TCLIFile.Create(Filename,Source,DefaultFileAge,faNormal);
  460. FFiles.Add(Result);
  461. AddDir(ExtractFilePath(Filename));
  462. end;
  463. function TCustomTestCLI.AddFile(Filename: string;
  464. const SourceLines: array of string): TCLIFile;
  465. begin
  466. Result:=AddFile(Filename,LinesToStr(SourceLines));
  467. end;
  468. function TCustomTestCLI.AddUnit(Filename: string; const Intf,
  469. Impl: array of string): TCLIFile;
  470. var
  471. Name: String;
  472. begin
  473. Name:=ExtractFilenameOnly(Filename);
  474. Result:=AddFile(Filename,
  475. 'unit '+Name+';'+LineEnding
  476. +'interface'+LineEnding
  477. +LinesToStr(Intf)
  478. +'implementation'+LineEnding
  479. +LinesToStr(Impl)
  480. +'end.'+LineEnding);
  481. end;
  482. function TCustomTestCLI.AddDir(Filename: string): TCLIFile;
  483. var
  484. p: Integer;
  485. Dir: String;
  486. aFile: TCLIFile;
  487. begin
  488. Result:=nil;
  489. Filename:=IncludeTrailingPathDelimiter(ExpandFilename(Filename));
  490. p:=length(Filename);
  491. while p>1 do
  492. begin
  493. if Filename[p]=PathDelim then
  494. begin
  495. Dir:=LeftStr(Filename,p-1);
  496. aFile:=FindFile(Dir);
  497. if Result=nil then
  498. Result:=aFile;
  499. if aFile=nil then
  500. begin
  501. {$IFDEF VerbosePCUFiler}
  502. writeln('TCustomTestCLI.AddDir add Dir=',Dir);
  503. {$ENDIF}
  504. FFiles.Add(TCLIFile.Create(Dir,'',DefaultFileAge,faDirectory));
  505. end
  506. else if (aFile.Attr and faDirectory)=0 then
  507. begin
  508. {$IFDEF VerbosePCUFiler}
  509. writeln('[20180224001036] TCustomTestCLI.AddDir file exists: Dir=',Dir);
  510. {$ENDIF}
  511. raise EPas2jsFileCache.Create('[20180224001036] TCustomTestCLI.AddDir Dir='+Dir);
  512. end;
  513. dec(p);
  514. end else
  515. dec(p);
  516. end;
  517. end;
  518. procedure TCustomTestCLI.AssertFileExists(Filename: string);
  519. var
  520. aFile: TCLIFile;
  521. begin
  522. aFile:=FindFile(Filename);
  523. AssertNotNull('File not found: '+Filename,aFile);
  524. end;
  525. function TCustomTestCLI.GetLogCount: integer;
  526. begin
  527. Result:=FLogMsgs.Count;
  528. end;
  529. { TTestCLI_UnitSearch }
  530. procedure TTestCLI_UnitSearch.TestUS_Program;
  531. begin
  532. AddUnit('system.pp',[''],['']);
  533. AddFile('test1.pas',[
  534. 'begin',
  535. 'end.']);
  536. Compile(['test1.pas','-va']);
  537. AssertNotNull('test1.js not found',FindFile('test1.js'));
  538. end;
  539. procedure TTestCLI_UnitSearch.TestUS_UsesEmptyFileFail;
  540. begin
  541. AddFile('system.pp','');
  542. AddFile('test1.pas',[
  543. 'begin',
  544. 'end.']);
  545. Compile(['test1.pas'],ExitCodeSyntaxError);
  546. AssertEquals('ErrorMsg','Expected "unit"',ErrorMsg);
  547. end;
  548. procedure TTestCLI_UnitSearch.TestUS_Program_o;
  549. begin
  550. AddUnit('system.pp',[''],['']);
  551. AddFile('test1.pas',[
  552. 'begin',
  553. 'end.']);
  554. Compile(['test1.pas','-obla.js']);
  555. AssertNotNull('bla.js not found',FindFile('bla.js'));
  556. end;
  557. procedure TTestCLI_UnitSearch.TestUS_Program_FU;
  558. begin
  559. AddUnit('system.pp',[''],['']);
  560. AddFile('test1.pas',[
  561. 'begin',
  562. 'end.']);
  563. AddDir('lib');
  564. Compile(['test1.pas','-FUlib']);
  565. AssertNotNull('lib/test1.js not found',FindFile('lib/test1.js'));
  566. end;
  567. procedure TTestCLI_UnitSearch.TestUS_Program_FU_o;
  568. begin
  569. AddUnit('system.pp',[''],['']);
  570. AddFile('test1.pas',[
  571. 'begin',
  572. 'end.']);
  573. AddDir('lib');
  574. Compile(['test1.pas','-FUlib','-ofoo.js']);
  575. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  576. AssertNotNull('foo.js not found',FindFile('foo.js'));
  577. end;
  578. procedure TTestCLI_UnitSearch.TestUS_Program_FE_o;
  579. begin
  580. AddUnit('system.pp',[''],['']);
  581. AddFile('test1.pas',[
  582. 'begin',
  583. 'end.']);
  584. AddDir('lib');
  585. Compile(['test1.pas','-FElib','-ofoo.js']);
  586. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  587. AssertNotNull('foo.js not found',FindFile('foo.js'));
  588. end;
  589. procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
  590. begin
  591. AddUnit('system.pp',[''],['']);
  592. AddUnit('unit1.pas',
  593. ['uses bird in ''unit2.pas'';',
  594. 'var a: longint;'],
  595. ['']);
  596. AddUnit('unit2.pas',
  597. ['var b: longint;'],
  598. ['']);
  599. AddFile('test1.pas',[
  600. 'uses foo in ''unit1.pas'', bar in ''unit2.pas'';',
  601. 'begin',
  602. ' bar.b:=foo.a;',
  603. ' a:=b;',
  604. 'end.']);
  605. Compile(['test1.pas','-Jc']);
  606. end;
  607. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_Duplicate;
  608. begin
  609. AddUnit('system.pp',[''],['']);
  610. AddUnit('unit1.pas',
  611. ['var a: longint;'],
  612. ['']);
  613. AddUnit('sub/unit1.pas',
  614. ['var b: longint;'],
  615. ['']);
  616. AddFile('test1.pas',[
  617. 'uses foo in ''unit1.pas'', bar in ''sub/unit1.pas'';',
  618. 'begin',
  619. ' bar.b:=foo.a;',
  620. ' a:=b;',
  621. 'end.']);
  622. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  623. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub/unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
  624. end;
  625. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
  626. begin
  627. AddUnit('system.pp',[''],['']);
  628. AddUnit('unit1.pas',
  629. ['var a: longint;'],
  630. ['']);
  631. AddUnit('sub/unit1.pas',
  632. ['var b: longint;'],
  633. ['']);
  634. AddUnit('unit2.pas',
  635. ['uses unit1 in ''unit1.pas'';'],
  636. ['']);
  637. AddFile('test1.pas',[
  638. 'uses unit2, foo in ''sub/unit1.pas'';',
  639. 'begin',
  640. 'end.']);
  641. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  642. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
  643. end;
  644. Initialization
  645. RegisterTests([TTestCLI_UnitSearch]);
  646. end.