tcunitsearch.pas 28 KB

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