tcunitsearch.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101
  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. procedure CheckDiff(Msg, Expected, Actual: string); virtual;
  89. public
  90. constructor Create; override;
  91. destructor Destroy; override;
  92. procedure Compile(const Args: array of string; ExpectedExitCode: longint = 0);
  93. property Compiler: TTestCompiler read FCompiler;
  94. property CompilerExe: string read FCompilerExe write FCompilerExe;
  95. property Params: TStringList read FParams;
  96. property Files[Index: integer]: TCLIFile read GetFiles; // files an directories
  97. function FileCount: integer;
  98. function FindFile(Filename: string): TCLIFile; // files and directories
  99. function ExpandFilename(const Filename: string): string;
  100. function AddFile(Filename, Source: string): TCLIFile;
  101. function AddFile(Filename: string; const SourceLines: array of string): TCLIFile;
  102. function AddUnit(Filename: string; const Intf, Impl: array of string): TCLIFile;
  103. function AddDir(Filename: string): TCLIFile;
  104. procedure AssertFileExists(Filename: string);
  105. property WorkDir: string read FWorkDir write SetWorkDir;
  106. property DefaultFileAge: longint read FDefaultFileAge write FDefaultFileAge;
  107. property ExitCode: integer read GetExitCode write SetExitCode;
  108. property LogMsgs[Index: integer]: TCLILogMsg read GetLogMsgs;
  109. function GetLogCount: integer;
  110. property ErrorMsg: string read FErrorMsg write FErrorMsg;
  111. property ErrorFile: string read FErrorFile write FErrorFile;
  112. property ErrorLine: integer read FErrorLine write FErrorLine;
  113. property ErrorCol: integer read FErrorCol write FErrorCol;
  114. property ErrorNumber: integer read FErrorNumber write FErrorNumber;
  115. property CurDate: TDateTime read FCurDate write FCurDate;
  116. end;
  117. { TTestCLI_UnitSearch }
  118. TTestCLI_UnitSearch = class(TCustomTestCLI)
  119. protected
  120. procedure CheckLinklibProgramSrc(Msg,Header: string);
  121. procedure CheckFullSource(Msg, Filename, ExpectedSrc: string);
  122. published
  123. procedure TestUS_CreateRelativePath;
  124. procedure TestUS_Program;
  125. procedure TestUS_UsesEmptyFileFail;
  126. procedure TestUS_Program_o;
  127. procedure TestUS_Program_FU;
  128. procedure TestUS_Program_FU_o;
  129. procedure TestUS_Program_FE_o;
  130. procedure TestUS_PlatformModule_Program;
  131. // include files
  132. procedure TestUS_IncludeSameDir;
  133. Procedure TestUS_Include_NestedDelphi;
  134. Procedure TestUS_Include_NestedObjFPC;
  135. // uses 'in' modifier
  136. procedure TestUS_UsesInFile;
  137. procedure TestUS_UsesInFile_Duplicate;
  138. procedure TestUS_UsesInFile_IndirectDuplicate;
  139. procedure TestUS_UsesInFile_WorkNotEqProgDir;
  140. procedure TestUS_UsesInFileTwice;
  141. procedure TestUS_UseUnitTwiceFail;
  142. procedure TestUS_UseUnitTwiceViaNameSpace;
  143. // namespace
  144. Procedure TestUS_DefaultNameSpaceLast;
  145. Procedure TestUS_DefaultNameSpaceAfterNameSpace;
  146. Procedure TestUS_NoNameSpaceBeforeDefaultNameSpace;
  147. Procedure TestUS_NoNameSpaceAndDefaultNameSpace;
  148. // linklib
  149. procedure TestUS_ProgramLinklib;
  150. procedure TestUS_UnitLinklib;
  151. end;
  152. function LinesToStr(const Lines: array of string): string;
  153. implementation
  154. function LinesToStr(const Lines: array of string): string;
  155. var
  156. i: Integer;
  157. begin
  158. Result:='';
  159. for i:=low(Lines) to high(Lines) do
  160. Result:=Result+Lines[i]+LineEnding;
  161. end;
  162. { TCLIFile }
  163. constructor TCLIFile.Create(const aFilename, Src: string;
  164. aAge: TPas2jsFileAgeTime; aAttr: TPas2jsFileAttr);
  165. begin
  166. Filename:=aFilename;
  167. Source:=Src;
  168. Age:=aAge;
  169. Attr:=aAttr;
  170. end;
  171. { TTestCompiler }
  172. function TTestCompiler.GetExitCode: Longint;
  173. begin
  174. Result:=FExitCode;
  175. end;
  176. procedure TTestCompiler.SetExitCode(Value: Longint);
  177. begin
  178. FExitCode:=Value;
  179. end;
  180. { TCustomTestCLI }
  181. function TCustomTestCLI.GetFiles(Index: integer): TCLIFile;
  182. begin
  183. Result:=TCLIFile(FFiles[Index]);
  184. end;
  185. function TCustomTestCLI.GetExitCode: integer;
  186. begin
  187. Result:=Compiler.ExitCode;
  188. end;
  189. function TCustomTestCLI.GetLogMsgs(Index: integer): TCLILogMsg;
  190. begin
  191. Result:=TCLILogMsg(FLogMsgs[Index]);
  192. end;
  193. procedure TCustomTestCLI.SetExitCode(const AValue: integer);
  194. begin
  195. Compiler.ExitCode:=AValue;
  196. end;
  197. procedure TCustomTestCLI.SetWorkDir(const AValue: string);
  198. var
  199. NewValue: String;
  200. begin
  201. NewValue:=IncludeTrailingPathDelimiter(ExpandFileNamePJ(ResolveDots(AValue)));
  202. if FWorkDir=NewValue then Exit;
  203. FWorkDir:=NewValue;
  204. end;
  205. procedure TCustomTestCLI.SetUp;
  206. begin
  207. {$IFDEF EnablePasTreeGlobalRefCount}
  208. FElementRefCountAtSetup:=TPasElement.GlobalRefCount;
  209. {$ENDIF}
  210. inherited SetUp;
  211. FDefaultFileAge:=DateTimeToFileDate(Now);
  212. WorkDir:=ExtractFilePath(ParamStr(0));
  213. {$IFDEF Windows}
  214. CompilerExe:='P:\bin\pas2js.exe';
  215. {$ELSE}
  216. CompilerExe:='/usr/bin/pas2js';
  217. {$ENDIF}
  218. FCompiler:=TTestCompiler.Create;
  219. //FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
  220. Compiler.Log.OnLog:=@DoLog;
  221. Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
  222. Compiler.FileCache.OnReadFile:=@OnReadFile;
  223. Compiler.FileCache.OnWriteFile:=@OnWriteFile;
  224. end;
  225. procedure TCustomTestCLI.TearDown;
  226. {$IFDEF CheckPasTreeRefCount}
  227. var
  228. El: TPasElement;
  229. i: integer;
  230. {$ENDIF}
  231. begin
  232. FreeAndNil(FCompiler);
  233. FParams.Clear;
  234. FFiles.Clear;
  235. FLogMsgs.Clear;
  236. FErrorMsg:='';
  237. FErrorFile:='';
  238. FErrorLine:=0;
  239. FErrorCol:=0;
  240. FErrorNumber:=0;
  241. inherited TearDown;
  242. {$IFDEF EnablePasTreeGlobalRefCount}
  243. if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
  244. begin
  245. writeln('TCustomTestCLI.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  246. {$IFDEF CheckPasTreeRefCount}
  247. El:=TPasElement.FirstRefEl;
  248. while El<>nil do
  249. begin
  250. writeln(' ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
  251. for i:=0 to El.RefIds.Count-1 do
  252. writeln(' ',El.RefIds[i]);
  253. El:=El.NextRefEl;
  254. end;
  255. {$ENDIF}
  256. Halt;
  257. Fail('TCustomTestCLI.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
  258. end;
  259. {$ENDIF}
  260. end;
  261. procedure TCustomTestCLI.DoLog(Sender: TObject; const Msg: String);
  262. var
  263. LogMsg: TCLILogMsg;
  264. begin
  265. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  266. writeln('TCustomTestCLI.DoLog ',Msg,' File=',Compiler.Log.LastMsgFile,' Line=',Compiler.Log.LastMsgLine);
  267. {$ENDIF}
  268. LogMsg:=TCLILogMsg.Create;
  269. LogMsg.Msg:=Msg;
  270. LogMsg.MsgTxt:=Compiler.Log.LastMsgTxt;
  271. LogMsg.MsgType:=Compiler.Log.LastMsgType;
  272. LogMsg.MsgFile:=Compiler.Log.LastMsgFile;
  273. LogMsg.MsgLine:=Compiler.Log.LastMsgLine;
  274. LogMsg.MsgCol:=Compiler.Log.LastMsgCol;
  275. LogMsg.MsgNumber:=Compiler.Log.LastMsgNumber;
  276. FLogMsgs.Add(LogMsg);
  277. if (LogMsg.MsgType<=mtError) then
  278. begin
  279. if (ErrorFile='')
  280. or ((ErrorLine<1) and (LogMsg.MsgLine>0)) then
  281. begin
  282. ErrorMsg:=LogMsg.MsgTxt;
  283. ErrorFile:=LogMsg.MsgFile;
  284. ErrorLine:=LogMsg.MsgLine;
  285. ErrorCol:=LogMsg.MsgCol;
  286. end;
  287. end;
  288. end;
  289. function TCustomTestCLI.OnReadDirectory(Dir: TPas2jsCachedDirectory): boolean;
  290. var
  291. i: Integer;
  292. aFile: TCLIFile;
  293. Path: String;
  294. begin
  295. Path:=Dir.Path;
  296. //writeln('TCustomTestCLI.ReadDirectory START ',Path,' ',Dir.Count);
  297. Dir.Add('.',DefaultFileAge,faDirectory,4096);
  298. Dir.Add('..',DefaultFileAge,faDirectory,4096);
  299. for i:=0 to FileCount-1 do
  300. begin
  301. aFile:=Files[i];
  302. if CompareFilenames(ExtractFilePath(aFile.Filename),Path)<>0 then continue;
  303. //writeln('TCustomTestCLI.ReadDirectory ',aFile.Filename);
  304. Dir.Add(ExtractFileName(aFile.Filename),aFile.Age,aFile.Attr,length(aFile.Source));
  305. end;
  306. //writeln('TCustomTestCLI.ReadDirectory END ',Path,' ',Dir.Count);
  307. Result:=true;
  308. end;
  309. function TCustomTestCLI.OnReadFile(aFilename: string; var aSource: string
  310. ): boolean;
  311. var
  312. aFile: TCLIFile;
  313. begin
  314. aFile:=FindFile(aFilename);
  315. //writeln('TCustomTestCLI.ReadFile ',aFilename,' Found=',aFile<>nil);
  316. if aFile=nil then exit(false);
  317. if (faDirectory and aFile.Attr)>0 then
  318. begin
  319. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  320. writeln('[20180224000557] TCustomTestCLI.OnReadFile ',aFilename);
  321. {$ENDIF}
  322. EPas2jsFileCache.Create('TCustomTestCLI.OnReadFile: reading directory '+aFilename);
  323. end;
  324. aSource:=aFile.Source;
  325. //writeln('TCustomTestCLI.OnReadFile ',aFile.Filename,' "',LeftStr(aFile.Source,50),'"');
  326. Result:=true;
  327. end;
  328. procedure TCustomTestCLI.OnWriteFile(aFilename: string; Source: string);
  329. var
  330. aFile: TCLIFile;
  331. s: String;
  332. i: Integer;
  333. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  334. //i: Integer;
  335. {$ENDIF}
  336. begin
  337. aFile:=FindFile(aFilename);
  338. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  339. writeln('TCustomTestCLI.WriteFile ',aFilename,' Found=',aFile<>nil,' SrcLen=',length(Source));
  340. {$ENDIF}
  341. if aFile<>nil then
  342. begin
  343. if (faDirectory and aFile.Attr)>0 then
  344. begin
  345. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  346. writeln('[20180223175616] TCustomTestCLI.OnWriteFile ',aFilename);
  347. {$ENDIF}
  348. raise EPas2jsFileCache.Create('unable to write file to directory "'+aFilename+'"');
  349. end;
  350. end else
  351. begin
  352. {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
  353. //writeln('TCustomTestCLI.OnWriteFile FFiles: ',FFiles.Count);
  354. //for i:=0 to FFiles.Count-1 do
  355. //begin
  356. // aFile:=TCLIFile(FFiles[i]);
  357. // writeln(' ',i,': Filename=',aFile.Filename,' ',CompareFilenames(aFile.Filename,aFilename),' Dir=',(aFile.Attr and faDirectory)>0,' Len=',length(aFile.Source));
  358. //end;
  359. {$ENDIF}
  360. aFile:=TCLIFile.Create(aFilename,'',0,0);
  361. FFiles.Add(aFile);
  362. end;
  363. aFile.Source:=Source;
  364. aFile.Attr:=faNormal;
  365. aFile.Age:=DateTimeToFileDate(CurDate);
  366. s:=LeftStr(aFile.Source,50);
  367. for i:=1 to length(s) do
  368. if not (s[i] in [#9..#10,#13,' '..#126]) then
  369. begin
  370. s:='<BINARY>';
  371. break;
  372. end;
  373. writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',s,'" ');
  374. //writeln('TCustomTestCLI.OnWriteFile ',aFile.Source);
  375. end;
  376. procedure TCustomTestCLI.WriteSources;
  377. var
  378. i, j, aRow, aCol: Integer;
  379. aFile: TCLIFile;
  380. SrcLines: TStringList;
  381. Line, aFilename: String;
  382. IsSrc: Boolean;
  383. begin
  384. writeln('TCustomTestCLI.WriteSources START');
  385. aFilename:=ErrorFile;
  386. aRow:=ErrorLine;
  387. aCol:=ErrorCol;
  388. SrcLines:=TStringList.Create;
  389. try
  390. for i:=0 to FileCount-1 do
  391. begin
  392. aFile:=Files[i];
  393. if (faDirectory and aFile.Attr)>0 then continue;
  394. writeln('Testcode:-File="',aFile.Filename,'"----------------------------------:');
  395. SrcLines.Text:=aFile.Source;
  396. IsSrc:=ExtractFilename(aFile.Filename)=ExtractFileName(aFilename);
  397. for j:=1 to SrcLines.Count do
  398. begin
  399. Line:=SrcLines[j-1];
  400. if IsSrc and (j=aRow) then
  401. begin
  402. write('*');
  403. Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
  404. end;
  405. writeln(Format('%:4d: ',[j]),Line);
  406. end;
  407. end;
  408. finally
  409. SrcLines.Free;
  410. end;
  411. end;
  412. procedure TCustomTestCLI.CheckDiff(Msg, Expected, Actual: string);
  413. // search diff, ignore changes in spaces
  414. var
  415. s: string;
  416. begin
  417. if CheckSrcDiff(Expected,Actual,s) then exit;
  418. Fail(Msg+': '+s);
  419. end;
  420. constructor TCustomTestCLI.Create;
  421. begin
  422. inherited Create;
  423. FFiles:=TObjectList.Create(true);
  424. FLogMsgs:=TObjectList.Create(true);
  425. FParams:=TStringList.Create;
  426. CurDate:=Now;
  427. end;
  428. destructor TCustomTestCLI.Destroy;
  429. begin
  430. FreeAndNil(FFiles);
  431. FreeAndNil(FLogMsgs);
  432. FreeAndNil(FParams);
  433. inherited Destroy;
  434. end;
  435. procedure TCustomTestCLI.Compile(const Args: array of string;
  436. ExpectedExitCode: longint);
  437. var
  438. i: Integer;
  439. begin
  440. AssertEquals('Initial System.ExitCode',0,system.ExitCode);
  441. for i:=low(Args) to High(Args) do
  442. Params.Add(Args[i]);
  443. try
  444. try
  445. //writeln('TCustomTestCLI.Compile WorkDir=',WorkDir);
  446. Compiler.Run(CompilerExe,WorkDir,Params,true);
  447. except
  448. on E: ECompilerTerminate do
  449. begin
  450. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  451. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  452. {$ENDIF}
  453. end;
  454. on E: Exception do
  455. begin
  456. {$IF defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
  457. writeln('TCustomTestCLI.Compile ',E.ClassName,':',E.Message);
  458. {$ENDIF}
  459. Fail('TCustomTestCLI.Compile '+E.ClassName+':'+E.Message);
  460. end;
  461. end;
  462. finally
  463. Compiler.Log.CloseOutputFile;
  464. end;
  465. if ExpectedExitCode<>ExitCode then
  466. begin
  467. WriteSources;
  468. AssertEquals('ExitCode',ExpectedExitCode,ExitCode);
  469. end;
  470. end;
  471. function TCustomTestCLI.FileCount: integer;
  472. begin
  473. Result:=FFiles.Count;
  474. end;
  475. function TCustomTestCLI.FindFile(Filename: string): TCLIFile;
  476. var
  477. i: Integer;
  478. begin
  479. Filename:=ExpandFilename(Filename);
  480. for i:=0 to FileCount-1 do
  481. if CompareFilenames(Files[i].Filename,Filename)=0 then
  482. exit(Files[i]);
  483. Result:=nil;
  484. end;
  485. function TCustomTestCLI.ExpandFilename(const Filename: string): string;
  486. begin
  487. Result:=SetDirSeparators(Filename);
  488. if not FilenameIsAbsolute(Result) then
  489. Result:=WorkDir+Result;
  490. Result:=ResolveDots(Result);
  491. end;
  492. function TCustomTestCLI.AddFile(Filename, Source: string): TCLIFile;
  493. begin
  494. Filename:=ExpandFilename(Filename);
  495. {$IFDEF VerbosePCUFiler}
  496. writeln('TCustomTestCLI.AddFile ',Filename);
  497. {$ENDIF}
  498. Result:=FindFile(Filename);
  499. if Result<>nil then
  500. raise Exception.Create('[20180224001050] TCustomTestCLI.AddFile already exists: '+Filename);
  501. Result:=TCLIFile.Create(Filename,Source,DefaultFileAge,faNormal);
  502. FFiles.Add(Result);
  503. AddDir(ExtractFilePath(Filename));
  504. end;
  505. function TCustomTestCLI.AddFile(Filename: string;
  506. const SourceLines: array of string): TCLIFile;
  507. begin
  508. Result:=AddFile(Filename,LinesToStr(SourceLines));
  509. end;
  510. function TCustomTestCLI.AddUnit(Filename: string; const Intf,
  511. Impl: array of string): TCLIFile;
  512. var
  513. Name: String;
  514. begin
  515. Name:=ExtractFilenameOnly(Filename);
  516. Result:=AddFile(Filename,
  517. 'unit '+Name+';'+LineEnding
  518. +'interface'+LineEnding
  519. +LinesToStr(Intf)
  520. +'implementation'+LineEnding
  521. +LinesToStr(Impl)
  522. +'end.'+LineEnding);
  523. end;
  524. function TCustomTestCLI.AddDir(Filename: string): TCLIFile;
  525. var
  526. p: Integer;
  527. Dir: String;
  528. aFile: TCLIFile;
  529. begin
  530. Result:=nil;
  531. Filename:=IncludeTrailingPathDelimiter(ExpandFilename(Filename));
  532. p:=length(Filename);
  533. while p>1 do
  534. begin
  535. if Filename[p]=PathDelim then
  536. begin
  537. Dir:=LeftStr(Filename,p-1);
  538. aFile:=FindFile(Dir);
  539. if Result=nil then
  540. Result:=aFile;
  541. if aFile=nil then
  542. begin
  543. {$IFDEF VerbosePCUFiler}
  544. writeln('TCustomTestCLI.AddDir add Dir=',Dir);
  545. {$ENDIF}
  546. FFiles.Add(TCLIFile.Create(Dir,'',DefaultFileAge,faDirectory));
  547. end
  548. else if (aFile.Attr and faDirectory)=0 then
  549. begin
  550. {$IFDEF VerbosePCUFiler}
  551. writeln('[20180224001036] TCustomTestCLI.AddDir file exists: Dir=',Dir);
  552. {$ENDIF}
  553. raise EPas2jsFileCache.Create('[20180224001036] TCustomTestCLI.AddDir Dir='+Dir);
  554. end;
  555. dec(p);
  556. end else
  557. dec(p);
  558. end;
  559. end;
  560. procedure TCustomTestCLI.AssertFileExists(Filename: string);
  561. var
  562. aFile: TCLIFile;
  563. begin
  564. aFile:=FindFile(Filename);
  565. AssertNotNull('File not found: '+Filename,aFile);
  566. end;
  567. function TCustomTestCLI.GetLogCount: integer;
  568. begin
  569. Result:=FLogMsgs.Count;
  570. end;
  571. { TTestCLI_UnitSearch }
  572. procedure TTestCLI_UnitSearch.CheckLinklibProgramSrc(Msg, Header: string);
  573. var
  574. aFile: TCLIFile;
  575. begin
  576. aFile:=FindFile('test1.js');
  577. if aFile=nil then
  578. Fail(Msg+' file not found test1.js');
  579. CheckDiff(Msg,
  580. LinesToStr([
  581. #$EF#$BB#$BF+Header,
  582. 'rtl.module("program",["system"],function () {',
  583. ' "use strict";',
  584. ' var $mod = this;',
  585. ' $mod.$main = function () {',
  586. ' };',
  587. '});',
  588. 'rtl.run();',
  589. '',
  590. '']),
  591. aFile.Source);
  592. end;
  593. procedure TTestCLI_UnitSearch.CheckFullSource(Msg, Filename, ExpectedSrc: string
  594. );
  595. var
  596. aFile: TCLIFile;
  597. begin
  598. aFile:=FindFile(Filename);
  599. if aFile=nil then
  600. Fail(Msg+' file not found "'+Filename+'"');
  601. CheckDiff(Msg,ExpectedSrc,aFile.Source);
  602. end;
  603. procedure TTestCLI_UnitSearch.TestUS_CreateRelativePath;
  604. procedure DoTest(Filename, BaseDirectory, Expected: string;
  605. UsePointDirectory: boolean = false);
  606. var
  607. Actual: String;
  608. begin
  609. ForcePathDelims(Filename);
  610. ForcePathDelims(BaseDirectory);
  611. ForcePathDelims(Expected);
  612. if not TryCreateRelativePath(Filename,BaseDirectory,UsePointDirectory,true,Actual) then
  613. Actual:=Filename;
  614. AssertEquals('TryCreateRelativePath(File='+Filename+',Base='+BaseDirectory+')',
  615. Expected,Actual);
  616. end;
  617. begin
  618. DoTest('/a','/a','');
  619. DoTest('/a','/a','.',true);
  620. DoTest('/a','/a/','');
  621. DoTest('/a/b','/a/b','');
  622. DoTest('/a/b','/a/b/','');
  623. DoTest('/a','/a/','');
  624. DoTest('/a','','/a');
  625. DoTest('/a/b','/a','b');
  626. DoTest('/a/b','/a/','b');
  627. DoTest('/a/b','/a//','b');
  628. DoTest('/a','/a/b','..');
  629. DoTest('/a','/a/b/','..');
  630. DoTest('/a','/a/b//','..');
  631. DoTest('/a/','/a/b','..');
  632. DoTest('/a','/a/b/c','../..');
  633. DoTest('/a','/a/b//c','../..');
  634. DoTest('/a','/a//b/c','../..');
  635. DoTest('/a','/a//b/c/','../..');
  636. DoTest('/a','/b','/a');
  637. DoTest('~/bin','/','~/bin');
  638. DoTest('$(HOME)/bin','/','$(HOME)/bin');
  639. {$IFDEF MSWindows}
  640. DoTest('D:\a\b\c.pas','D:\a\d\','..\b\c.pas');
  641. {$ENDIF}
  642. end;
  643. procedure TTestCLI_UnitSearch.TestUS_Program;
  644. begin
  645. AddUnit('system.pp',[''],['']);
  646. AddFile('test1.pas',[
  647. 'begin',
  648. 'end.']);
  649. Compile(['test1.pas','-va']);
  650. AssertNotNull('test1.js not found',FindFile('test1.js'));
  651. end;
  652. procedure TTestCLI_UnitSearch.TestUS_UsesEmptyFileFail;
  653. begin
  654. AddFile('system.pp','');
  655. AddFile('test1.pas',[
  656. 'begin',
  657. 'end.']);
  658. Compile(['test1.pas'],ExitCodeSyntaxError);
  659. AssertEquals('ErrorMsg','Expected "unit"',ErrorMsg);
  660. end;
  661. procedure TTestCLI_UnitSearch.TestUS_Program_o;
  662. begin
  663. AddUnit('system.pp',[''],['']);
  664. AddFile('test1.pas',[
  665. 'begin',
  666. 'end.']);
  667. Compile(['test1.pas','-obla.js']);
  668. AssertNotNull('bla.js not found',FindFile('bla.js'));
  669. end;
  670. procedure TTestCLI_UnitSearch.TestUS_Program_FU;
  671. begin
  672. AddUnit('system.pp',[''],['']);
  673. AddFile('test1.pas',[
  674. 'begin',
  675. 'end.']);
  676. AddDir('lib');
  677. Compile(['test1.pas','-FUlib']);
  678. AssertNotNull('lib/test1.js not found',FindFile('lib/test1.js'));
  679. end;
  680. procedure TTestCLI_UnitSearch.TestUS_Program_FU_o;
  681. begin
  682. AddUnit('system.pp',[''],['']);
  683. AddFile('test1.pas',[
  684. 'begin',
  685. 'end.']);
  686. AddDir('lib');
  687. Compile(['test1.pas','-FUlib','-ofoo.js']);
  688. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  689. AssertNotNull('foo.js not found',FindFile('foo.js'));
  690. end;
  691. procedure TTestCLI_UnitSearch.TestUS_Program_FE_o;
  692. begin
  693. AddUnit('system.pp',[''],['']);
  694. AddFile('test1.pas',[
  695. 'begin',
  696. 'end.']);
  697. AddDir('lib');
  698. Compile(['test1.pas','-FElib','-ofoo.js']);
  699. AssertNotNull('lib/system.js not found',FindFile('lib/system.js'));
  700. AssertNotNull('foo.js not found',FindFile('foo.js'));
  701. end;
  702. procedure TTestCLI_UnitSearch.TestUS_PlatformModule_Program;
  703. begin
  704. AddUnit('system.pp',[''],['']);
  705. AddFile('test1.pas',[
  706. 'begin',
  707. 'end.']);
  708. Compile(['-Tmodule','-va','test1.pas']);
  709. CheckFullSource('TestUS_PlatformModule_Library','test1.js',
  710. LinesToStr([
  711. #$EF#$BB#$BF+'rtl.module("program",["system"],function () {',
  712. ' "use strict";',
  713. ' var $mod = this;',
  714. ' $mod.$main = function () {',
  715. ' };',
  716. '});',
  717. 'rtl.run();',
  718. '']));
  719. end;
  720. procedure TTestCLI_UnitSearch.TestUS_IncludeSameDir;
  721. begin
  722. AddUnit('system.pp',[''],['']);
  723. AddFile('sub/defines.inc',[
  724. '{$Define foo}',
  725. '']);
  726. AddUnit('sub/unit1.pas',
  727. ['{$I defines.inc}',
  728. '{$ifdef foo}',
  729. 'var a: longint;',
  730. '{$endif}'],
  731. ['']);
  732. AddFile('test1.pas',[
  733. 'uses unit1;',
  734. 'begin',
  735. ' a:=3;',
  736. 'end.']);
  737. AddDir('lib');
  738. Compile(['test1.pas','-Fusub','-FElib','-ofoo.js']);
  739. end;
  740. procedure TTestCLI_UnitSearch.TestUS_Include_NestedDelphi;
  741. begin
  742. AddUnit('system.pp',[''],['']);
  743. AddFile('sub/inc1.inc',[
  744. 'type number = longint;',
  745. '{$I sub/deep/inc2.inc}',
  746. '']);
  747. AddFile('sub/deep/inc2.inc',[
  748. 'type numero = number;',
  749. '{$I sub/inc3.inc}',
  750. '']);
  751. AddFile('sub/inc3.inc',[
  752. 'type nummer = numero;',
  753. '']);
  754. AddFile('test1.pas',[
  755. '{$mode delphi}',
  756. '{$i sub/inc1.inc}',
  757. 'var',
  758. ' n: nummer;',
  759. 'begin',
  760. 'end.']);
  761. Compile(['test1.pas','-Jc']);
  762. end;
  763. procedure TTestCLI_UnitSearch.TestUS_Include_NestedObjFPC;
  764. begin
  765. AddUnit('system.pp',[''],['']);
  766. AddFile('sub/inc1.inc',[
  767. 'type number = longint;',
  768. '{$I deep/inc2.inc}',
  769. '']);
  770. AddFile('sub/deep/inc2.inc',[
  771. 'type numero = number;',
  772. '{$I ../inc3.inc}',
  773. '']);
  774. AddFile('sub/inc3.inc',[
  775. 'type nummer = numero;',
  776. '']);
  777. AddFile('test1.pas',[
  778. '{$mode objfpc}',
  779. '{$i sub/inc1.inc}',
  780. 'var',
  781. ' n: nummer;',
  782. 'begin',
  783. 'end.']);
  784. Compile(['test1.pas','-Jc']);
  785. end;
  786. procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
  787. begin
  788. AddUnit('system.pp',[''],['']);
  789. AddUnit('unit1.pas',
  790. ['uses bird in ''unit2.pas'';',
  791. 'var a: longint;'],
  792. ['']);
  793. AddUnit('unit2.pas',
  794. ['var b: longint;'],
  795. ['']);
  796. AddFile('test1.pas',[
  797. 'uses foo in ''unit1.pas'', bar in ''unit2.pas'';',
  798. 'begin',
  799. ' bar.b:=foo.a;',
  800. ' a:=b;',
  801. 'end.']);
  802. Compile(['test1.pas','-Jc']);
  803. end;
  804. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_Duplicate;
  805. begin
  806. // check if using two different units with same name
  807. AddUnit('system.pp',[''],['']);
  808. AddUnit('unit1.pas',
  809. ['var a: longint;'],
  810. ['']);
  811. AddUnit('sub'+PathDelim+'unit1.pas',
  812. ['var b: longint;'],
  813. ['']);
  814. AddFile('test1.pas',[
  815. 'uses foo in ''unit1.pas'', bar in ''sub/unit1.pas'';',
  816. 'begin',
  817. ' bar.b:=foo.a;',
  818. ' a:=b;',
  819. 'end.']);
  820. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  821. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub'+PathDelim+'unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
  822. end;
  823. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
  824. begin
  825. // check if using two different units with same name
  826. AddUnit('system.pp',[''],['']);
  827. AddUnit('unit1.pas',
  828. ['var a: longint;'],
  829. ['']);
  830. AddUnit('sub'+PathDelim+'unit1.pas',
  831. ['var b: longint;'],
  832. ['']);
  833. AddUnit('unit2.pas',
  834. ['uses unit1 in ''unit1.pas'';'],
  835. ['']);
  836. AddFile('test1.pas',[
  837. 'uses unit2, foo in ''sub/unit1.pas'';',
  838. 'begin',
  839. 'end.']);
  840. Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
  841. AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub'+PathDelim+'unit1.pas"',ErrorMsg);
  842. end;
  843. procedure TTestCLI_UnitSearch.TestUS_UsesInFile_WorkNotEqProgDir;
  844. begin
  845. AddUnit('system.pp',[''],['']);
  846. AddUnit('sub/unit2.pas',
  847. ['var a: longint;'],
  848. ['']);
  849. AddUnit('sub/unit1.pas',
  850. ['uses unit2;'],
  851. ['']);
  852. AddFile('sub/test1.pas',[
  853. 'uses foo in ''unit1.pas'';',
  854. 'begin',
  855. 'end.']);
  856. Compile(['sub/test1.pas','-Jc']);
  857. end;
  858. procedure TTestCLI_UnitSearch.TestUS_UsesInFileTwice;
  859. begin
  860. AddUnit('system.pp',[''],['']);
  861. AddUnit('unit1.pas',
  862. ['var a: longint;'],
  863. ['']);
  864. AddFile('test1.pas',[
  865. 'uses foo in ''unit1.pas'', bar in ''unit1.pas'';',
  866. 'begin',
  867. ' bar.a:=foo.a;',
  868. ' a:=a;',
  869. 'end.']);
  870. Compile(['test1.pas','-Jc']);
  871. end;
  872. procedure TTestCLI_UnitSearch.TestUS_UseUnitTwiceFail;
  873. begin
  874. AddUnit('system.pp',[''],['']);
  875. AddUnit('sub.unit1.pas',
  876. ['var a: longint;'],
  877. ['']);
  878. AddFile('test1.pas',[
  879. 'uses sub.Unit1, sub.unit1;',
  880. 'begin',
  881. ' a:=a;',
  882. 'end.']);
  883. Compile(['test1.pas','-FNsub','-Jc'],ExitCodeSyntaxError);
  884. AssertEquals('ErrorMsg','Duplicate identifier "sub.unit1"',ErrorMsg);
  885. end;
  886. procedure TTestCLI_UnitSearch.TestUS_UseUnitTwiceViaNameSpace;
  887. begin
  888. AddUnit('system.pp',[''],['']);
  889. AddUnit('sub.unit1.pas',
  890. ['var a: longint;'],
  891. ['']);
  892. AddFile('test1.pas',[
  893. 'uses unit1, sub.unit1;',
  894. 'begin',
  895. ' unit1.a:=sub.unit1.a;',
  896. ' a:=a;',
  897. 'end.']);
  898. Compile(['test1.pas','-FNsub','-Jc']);
  899. end;
  900. procedure TTestCLI_UnitSearch.TestUS_DefaultNameSpaceLast;
  901. begin
  902. AddUnit('system.pp',[''],['']);
  903. AddUnit('Unit2.pas',
  904. ['var i: longint;'],
  905. ['']);
  906. AddUnit('NS1.Unit2.pas',
  907. ['var j: longint;'],
  908. ['']);
  909. AddFile('test1.pas',[
  910. 'uses unIt2;',
  911. 'var',
  912. ' k: longint;',
  913. 'begin',
  914. ' k:=i;',
  915. 'end.']);
  916. Compile(['test1.pas','','-Jc']);
  917. end;
  918. procedure TTestCLI_UnitSearch.TestUS_DefaultNameSpaceAfterNameSpace;
  919. begin
  920. AddUnit('system.pp',[''],['']);
  921. AddUnit('prg.Unit2.pas',
  922. ['var j: longint;'],
  923. ['']);
  924. AddUnit('sub.Unit2.pas',
  925. ['var i: longint;'],
  926. ['']);
  927. AddFile('prg.test1.pas',[
  928. 'uses unIt2;',
  929. 'var',
  930. ' k: longint;',
  931. 'begin',
  932. ' k:=i;',
  933. 'end.']);
  934. Compile(['prg.test1.pas','-FNsub','-Jc']);
  935. end;
  936. procedure TTestCLI_UnitSearch.TestUS_NoNameSpaceBeforeDefaultNameSpace;
  937. begin
  938. AddUnit('system.pp',[''],['']);
  939. AddUnit('prg.Unit2.pas',
  940. ['var j: longint;'],
  941. ['']);
  942. AddUnit('Unit2.pas',
  943. ['var i: longint;'],
  944. ['']);
  945. AddFile('prg.test1.pas',[
  946. 'uses unIt2;',
  947. 'var',
  948. ' k: longint;',
  949. 'begin',
  950. ' k:=i;',
  951. 'end.']);
  952. Compile(['prg.test1.pas','','-Jc']);
  953. end;
  954. procedure TTestCLI_UnitSearch.TestUS_NoNameSpaceAndDefaultNameSpace;
  955. begin
  956. AddUnit('system.pp',[''],['']);
  957. AddUnit('UnitA.pas',
  958. ['type TBool = boolean;'],
  959. ['']);
  960. AddUnit('ThirdParty.UnitB.pas',
  961. ['uses UnitA;',
  962. 'type TAlias = TBool;'],
  963. ['']);
  964. AddUnit('MyProject.UnitA.pas',
  965. [
  966. 'uses ThirdParty.UnitB;',
  967. 'var a: TAlias;'],
  968. ['']);
  969. AddFile('MyProject.Main.pas',[
  970. 'uses MyProject.UnitA;',
  971. 'var',
  972. ' b: boolean;',
  973. 'begin',
  974. ' b:=a;',
  975. 'end.']);
  976. Compile(['MyProject.Main.pas','','-Jc']);
  977. end;
  978. procedure TTestCLI_UnitSearch.TestUS_ProgramLinklib;
  979. begin
  980. AddUnit('system.pp',[''],['']);
  981. AddFile('test1.pas',[
  982. '{$linklib Bird}',
  983. 'begin',
  984. 'end.']);
  985. Compile(['-Tnodejs','-va','test1.pas']);
  986. CheckLinklibProgramSrc('TestUS_ProgramLinklib',
  987. LinesToStr([
  988. 'import * as bird from "Bird.js";',
  989. 'pas.$libimports.bird = bird;']));
  990. end;
  991. procedure TTestCLI_UnitSearch.TestUS_UnitLinklib;
  992. begin
  993. AddUnit('system.pp',[''],['']);
  994. AddUnit('UnitB.pas',
  995. ['{$linklib Bird Thunderbird}',
  996. ''],
  997. ['']);
  998. AddFile('test1.pas',[
  999. 'uses UnitB;',
  1000. 'begin',
  1001. 'end.']);
  1002. Compile(['-Tnodejs','-va','test1.pas']);
  1003. CheckLinklibProgramSrc('TestUS_UnitLinklib',
  1004. LinesToStr([
  1005. 'import * as Thunderbird from "Bird.js";',
  1006. 'pas.$libimports.Thunderbird = Thunderbird;']));
  1007. end;
  1008. Initialization
  1009. RegisterTests([TTestCLI_UnitSearch]);
  1010. end.