tcunitsearch.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775
  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_CreateRelativePath;
  120. procedure TestUS_Program;
  121. procedure TestUS_UsesEmptyFileFail;
  122. procedure TestUS_Program_o;
  123. procedure TestUS_Program_FU;
  124. procedure TestUS_Program_FU_o;
  125. procedure TestUS_Program_FE_o;
  126. procedure TestUS_UsesInFile;
  127. procedure TestUS_UsesInFile_Duplicate;
  128. procedure TestUS_UsesInFile_IndirectDuplicate;
  129. procedure TestUS_UsesInFile_WorkNotEqProgDir;
  130. end;
  131. function LinesToStr(const Lines: array of string): string;
  132. implementation
  133. function LinesToStr(const Lines: array of string): string;
  134. var
  135. i: Integer;
  136. begin
  137. Result:='';
  138. for i:=low(Lines) to high(Lines) do
  139. Result:=Result+Lines[i]+LineEnding;
  140. end;
  141. { TCLIFile }
  142. constructor TCLIFile.Create(const aFilename, Src: string;
  143. aAge: TPas2jsFileAgeTime; aAttr: TPas2jsFileAttr);
  144. begin
  145. Filename:=aFilename;
  146. Source:=Src;
  147. Age:=aAge;
  148. Attr:=aAttr;
  149. end;
  150. { TTestCompiler }
  151. function TTestCompiler.GetExitCode: Longint;
  152. begin
  153. Result:=FExitCode;
  154. end;
  155. procedure TTestCompiler.SetExitCode(Value: Longint);
  156. begin
  157. FExitCode:=Value;
  158. end;
  159. { TCustomTestCLI }
  160. function TCustomTestCLI.GetFiles(Index: integer): TCLIFile;
  161. begin
  162. Result:=TCLIFile(FFiles[Index]);
  163. end;
  164. function TCustomTestCLI.GetExitCode: integer;
  165. begin
  166. Result:=Compiler.ExitCode;
  167. end;
  168. function TCustomTestCLI.GetLogMsgs(Index: integer): TCLILogMsg;
  169. begin
  170. Result:=TCLILogMsg(FLogMsgs[Index]);
  171. end;
  172. procedure TCustomTestCLI.SetExitCode(const AValue: integer);
  173. begin
  174. Compiler.ExitCode:=AValue;
  175. end;
  176. procedure TCustomTestCLI.SetWorkDir(const AValue: string);
  177. var
  178. NewValue: String;
  179. begin
  180. NewValue:=IncludeTrailingPathDelimiter(ExpandFileNamePJ(ResolveDots(AValue)));
  181. if FWorkDir=NewValue then Exit;
  182. FWorkDir:=NewValue;
  183. end;
  184. procedure TCustomTestCLI.SetUp;
  185. begin
  186. {$IFDEF EnablePasTreeGlobalRefCount}
  187. FElementRefCountAtSetup:=TPasElement.GlobalRefCount;
  188. {$ENDIF}
  189. inherited SetUp;
  190. FDefaultFileAge:=DateTimeToFileDate(Now);
  191. WorkDir:=ExtractFilePath(ParamStr(0));
  192. {$IFDEF Windows}
  193. CompilerExe:='P:\bin\pas2js.exe';
  194. {$ELSE}
  195. CompilerExe:='/usr/bin/pas2js';
  196. {$ENDIF}
  197. FCompiler:=TTestCompiler.Create;
  198. //FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
  199. Compiler.Log.OnLog:=@DoLog;
  200. Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
  201. Compiler.FileCache.OnReadFile:=@OnReadFile;
  202. Compiler.FileCache.OnWriteFile:=@OnWriteFile;
  203. end;
  204. procedure TCustomTestCLI.TearDown;
  205. {$IFDEF CheckPasTreeRefCount}
  206. var
  207. El: TPasElement;
  208. i: integer;
  209. {$ENDIF}
  210. begin
  211. FreeAndNil(FCompiler);
  212. FParams.Clear;
  213. FFiles.Clear;
  214. FLogMsgs.Clear;
  215. FErrorMsg:='';
  216. FErrorFile:='';
  217. FErrorLine:=0;
  218. FErrorCol:=0;
  219. FErrorNumber:=0;
  220. inherited TearDown;
  221. {$IFDEF EnablePasTreeGlobalRefCount}
  222. if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
  223. begin
  224. writeln('TCustomTestCLI.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  225. {$IFDEF CheckPasTreeRefCount}
  226. El:=TPasElement.FirstRefEl;
  227. while El<>nil do
  228. begin
  229. writeln(' ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
  230. for i:=0 to El.RefIds.Count-1 do
  231. writeln(' ',El.RefIds[i]);
  232. El:=El.NextRefEl;
  233. end;
  234. {$ENDIF}
  235. Halt;
  236. Fail('TCustomTestCLI.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  237. end;
  238. {$ENDIF}
  239. end;
  240. procedure TCustomTestCLI.DoLog(Sender: TObject; const Msg: String);
  241. var
  242. LogMsg: TCLILogMsg;
  243. begin
  244. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  245. writeln('TCustomTestCLI.DoLog ',Msg,' File=',Compiler.Log.LastMsgFile,' Line=',Compiler.Log.LastMsgLine);
  246. {$ENDIF}
  247. LogMsg:=TCLILogMsg.Create;
  248. LogMsg.Msg:=Msg;
  249. LogMsg.MsgTxt:=Compiler.Log.LastMsgTxt;
  250. LogMsg.MsgType:=Compiler.Log.LastMsgType;
  251. LogMsg.MsgFile:=Compiler.Log.LastMsgFile;
  252. LogMsg.MsgLine:=Compiler.Log.LastMsgLine;
  253. LogMsg.MsgCol:=Compiler.Log.LastMsgCol;
  254. LogMsg.MsgNumber:=Compiler.Log.LastMsgNumber;
  255. FLogMsgs.Add(LogMsg);
  256. if (LogMsg.MsgType<=mtError) then
  257. begin
  258. if (ErrorFile='')
  259. or ((ErrorLine<1) and (LogMsg.MsgLine>0)) then
  260. begin
  261. ErrorMsg:=LogMsg.MsgTxt;
  262. ErrorFile:=LogMsg.MsgFile;
  263. ErrorLine:=LogMsg.MsgLine;
  264. ErrorCol:=LogMsg.MsgCol;
  265. end;
  266. end;
  267. end;
  268. function TCustomTestCLI.OnReadDirectory(Dir: TPas2jsCachedDirectory): boolean;
  269. var
  270. i: Integer;
  271. aFile: TCLIFile;
  272. Path: String;
  273. begin
  274. Path:=Dir.Path;
  275. //writeln('TCustomTestCLI.ReadDirectory START ',Path,' ',Dir.Count);
  276. Dir.Add('.',DefaultFileAge,faDirectory,4096);
  277. Dir.Add('..',DefaultFileAge,faDirectory,4096);
  278. for i:=0 to FileCount-1 do
  279. begin
  280. aFile:=Files[i];
  281. if CompareFilenames(ExtractFilePath(aFile.Filename),Path)<>0 then continue;
  282. //writeln('TCustomTestCLI.ReadDirectory ',aFile.Filename);
  283. Dir.Add(ExtractFileName(aFile.Filename),aFile.Age,aFile.Attr,length(aFile.Source));
  284. end;
  285. //writeln('TCustomTestCLI.ReadDirectory END ',Path,' ',Dir.Count);
  286. Result:=true;
  287. end;
  288. function TCustomTestCLI.OnReadFile(aFilename: string; var aSource: string
  289. ): boolean;
  290. var
  291. aFile: TCLIFile;
  292. begin
  293. aFile:=FindFile(aFilename);
  294. //writeln('TCustomTestCLI.ReadFile ',aFilename,' Found=',aFile<>nil);
  295. if aFile=nil then exit(false);
  296. if (faDirectory and aFile.Attr)>0 then
  297. begin
  298. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  299. writeln('[20180224000557] TCustomTestCLI.OnReadFile ',aFilename);
  300. {$ENDIF}
  301. EPas2jsFileCache.Create('TCustomTestCLI.OnReadFile: reading directory '+aFilename);
  302. end;
  303. aSource:=aFile.Source;
  304. //writeln('TCustomTestCLI.OnReadFile ',aFile.Filename,' "',LeftStr(aFile.Source,50),'"');
  305. Result:=true;
  306. end;
  307. procedure TCustomTestCLI.OnWriteFile(aFilename: string; Source: string);
  308. var
  309. aFile: TCLIFile;
  310. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  311. //i: Integer;
  312. {$ENDIF}
  313. begin
  314. aFile:=FindFile(aFilename);
  315. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  316. writeln('TCustomTestCLI.WriteFile ',aFilename,' Found=',aFile<>nil,' SrcLen=',length(Source));
  317. {$ENDIF}
  318. if aFile<>nil then
  319. begin
  320. if (faDirectory and aFile.Attr)>0 then
  321. begin
  322. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  323. writeln('[20180223175616] TCustomTestCLI.OnWriteFile ',aFilename);
  324. {$ENDIF}
  325. raise EPas2jsFileCache.Create('unable to write file to directory "'+aFilename+'"');
  326. end;
  327. end else
  328. begin
  329. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  330. //writeln('TCustomTestCLI.OnWriteFile FFiles: ',FFiles.Count);
  331. //for i:=0 to FFiles.Count-1 do
  332. //begin
  333. // aFile:=TCLIFile(FFiles[i]);
  334. // writeln(' ',i,': Filename=',aFile.Filename,' ',CompareFilenames(aFile.Filename,aFilename),' Dir=',(aFile.Attr and faDirectory)>0,' Len=',length(aFile.Source));
  335. //end;
  336. {$ENDIF}
  337. aFile:=TCLIFile.Create(aFilename,'',0,0);
  338. FFiles.Add(aFile);
  339. end;
  340. aFile.Source:=Source;
  341. aFile.Attr:=faNormal;
  342. aFile.Age:=DateTimeToFileDate(CurDate);
  343. writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',LeftStr(aFile.Source,50),'" ');
  344. end;
  345. procedure TCustomTestCLI.WriteSources;
  346. var
  347. i, j, aRow, aCol: Integer;
  348. aFile: TCLIFile;
  349. SrcLines: TStringList;
  350. Line, aFilename: String;
  351. IsSrc: Boolean;
  352. begin
  353. writeln('TCustomTestCLI.WriteSources START');
  354. aFilename:=ErrorFile;
  355. aRow:=ErrorLine;
  356. aCol:=ErrorCol;
  357. SrcLines:=TStringList.Create;
  358. try
  359. for i:=0 to FileCount-1 do
  360. begin
  361. aFile:=Files[i];
  362. if (faDirectory and aFile.Attr)>0 then continue;
  363. writeln('Testcode:-File="',aFile.Filename,'"----------------------------------:');
  364. SrcLines.Text:=aFile.Source;
  365. IsSrc:=ExtractFilename(aFile.Filename)=ExtractFileName(aFilename);
  366. for j:=1 to SrcLines.Count do
  367. begin
  368. Line:=SrcLines[j-1];
  369. if IsSrc and (j=aRow) then
  370. begin
  371. write('*');
  372. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  373. end;
  374. writeln(Format('%:4d: ',[j]),Line);
  375. end;
  376. end;
  377. finally
  378. SrcLines.Free;
  379. end;
  380. end;
  381. constructor TCustomTestCLI.Create;
  382. begin
  383. inherited Create;
  384. FFiles:=TObjectList.Create(true);
  385. FLogMsgs:=TObjectList.Create(true);
  386. FParams:=TStringList.Create;
  387. CurDate:=Now;
  388. end;
  389. destructor TCustomTestCLI.Destroy;
  390. begin
  391. FreeAndNil(FFiles);
  392. FreeAndNil(FLogMsgs);
  393. FreeAndNil(FParams);
  394. inherited Destroy;
  395. end;
  396. procedure TCustomTestCLI.Compile(const Args: array of string;
  397. ExpectedExitCode: longint);
  398. var
  399. i: Integer;
  400. begin
  401. AssertEquals('Initial System.ExitCode',0,system.ExitCode);
  402. for i:=low(Args) to High(Args) do
  403. Params.Add(Args[i]);
  404. try
  405. try
  406. //writeln('TCustomTestCLI.Compile WorkDir=',WorkDir);
  407. Compiler.Run(CompilerExe,WorkDir,Params,false);
  408. except
  409. on E: ECompilerTerminate do
  410. begin
  411. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  412. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  413. {$ENDIF}
  414. end;
  415. on E: Exception do
  416. begin
  417. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  418. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  419. {$ENDIF}
  420. Fail('TCustomTestCLI.Compile '+E.ClassName+':'+E.Message);
  421. end;
  422. end;
  423. finally
  424. Compiler.Log.CloseOutputFile;
  425. end;
  426. if ExpectedExitCode<>ExitCode then
  427. begin
  428. WriteSources;
  429. AssertEquals('ExitCode',ExpectedExitCode,ExitCode);
  430. end;
  431. end;
  432. function TCustomTestCLI.FileCount: integer;
  433. begin
  434. Result:=FFiles.Count;
  435. end;
  436. function TCustomTestCLI.FindFile(Filename: string): TCLIFile;
  437. var
  438. i: Integer;
  439. begin
  440. Filename:=ExpandFilename(Filename);
  441. for i:=0 to FileCount-1 do
  442. if CompareFilenames(Files[i].Filename,Filename)=0 then
  443. exit(Files[i]);
  444. Result:=nil;
  445. end;
  446. function TCustomTestCLI.ExpandFilename(const Filename: string): string;
  447. begin
  448. Result:=SetDirSeparators(Filename);
  449. if not FilenameIsAbsolute(Result) then
  450. Result:=WorkDir+Result;
  451. Result:=ResolveDots(Result);
  452. end;
  453. function TCustomTestCLI.AddFile(Filename, Source: string): TCLIFile;
  454. begin
  455. Filename:=ExpandFilename(Filename);
  456. {$IFDEF VerbosePCUFiler}
  457. writeln('TCustomTestCLI.AddFile ',Filename);
  458. {$ENDIF}
  459. Result:=FindFile(Filename);
  460. if Result<>nil then
  461. raise Exception.Create('[20180224001050] TCustomTestCLI.AddFile already exists: '+Filename);
  462. Result:=TCLIFile.Create(Filename,Source,DefaultFileAge,faNormal);
  463. FFiles.Add(Result);
  464. AddDir(ExtractFilePath(Filename));
  465. end;
  466. function TCustomTestCLI.AddFile(Filename: string;
  467. const SourceLines: array of string): TCLIFile;
  468. begin
  469. Result:=AddFile(Filename,LinesToStr(SourceLines));
  470. end;
  471. function TCustomTestCLI.AddUnit(Filename: string; const Intf,
  472. Impl: array of string): TCLIFile;
  473. var
  474. Name: String;
  475. begin
  476. Name:=ExtractFilenameOnly(Filename);
  477. Result:=AddFile(Filename,
  478. 'unit '+Name+';'+LineEnding
  479. +'interface'+LineEnding
  480. +LinesToStr(Intf)
  481. +'implementation'+LineEnding
  482. +LinesToStr(Impl)
  483. +'end.'+LineEnding);
  484. end;
  485. function TCustomTestCLI.AddDir(Filename: string): TCLIFile;
  486. var
  487. p: Integer;
  488. Dir: String;
  489. aFile: TCLIFile;
  490. begin
  491. Result:=nil;
  492. Filename:=IncludeTrailingPathDelimiter(ExpandFilename(Filename));
  493. p:=length(Filename);
  494. while p>1 do
  495. begin
  496. if Filename[p]=PathDelim then
  497. begin
  498. Dir:=LeftStr(Filename,p-1);
  499. aFile:=FindFile(Dir);
  500. if Result=nil then
  501. Result:=aFile;
  502. if aFile=nil then
  503. begin
  504. {$IFDEF VerbosePCUFiler}
  505. writeln('TCustomTestCLI.AddDir add Dir=',Dir);
  506. {$ENDIF}
  507. FFiles.Add(TCLIFile.Create(Dir,'',DefaultFileAge,faDirectory));
  508. end
  509. else if (aFile.Attr and faDirectory)=0 then
  510. begin
  511. {$IFDEF VerbosePCUFiler}
  512. writeln('[20180224001036] TCustomTestCLI.AddDir file exists: Dir=',Dir);
  513. {$ENDIF}
  514. raise EPas2jsFileCache.Create('[20180224001036] TCustomTestCLI.AddDir Dir='+Dir);
  515. end;
  516. dec(p);
  517. end else
  518. dec(p);
  519. end;
  520. end;
  521. procedure TCustomTestCLI.AssertFileExists(Filename: string);
  522. var
  523. aFile: TCLIFile;
  524. begin
  525. aFile:=FindFile(Filename);
  526. AssertNotNull('File not found: '+Filename,aFile);
  527. end;
  528. function TCustomTestCLI.GetLogCount: integer;
  529. begin
  530. Result:=FLogMsgs.Count;
  531. end;
  532. { TTestCLI_UnitSearch }
  533. procedure TTestCLI_UnitSearch.TestUS_CreateRelativePath;
  534. procedure DoTest(Filename, BaseDirectory, Expected: string;
  535. UsePointDirectory: boolean = false);
  536. var
  537. Actual: String;
  538. begin
  539. ForcePathDelims(Filename);
  540. ForcePathDelims(BaseDirectory);
  541. ForcePathDelims(Expected);
  542. if not TryCreateRelativePath(Filename,BaseDirectory,UsePointDirectory,true,Actual) then
  543. Actual:=Filename;
  544. AssertEquals('TryCreateRelativePath(File='+Filename+',Base='+BaseDirectory+')',
  545. Expected,Actual);
  546. end;
  547. begin
  548. DoTest('/a','/a','');
  549. DoTest('/a','/a','.',true);
  550. DoTest('/a','/a/','');
  551. DoTest('/a/b','/a/b','');
  552. DoTest('/a/b','/a/b/','');
  553. DoTest('/a','/a/','');
  554. DoTest('/a','','/a');
  555. DoTest('/a/b','/a','b');
  556. DoTest('/a/b','/a/','b');
  557. DoTest('/a/b','/a//','b');
  558. DoTest('/a','/a/b','..');
  559. DoTest('/a','/a/b/','..');
  560. DoTest('/a','/a/b//','..');
  561. DoTest('/a/','/a/b','..');
  562. DoTest('/a','/a/b/c','../..');
  563. DoTest('/a','/a/b//c','../..');
  564. DoTest('/a','/a//b/c','../..');
  565. DoTest('/a','/a//b/c/','../..');
  566. DoTest('/a','/b','/a');
  567. DoTest('~/bin','/','~/bin');
  568. DoTest('$(HOME)/bin','/','$(HOME)/bin');
  569. {$IFDEF MSWindows}
  570. DoTest('D:\a\b\c.pas','D:\a\d\','..\b\c.pas');
  571. {$ENDIF}
  572. end;
  573. procedure TTestCLI_UnitSearch.TestUS_Program;
  574. begin
  575. AddUnit('system.pp',[''],['']);
  576. AddFile('test1.pas',[
  577. 'begin',
  578. 'end.']);
  579. Compile(['test1.pas','-va']);
  580. AssertNotNull('test1.js not found',FindFile('test1.js'));
  581. end;
  582. procedure TTestCLI_UnitSearch.TestUS_UsesEmptyFileFail;
  583. begin
  584. AddFile('system.pp','');
  585. AddFile('test1.pas',[
  586. 'begin',
  587. 'end.']);
  588. Compile(['test1.pas'],ExitCodeSyntaxError);
  589. AssertEquals('ErrorMsg','Expected "unit"',ErrorMsg);
  590. end;
  591. procedure TTestCLI_UnitSearch.TestUS_Program_o;
  592. begin
  593. AddUnit('system.pp',[''],['']);
  594. AddFile('test1.pas',[
  595. 'begin',
  596. 'end.']);
  597. Compile(['test1.pas','-obla.js']);
  598. AssertNotNull('bla.js not found',FindFile('bla.js'));
  599. end;
  600. procedure TTestCLI_UnitSearch.TestUS_Program_FU;
  601. begin
  602. AddUnit('system.pp',[''],['']);
  603. AddFile('test1.pas',[
  604. 'begin',
  605. 'end.']);
  606. AddDir('lib');
  607. Compile(['test1.pas','-FUlib']);
  608. AssertNotNull('lib/test1.js not found',FindFile('lib/test1.js'));
  609. end;
  610. procedure TTestCLI_UnitSearch.TestUS_Program_FU_o;
  611. begin
  612. AddUnit('system.pp',[''],['']);
  613. AddFile('test1.pas',[
  614. 'begin',
  615. 'end.']);
  616. AddDir('lib');
  617. Compile(['test1.pas','-FUlib','-ofoo.js']);
  618. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  619. AssertNotNull('foo.js not found',FindFile('foo.js'));
  620. end;
  621. procedure TTestCLI_UnitSearch.TestUS_Program_FE_o;
  622. begin
  623. AddUnit('system.pp',[''],['']);
  624. AddFile('test1.pas',[
  625. 'begin',
  626. 'end.']);
  627. AddDir('lib');
  628. Compile(['test1.pas','-FElib','-ofoo.js']);
  629. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  630. AssertNotNull('foo.js not found',FindFile('foo.js'));
  631. end;
  632. procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
  633. begin
  634. AddUnit('system.pp',[''],['']);
  635. AddUnit('unit1.pas',
  636. ['uses bird in ''unit2.pas'';',
  637. 'var a: longint;'],
  638. ['']);
  639. AddUnit('unit2.pas',
  640. ['var b: longint;'],
  641. ['']);
  642. AddFile('test1.pas',[
  643. 'uses foo in ''unit1.pas'', bar in ''unit2.pas'';',
  644. 'begin',
  645. ' bar.b:=foo.a;',
  646. ' a:=b;',
  647. 'end.']);
  648. Compile(['test1.pas','-Jc']);
  649. end;
  650. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_Duplicate;
  651. begin
  652. AddUnit('system.pp',[''],['']);
  653. AddUnit('unit1.pas',
  654. ['var a: longint;'],
  655. ['']);
  656. AddUnit('sub/unit1.pas',
  657. ['var b: longint;'],
  658. ['']);
  659. AddFile('test1.pas',[
  660. 'uses foo in ''unit1.pas'', bar in ''sub/unit1.pas'';',
  661. 'begin',
  662. ' bar.b:=foo.a;',
  663. ' a:=b;',
  664. 'end.']);
  665. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  666. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub/unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
  667. end;
  668. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
  669. begin
  670. AddUnit('system.pp',[''],['']);
  671. AddUnit('unit1.pas',
  672. ['var a: longint;'],
  673. ['']);
  674. AddUnit('sub/unit1.pas',
  675. ['var b: longint;'],
  676. ['']);
  677. AddUnit('unit2.pas',
  678. ['uses unit1 in ''unit1.pas'';'],
  679. ['']);
  680. AddFile('test1.pas',[
  681. 'uses unit2, foo in ''sub/unit1.pas'';',
  682. 'begin',
  683. 'end.']);
  684. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  685. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
  686. end;
  687. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_WorkNotEqProgDir;
  688. begin
  689. AddUnit('system.pp',[''],['']);
  690. AddUnit('sub/unit2.pas',
  691. ['var a: longint;'],
  692. ['']);
  693. AddUnit('sub/unit1.pas',
  694. ['uses unit2;'],
  695. ['']);
  696. AddFile('sub/test1.pas',[
  697. 'uses foo in ''unit1.pas'';',
  698. 'begin',
  699. 'end.']);
  700. Compile(['sub/test1.pas','-Jc']);
  701. end;
  702. Initialization
  703. RegisterTests([TTestCLI_UnitSearch]);
  704. end.