tcunitsearch.pas 22 KB

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