tcunitsearch.pas 26 KB

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