tcunitsearch.pas 24 KB

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