tcunitsearch.pas 25 KB

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