tcunitsearch.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713
  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, Pas2JSPCUCompiler, Pas2jsFileCache, Pas2jsLogger,
  25. tcmodules;
  26. type
  27. { TTestCompiler }
  28. TTestCompiler = class(TPas2jsPCUCompiler)
  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(ExpandFileNamePJ(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. //FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
  197. Compiler.Log.OnLog:=@DoLog;
  198. Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
  199. Compiler.FileCache.OnReadFile:=@OnReadFile;
  200. Compiler.FileCache.OnWriteFile:=@OnWriteFile;
  201. end;
  202. procedure TCustomTestCLI.TearDown;
  203. {$IFDEF CheckPasTreeRefCount}
  204. var
  205. El: TPasElement;
  206. i: integer;
  207. {$ENDIF}
  208. begin
  209. FreeAndNil(FCompiler);
  210. FParams.Clear;
  211. FFiles.Clear;
  212. FLogMsgs.Clear;
  213. FErrorMsg:='';
  214. FErrorFile:='';
  215. FErrorLine:=0;
  216. FErrorCol:=0;
  217. FErrorNumber:=0;
  218. inherited TearDown;
  219. {$IFDEF EnablePasTreeGlobalRefCount}
  220. if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
  221. begin
  222. writeln('TCustomTestCLI.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  223. {$IFDEF CheckPasTreeRefCount}
  224. El:=TPasElement.FirstRefEl;
  225. while El<>nil do
  226. begin
  227. writeln(' ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
  228. for i:=0 to El.RefIds.Count-1 do
  229. writeln(' ',El.RefIds[i]);
  230. El:=El.NextRefEl;
  231. end;
  232. {$ENDIF}
  233. Halt;
  234. Fail('TCustomTestCLI.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  235. end;
  236. {$ENDIF}
  237. end;
  238. procedure TCustomTestCLI.DoLog(Sender: TObject; const Msg: String);
  239. var
  240. LogMsg: TCLILogMsg;
  241. begin
  242. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  243. writeln('TCustomTestCLI.DoLog ',Msg,' File=',Compiler.Log.LastMsgFile,' Line=',Compiler.Log.LastMsgLine);
  244. {$ENDIF}
  245. LogMsg:=TCLILogMsg.Create;
  246. LogMsg.Msg:=Msg;
  247. LogMsg.MsgTxt:=Compiler.Log.LastMsgTxt;
  248. LogMsg.MsgType:=Compiler.Log.LastMsgType;
  249. LogMsg.MsgFile:=Compiler.Log.LastMsgFile;
  250. LogMsg.MsgLine:=Compiler.Log.LastMsgLine;
  251. LogMsg.MsgCol:=Compiler.Log.LastMsgCol;
  252. LogMsg.MsgNumber:=Compiler.Log.LastMsgNumber;
  253. FLogMsgs.Add(LogMsg);
  254. if (LogMsg.MsgType<=mtError) then
  255. begin
  256. if (ErrorFile='')
  257. or ((ErrorLine<1) and (LogMsg.MsgLine>0)) then
  258. begin
  259. ErrorMsg:=LogMsg.MsgTxt;
  260. ErrorFile:=LogMsg.MsgFile;
  261. ErrorLine:=LogMsg.MsgLine;
  262. ErrorCol:=LogMsg.MsgCol;
  263. end;
  264. end;
  265. end;
  266. function TCustomTestCLI.OnReadDirectory(Dir: TPas2jsCachedDirectory): boolean;
  267. var
  268. i: Integer;
  269. aFile: TCLIFile;
  270. Path: String;
  271. begin
  272. Path:=Dir.Path;
  273. //writeln('TCustomTestCLI.ReadDirectory START ',Path,' ',Dir.Count);
  274. Dir.Add('.',DefaultFileAge,faDirectory,4096);
  275. Dir.Add('..',DefaultFileAge,faDirectory,4096);
  276. for i:=0 to FileCount-1 do
  277. begin
  278. aFile:=Files[i];
  279. if CompareFilenames(ExtractFilePath(aFile.Filename),Path)<>0 then continue;
  280. //writeln('TCustomTestCLI.ReadDirectory ',aFile.Filename);
  281. Dir.Add(ExtractFileName(aFile.Filename),aFile.Age,aFile.Attr,length(aFile.Source));
  282. end;
  283. //writeln('TCustomTestCLI.ReadDirectory END ',Path,' ',Dir.Count);
  284. Result:=true;
  285. end;
  286. function TCustomTestCLI.OnReadFile(aFilename: string; var aSource: string
  287. ): boolean;
  288. var
  289. aFile: TCLIFile;
  290. begin
  291. aFile:=FindFile(aFilename);
  292. //writeln('TCustomTestCLI.ReadFile ',aFilename,' Found=',aFile<>nil);
  293. if aFile=nil then exit(false);
  294. if (faDirectory and aFile.Attr)>0 then
  295. begin
  296. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  297. writeln('[20180224000557] TCustomTestCLI.OnReadFile ',aFilename);
  298. {$ENDIF}
  299. EPas2jsFileCache.Create('TCustomTestCLI.OnReadFile: reading directory '+aFilename);
  300. end;
  301. aSource:=aFile.Source;
  302. //writeln('TCustomTestCLI.OnReadFile ',aFile.Filename,' "',LeftStr(aFile.Source,50),'"');
  303. Result:=true;
  304. end;
  305. procedure TCustomTestCLI.OnWriteFile(aFilename: string; Source: string);
  306. var
  307. aFile: TCLIFile;
  308. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  309. //i: Integer;
  310. {$ENDIF}
  311. begin
  312. aFile:=FindFile(aFilename);
  313. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  314. writeln('TCustomTestCLI.WriteFile ',aFilename,' Found=',aFile<>nil,' SrcLen=',length(Source));
  315. {$ENDIF}
  316. if aFile<>nil then
  317. begin
  318. if (faDirectory and aFile.Attr)>0 then
  319. begin
  320. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  321. writeln('[20180223175616] TCustomTestCLI.OnWriteFile ',aFilename);
  322. {$ENDIF}
  323. raise EPas2jsFileCache.Create('unable to write file to directory "'+aFilename+'"');
  324. end;
  325. end else
  326. begin
  327. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  328. //writeln('TCustomTestCLI.OnWriteFile FFiles: ',FFiles.Count);
  329. //for i:=0 to FFiles.Count-1 do
  330. //begin
  331. // aFile:=TCLIFile(FFiles[i]);
  332. // writeln(' ',i,': Filename=',aFile.Filename,' ',CompareFilenames(aFile.Filename,aFilename),' Dir=',(aFile.Attr and faDirectory)>0,' Len=',length(aFile.Source));
  333. //end;
  334. {$ENDIF}
  335. aFile:=TCLIFile.Create(aFilename,'',0,0);
  336. FFiles.Add(aFile);
  337. end;
  338. aFile.Source:=Source;
  339. aFile.Attr:=faNormal;
  340. aFile.Age:=DateTimeToFileDate(CurDate);
  341. writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',LeftStr(aFile.Source,50),'" ');
  342. end;
  343. procedure TCustomTestCLI.WriteSources;
  344. var
  345. i, j, aRow, aCol: Integer;
  346. aFile: TCLIFile;
  347. SrcLines: TStringList;
  348. Line, aFilename: String;
  349. IsSrc: Boolean;
  350. begin
  351. writeln('TCustomTestCLI.WriteSources START');
  352. aFilename:=ErrorFile;
  353. aRow:=ErrorLine;
  354. aCol:=ErrorCol;
  355. SrcLines:=TStringList.Create;
  356. try
  357. for i:=0 to FileCount-1 do
  358. begin
  359. aFile:=Files[i];
  360. if (faDirectory and aFile.Attr)>0 then continue;
  361. writeln('Testcode:-File="',aFile.Filename,'"----------------------------------:');
  362. SrcLines.Text:=aFile.Source;
  363. IsSrc:=ExtractFilename(aFile.Filename)=ExtractFileName(aFilename);
  364. for j:=1 to SrcLines.Count do
  365. begin
  366. Line:=SrcLines[j-1];
  367. if IsSrc and (j=aRow) then
  368. begin
  369. write('*');
  370. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  371. end;
  372. writeln(Format('%:4d: ',[j]),Line);
  373. end;
  374. end;
  375. finally
  376. SrcLines.Free;
  377. end;
  378. end;
  379. constructor TCustomTestCLI.Create;
  380. begin
  381. inherited Create;
  382. FFiles:=TObjectList.Create(true);
  383. FLogMsgs:=TObjectList.Create(true);
  384. FParams:=TStringList.Create;
  385. CurDate:=Now;
  386. end;
  387. destructor TCustomTestCLI.Destroy;
  388. begin
  389. FreeAndNil(FFiles);
  390. FreeAndNil(FLogMsgs);
  391. FreeAndNil(FParams);
  392. inherited Destroy;
  393. end;
  394. procedure TCustomTestCLI.Compile(const Args: array of string;
  395. ExpectedExitCode: longint);
  396. var
  397. i: Integer;
  398. begin
  399. AssertEquals('Initial System.ExitCode',0,system.ExitCode);
  400. for i:=low(Args) to High(Args) do
  401. Params.Add(Args[i]);
  402. try
  403. try
  404. //writeln('TCustomTestCLI.Compile WorkDir=',WorkDir);
  405. Compiler.Run(CompilerExe,WorkDir,Params,false);
  406. except
  407. on E: ECompilerTerminate do
  408. begin
  409. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  410. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  411. {$ENDIF}
  412. end;
  413. on E: Exception do
  414. begin
  415. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  416. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  417. {$ENDIF}
  418. Fail('TCustomTestCLI.Compile '+E.ClassName+':'+E.Message);
  419. end;
  420. end;
  421. finally
  422. Compiler.Log.CloseOutputFile;
  423. end;
  424. if ExpectedExitCode<>ExitCode then
  425. begin
  426. WriteSources;
  427. AssertEquals('ExitCode',ExpectedExitCode,ExitCode);
  428. end;
  429. end;
  430. function TCustomTestCLI.FileCount: integer;
  431. begin
  432. Result:=FFiles.Count;
  433. end;
  434. function TCustomTestCLI.FindFile(Filename: string): TCLIFile;
  435. var
  436. i: Integer;
  437. begin
  438. Filename:=ExpandFilename(Filename);
  439. for i:=0 to FileCount-1 do
  440. if CompareFilenames(Files[i].Filename,Filename)=0 then
  441. exit(Files[i]);
  442. Result:=nil;
  443. end;
  444. function TCustomTestCLI.ExpandFilename(const Filename: string): string;
  445. begin
  446. Result:=SetDirSeparators(Filename);
  447. if not FilenameIsAbsolute(Result) then
  448. Result:=WorkDir+Result;
  449. Result:=ResolveDots(Result);
  450. end;
  451. function TCustomTestCLI.AddFile(Filename, Source: string): TCLIFile;
  452. begin
  453. Filename:=ExpandFilename(Filename);
  454. {$IFDEF VerbosePCUFiler}
  455. writeln('TCustomTestCLI.AddFile ',Filename);
  456. {$ENDIF}
  457. Result:=FindFile(Filename);
  458. if Result<>nil then
  459. raise Exception.Create('[20180224001050] TCustomTestCLI.AddFile already exists: '+Filename);
  460. Result:=TCLIFile.Create(Filename,Source,DefaultFileAge,faNormal);
  461. FFiles.Add(Result);
  462. AddDir(ExtractFilePath(Filename));
  463. end;
  464. function TCustomTestCLI.AddFile(Filename: string;
  465. const SourceLines: array of string): TCLIFile;
  466. begin
  467. Result:=AddFile(Filename,LinesToStr(SourceLines));
  468. end;
  469. function TCustomTestCLI.AddUnit(Filename: string; const Intf,
  470. Impl: array of string): TCLIFile;
  471. var
  472. Name: String;
  473. begin
  474. Name:=ExtractFilenameOnly(Filename);
  475. Result:=AddFile(Filename,
  476. 'unit '+Name+';'+LineEnding
  477. +'interface'+LineEnding
  478. +LinesToStr(Intf)
  479. +'implementation'+LineEnding
  480. +LinesToStr(Impl)
  481. +'end.'+LineEnding);
  482. end;
  483. function TCustomTestCLI.AddDir(Filename: string): TCLIFile;
  484. var
  485. p: Integer;
  486. Dir: String;
  487. aFile: TCLIFile;
  488. begin
  489. Result:=nil;
  490. Filename:=IncludeTrailingPathDelimiter(ExpandFilename(Filename));
  491. p:=length(Filename);
  492. while p>1 do
  493. begin
  494. if Filename[p]=PathDelim then
  495. begin
  496. Dir:=LeftStr(Filename,p-1);
  497. aFile:=FindFile(Dir);
  498. if Result=nil then
  499. Result:=aFile;
  500. if aFile=nil then
  501. begin
  502. {$IFDEF VerbosePCUFiler}
  503. writeln('TCustomTestCLI.AddDir add Dir=',Dir);
  504. {$ENDIF}
  505. FFiles.Add(TCLIFile.Create(Dir,'',DefaultFileAge,faDirectory));
  506. end
  507. else if (aFile.Attr and faDirectory)=0 then
  508. begin
  509. {$IFDEF VerbosePCUFiler}
  510. writeln('[20180224001036] TCustomTestCLI.AddDir file exists: Dir=',Dir);
  511. {$ENDIF}
  512. raise EPas2jsFileCache.Create('[20180224001036] TCustomTestCLI.AddDir Dir='+Dir);
  513. end;
  514. dec(p);
  515. end else
  516. dec(p);
  517. end;
  518. end;
  519. procedure TCustomTestCLI.AssertFileExists(Filename: string);
  520. var
  521. aFile: TCLIFile;
  522. begin
  523. aFile:=FindFile(Filename);
  524. AssertNotNull('File not found: '+Filename,aFile);
  525. end;
  526. function TCustomTestCLI.GetLogCount: integer;
  527. begin
  528. Result:=FLogMsgs.Count;
  529. end;
  530. { TTestCLI_UnitSearch }
  531. procedure TTestCLI_UnitSearch.TestUS_Program;
  532. begin
  533. AddUnit('system.pp',[''],['']);
  534. AddFile('test1.pas',[
  535. 'begin',
  536. 'end.']);
  537. Compile(['test1.pas','-va']);
  538. AssertNotNull('test1.js not found',FindFile('test1.js'));
  539. end;
  540. procedure TTestCLI_UnitSearch.TestUS_UsesEmptyFileFail;
  541. begin
  542. AddFile('system.pp','');
  543. AddFile('test1.pas',[
  544. 'begin',
  545. 'end.']);
  546. Compile(['test1.pas'],ExitCodeSyntaxError);
  547. AssertEquals('ErrorMsg','Expected "unit"',ErrorMsg);
  548. end;
  549. procedure TTestCLI_UnitSearch.TestUS_Program_o;
  550. begin
  551. AddUnit('system.pp',[''],['']);
  552. AddFile('test1.pas',[
  553. 'begin',
  554. 'end.']);
  555. Compile(['test1.pas','-obla.js']);
  556. AssertNotNull('bla.js not found',FindFile('bla.js'));
  557. end;
  558. procedure TTestCLI_UnitSearch.TestUS_Program_FU;
  559. begin
  560. AddUnit('system.pp',[''],['']);
  561. AddFile('test1.pas',[
  562. 'begin',
  563. 'end.']);
  564. AddDir('lib');
  565. Compile(['test1.pas','-FUlib']);
  566. AssertNotNull('lib/test1.js not found',FindFile('lib/test1.js'));
  567. end;
  568. procedure TTestCLI_UnitSearch.TestUS_Program_FU_o;
  569. begin
  570. AddUnit('system.pp',[''],['']);
  571. AddFile('test1.pas',[
  572. 'begin',
  573. 'end.']);
  574. AddDir('lib');
  575. Compile(['test1.pas','-FUlib','-ofoo.js']);
  576. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  577. AssertNotNull('foo.js not found',FindFile('foo.js'));
  578. end;
  579. procedure TTestCLI_UnitSearch.TestUS_Program_FE_o;
  580. begin
  581. AddUnit('system.pp',[''],['']);
  582. AddFile('test1.pas',[
  583. 'begin',
  584. 'end.']);
  585. AddDir('lib');
  586. Compile(['test1.pas','-FElib','-ofoo.js']);
  587. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  588. AssertNotNull('foo.js not found',FindFile('foo.js'));
  589. end;
  590. procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
  591. begin
  592. AddUnit('system.pp',[''],['']);
  593. AddUnit('unit1.pas',
  594. ['uses bird in ''unit2.pas'';',
  595. 'var a: longint;'],
  596. ['']);
  597. AddUnit('unit2.pas',
  598. ['var b: longint;'],
  599. ['']);
  600. AddFile('test1.pas',[
  601. 'uses foo in ''unit1.pas'', bar in ''unit2.pas'';',
  602. 'begin',
  603. ' bar.b:=foo.a;',
  604. ' a:=b;',
  605. 'end.']);
  606. Compile(['test1.pas','-Jc']);
  607. end;
  608. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_Duplicate;
  609. begin
  610. AddUnit('system.pp',[''],['']);
  611. AddUnit('unit1.pas',
  612. ['var a: longint;'],
  613. ['']);
  614. AddUnit('sub/unit1.pas',
  615. ['var b: longint;'],
  616. ['']);
  617. AddFile('test1.pas',[
  618. 'uses foo in ''unit1.pas'', bar in ''sub/unit1.pas'';',
  619. 'begin',
  620. ' bar.b:=foo.a;',
  621. ' a:=b;',
  622. 'end.']);
  623. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  624. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub/unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
  625. end;
  626. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
  627. begin
  628. AddUnit('system.pp',[''],['']);
  629. AddUnit('unit1.pas',
  630. ['var a: longint;'],
  631. ['']);
  632. AddUnit('sub/unit1.pas',
  633. ['var b: longint;'],
  634. ['']);
  635. AddUnit('unit2.pas',
  636. ['uses unit1 in ''unit1.pas'';'],
  637. ['']);
  638. AddFile('test1.pas',[
  639. 'uses unit2, foo in ''sub/unit1.pas'';',
  640. 'begin',
  641. 'end.']);
  642. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  643. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
  644. end;
  645. Initialization
  646. RegisterTests([TTestCLI_UnitSearch]);
  647. end.