1{ 2 This file is part of the Free Component Library (FCL) 3 Copyright (c) 2018 Mattias Gaertner mattias@freepascal.org 4 5 Pascal to Javascript converter class. 6 7 See the file COPYING.FPC, included in this distribution, 8 for details about the copyright. 9 10 This program is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 13 14 ********************************************************************** 15 16 Abstract: 17 TPas2jsFileResolver extends TFileResolver and searches source files. 18} 19unit Pas2jsFileCache; 20 21{$mode objfpc}{$H+} 22 23{$i pas2js_defines.inc} 24 25interface 26 27uses 28 {$IFDEF Pas2js} 29 {$IFDEF NodeJS} 30 JS, node.fs, 31 {$ENDIF} 32 {$ENDIF} 33 Classes, SysUtils, 34 fpjson, 35 PScanner, PasResolver, PasUseAnalyzer, 36 Pas2jsLogger, Pas2jsFileUtils, Pas2JSFS; 37 38 39type 40 EPas2jsFileCache = class(EPas2JSFS); 41 42type 43 TPas2jsFileAgeTime = longint; 44 TPas2jsFileAttr = longint; 45 TPas2jsFileSize = TMaxPrecInt; 46 TPas2jsSearchFileCase = ( 47 sfcDefault, 48 sfcCaseSensitive, 49 sfcCaseInsensitive 50 ); 51 52 TPas2jsCachedDirectories = class; 53 54 TPas2jsCachedDirectoryEntry = class 55 public 56 Name: string; 57 Time: TPas2jsFileAgeTime; // modification time 58 Attr: TPas2jsFileAttr; 59 Size: TPas2jsFileSize; 60 end; 61 62 { TPas2jsCachedDirectory } 63 64 TPas2jsCachedDirectory = class 65 private 66 FChangeStamp: TChangeStamp; 67 FPath: string; 68 FEntries: TFPList; // list of TPas2jsCachedDirectoryEntry 69 FPool: TPas2jsCachedDirectories; 70 FRefCount: integer; 71 FSorted: boolean; 72 function GetEntries(Index: integer): TPas2jsCachedDirectoryEntry; inline; 73 procedure SetSorted(const AValue: boolean); 74 protected 75 procedure DoReadDir; virtual; 76 public 77 constructor Create(aPath: string; aPool: TPas2jsCachedDirectories); 78 destructor Destroy; override; 79 function Count: integer; 80 procedure Clear; 81 property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp 82 function NeedsUpdate: boolean; 83 procedure Update; 84 procedure Reference; 85 procedure Release; 86 property RefCount: integer read FRefCount; 87 function Add(const Name: string; Time: TPas2jsFileAgeTime; 88 Attr: TPas2jsFileAttr; Size: TPas2jsFileSize): TPas2jsCachedDirectoryEntry; 89 function FindFile(const ShortFilename: string; 90 const FileCase: TPas2jsSearchFileCase): string; 91 function FileAge(const ShortFilename: string): TPas2jsFileAgeTime; 92 function FileAttr(const ShortFilename: string): TPas2jsFileAttr; 93 function FileSize(const ShortFilename: string): TPas2jsFileSize; 94 function IndexOfFileCaseInsensitive(const ShortFilename: String): integer; 95 function IndexOfFileCaseSensitive(const ShortFilename: String): integer; 96 function IndexOfFile(const ShortFilename: String): integer; inline; 97 function CountSameNamesCaseInsensitive(Index: integer): integer; 98 procedure GetSameNamesCaseInsensitive(Index: integer; List: TStrings); 99 property Entries[Index: integer]: TPas2jsCachedDirectoryEntry read GetEntries; default; 100 procedure GetFiles(var Files: TStrings; 101 IncludeDirs: boolean = true // add faDirectory as well 102 ); // returns relative file names 103 procedure CheckConsistency; 104 procedure WriteDebugReport; 105 property Path: string read FPath; // with trailing path delimiter 106 property Pool: TPas2jsCachedDirectories read FPool; 107 property Sorted: boolean read FSorted write SetSorted; // descending, sort first case insensitive, then sensitive 108 end; 109 110 TReadDirectoryEvent = function(Dir: TPas2jsCachedDirectory): boolean of object;// true = skip default function 111 112 { TPas2jsCachedDirectories } 113 114 TPas2jsCachedDirectories = class 115 private 116 FChangeStamp: TChangeStamp; 117 FDirectories: TPasAnalyzerKeySet;// set of TPas2jsCachedDirectory, key is Directory 118 FWorkingDirectory: string; 119 private 120 FOnReadDirectory: TReadDirectoryEvent; 121 type 122 TFileInfo = record 123 Filename: string; 124 DirPath: string; 125 ShortFilename: string; 126 Dir: TPas2jsCachedDirectory; 127 end; 128 function GetFileInfo(var Info: TFileInfo): boolean; 129 procedure SetWorkingDirectory(const AValue: string); 130 public 131 constructor Create; 132 destructor Destroy; override; 133 property ChangeStamp: TChangeStamp read FChangeStamp; 134 procedure Invalidate; inline; 135 procedure Clear; 136 function DirectoryExists(Filename: string): boolean; 137 function FileExists(Filename: string): boolean; 138 function FileExistsI(var Filename: string): integer; // returns number of found files 139 function FileAge(Filename: string): TPas2jsFileAgeTime; 140 function FileAttr(Filename: string): TPas2jsFileAttr; 141 function FileSize(Filename: string): TPas2jsFileSize; 142 function FindDiskFilename(const Filename: string; 143 {%H-}SearchCaseInsensitive: boolean = false): string; // using Pascal case insensitivity, not UTF-8 144 procedure GetListing(const aDirectory: string; var Files: TStrings; 145 IncludeDirs: boolean = true // add faDirectory as well 146 ); // returns relative file names 147 function GetDirectory(const Directory: string; 148 CreateIfNotExists: boolean = true; 149 DoReference: boolean = true): TPas2jsCachedDirectory; 150 property WorkingDirectory: string read FWorkingDirectory write SetWorkingDirectory; // used for relative filenames, contains trailing path delimiter 151 property OnReadDirectory: TReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory; 152 end; 153 154type 155 TPas2jsFilesCache = class; 156 TPas2jsCachedFile = class; 157 158 { TPas2jsFileResolver } 159 160 TPas2jsFileResolver = class(TPas2JSFSResolver) 161 private 162 function GetCache: TPas2jsFilesCache; 163 public 164 constructor Create(aCache: TPas2jsFilesCache); reintroduce; 165 // Redirect all calls to cache. 166 property Cache: TPas2jsFilesCache read GetCache; 167 end; 168 169 { TPas2jsFileLineReader } 170 171 TPas2jsFileLineReader = class(TSourceLineReader) 172 private 173 FCachedFile: TPas2jsCachedFile; 174 Protected 175 Procedure IncLineNumber; override; 176 property CachedFile: TPas2jsCachedFile read FCachedFile; 177 public 178 constructor Create(const AFilename: string); override; 179 constructor Create(aFile: TPas2jsCachedFile); reintroduce; 180 end; 181 182 { TPas2jsCachedFile } 183 184 TPas2jsCachedFile = class(TPas2JSFile) 185 private 186 FChangeStamp: TChangeStamp; 187 FFileEncoding: string; 188 FLastErrorMsg: string; 189 FLoaded: boolean; 190 FLoadedFileAge: longint; 191 FCacheStamp: TChangeStamp; // Cache.ResetStamp when file was loaded 192 function GetCache: TPas2jsFilesCache; 193 function GetIsBinary: boolean; inline; 194 Protected 195 property IsBinary: boolean read GetIsBinary; 196 property FileEncoding: string read FFileEncoding; 197 property Cache: TPas2jsFilesCache read GetCache; 198 property ChangeStamp: TChangeStamp read FChangeStamp;// changed when Source changed 199 property Loaded: boolean read FLoaded; // Source valid, but may contain an old version 200 property LastErrorMsg: string read FLastErrorMsg; 201 property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true 202 public 203 constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce; 204 function Load(RaiseOnError: boolean; Binary: boolean = false): boolean; override; 205 function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override; 206 end; 207 208 TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object; 209 TPas2jsWriteFileEvent = procedure(aFilename: string; Source: string) of object; 210 211 TPas2jsSearchPathKind = ( 212 spkPath, // e.g. unitpaths, includepaths 213 spkIdentifier // e.g. namespaces, trailing - means remove 214 ); 215 216 { TPas2jsFilesCache } 217 218 TPas2jsFilesCache = class (TPas2JSFS) 219 private 220 FBaseDirectory: string; 221 FDirectoryCache: TPas2jsCachedDirectories; 222 FFiles: TPasAnalyzerKeySet; // set of TPas2jsCachedFile, key is Filename 223 FForeignUnitPaths: TStringList; 224 FForeignUnitPathsFromCmdLine: integer; 225 FIncludePaths: TStringList; 226 FIncludePathsFromCmdLine: integer; 227 FLog: TPas2jsLogger; 228 FOnReadFile: TPas2jsReadFileEvent; 229 FOnWriteFile: TPas2jsWriteFileEvent; 230 FResetStamp: TChangeStamp; 231 FResourcePaths: TStringList; 232 FUnitPaths: TStringList; 233 FUnitPathsFromCmdLine: integer; 234 FPCUPaths: TStringList; 235 function FileExistsILogged(var Filename: string): integer; 236 function FileExistsLogged(const Filename: string): boolean; 237 function GetOnReadDirectory: TReadDirectoryEvent; 238 procedure RegisterMessages; 239 procedure SetBaseDirectory(AValue: string); 240 function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind; 241 FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string; 242 procedure SetOnReadDirectory(AValue: TReadDirectoryEvent); 243 protected 244 function FindSourceFileName(const aFilename: string): String; override; 245 function GetHasPCUSupport: Boolean; virtual; 246 function ReadFile(Filename: string; var Source: string): boolean; virtual; 247 procedure FindMatchingFiles(Mask: string; MaxCount: integer; Files: TStrings);// find files, matching * and ? 248 public 249 constructor Create(aLog: TPas2jsLogger); overload; 250 destructor Destroy; override; 251 procedure Reset; override; 252 procedure WriteFoldersAndSearchPaths; override; 253 procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); override; 254 function PCUExists(var aFileName: string): Boolean; override; 255 Function SameFileName(Const File1,File2 : String) : Boolean; override; 256 Function File1IsNewer(const File1, File2: String): Boolean; override; 257 function SearchLowUpCase(var Filename: string): boolean; 258 function FindCustomJSFileName(const aFilename: string): String; override; 259 function FindUnitJSFileName(const aUnitFilename: string): String; override; 260 function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override; 261 function FindResourceFileName(const aFilename, ModuleDir: string): String; override; 262 function FindIncludeFileName(const aFilename, ModuleDir: string): String; override; 263 function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; 264 function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; 265 function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; 266 function CreateResolver: TPas2jsFSResolver; override; 267 function FormatPath(const aPath: string): string; override; 268 Function DirectoryExists(Const Filename: string): boolean; override; 269 function FileExists(const Filename: string): boolean; override; 270 function FileExistsI(var Filename: string): integer; // returns number of found files 271 function FileAge(const Filename: string): TPas2jsFileAgeTime; virtual; 272 function FindFile(Filename: string): TPas2jsCachedFile; 273 function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; override; 274 function NormalizeFilename(const Filename: string; RaiseOnError: boolean): string; 275 procedure GetListing(const aDirectory: string; var Files: TStrings; 276 FullPaths: boolean = true); 277 procedure RaiseDuplicateFile(aFilename: string); 278 procedure SaveToFile(ms: TFPJSStream; Filename: string); override; 279 function ExpandDirectory(const Filename: string): string; override; 280 function ExpandFileName(const Filename: string): string; override; 281 function ExpandExecutable(const Filename: string): string; override; 282 function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; override; 283 Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override; 284 function TryCreateRelativePath(const Filename, BaseDirectory: String; 285 UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; override; 286 Protected 287 property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache; 288 public 289 property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim 290 property ForeignUnitPaths: TStringList read FForeignUnitPaths; 291 property ResourcePaths : TStringList read FResourcePaths; 292 property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine; 293 property IncludePaths: TStringList read FIncludePaths; 294 property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine; 295 property Log: TPas2jsLogger read FLog; 296 property ResetStamp: TChangeStamp read FResetStamp; 297 property UnitPaths: TStringList read FUnitPaths; 298 property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine; 299 property OnReadDirectory: TReadDirectoryEvent read GetOnReadDirectory write SetOnReadDirectory; 300 property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile; 301 property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile; 302 end; 303 304{$IFDEF Pas2js} 305function PtrStrToStr(StrAsPtr: Pointer): string; 306function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string; 307function Pas2jsCachedFileToKeyName(Item: Pointer): string; 308function Pas2jsCacheDirToKeyName(Item: Pointer): string; 309{$ELSE} 310function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer; 311function CompareCachedFiles(File1, File2: Pointer): integer; 312function ComparePas2jsCacheDirectories(Dir1, Dir2: Pointer): integer; 313function CompareAnsiStringWithDirectoryCache(Path, DirCache: Pointer): integer; 314{$ENDIF} 315function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer; 316function CompareFirstCaseInsThenSensitive(const s, h: string): integer; 317 318{$IFDEF FPC_HAS_CPSTRING} 319// UTF-8 helper functions 320function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string; 321function GuessEncoding(const Src: string): string; 322function HasUTF8BOM(const s: string): boolean; 323function RemoveUTFBOM(const s: string): string; 324{$ENDIF} 325 326implementation 327 328{$IFDEF pas2js} 329function PtrStrToStr(StrAsPtr: Pointer): string; 330var 331 S: String absolute StrAsPtr; 332begin 333 Result:=S; 334end; 335 336function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string; 337var 338 Filename: String absolute FilenameAsPtr; 339begin 340 Result:=FilenameToKey(Filename); 341end; 342 343function Pas2jsCachedFileToKeyName(Item: Pointer): string; 344var 345 aFile: TPas2jsCachedFile absolute Item; 346begin 347 Result:=FilenameToKey(aFile.Filename); 348end; 349 350function Pas2jsCacheDirToKeyName(Item: Pointer): string; 351var 352 Dir: TPas2jsCachedDirectory absolute Item; 353begin 354 Result:=FilenameToKey(Dir.Path); 355end; 356 357{$ELSE} 358function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer; 359var 360 Cache: TPas2jsCachedFile absolute CachedFile; 361begin 362 Result:=CompareFilenames(AnsiString(Filename),Cache.Filename); 363end; 364 365function CompareCachedFiles(File1, File2: Pointer): integer; 366var 367 Cache1: TPas2jsCachedFile absolute File1; 368 Cache2: TPas2jsCachedFile absolute File2; 369begin 370 Result:=CompareFilenames(Cache1.Filename,Cache2.Filename); 371end; 372 373function ComparePas2jsCacheDirectories(Dir1, Dir2: Pointer): integer; 374var 375 Directory1: TPas2jsCachedDirectory absolute Dir1; 376 Directory2: TPas2jsCachedDirectory absolute Dir2; 377begin 378 Result:=CompareFilenames(Directory1.Path,Directory2.Path); 379end; 380 381function CompareAnsiStringWithDirectoryCache(Path, DirCache: Pointer): integer; 382var 383 Directory: TPas2jsCachedDirectory absolute DirCache; 384begin 385 Result:=CompareFilenames(AnsiString(Path),Directory.Path); 386end; 387 388{$ENDIF} 389 390function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer; 391var 392 E1: TPas2jsCachedDirectoryEntry absolute Entry1; 393 E2: TPas2jsCachedDirectoryEntry absolute Entry2; 394begin 395 Result:=CompareFirstCaseInsThenSensitive(E1.Name,E2.Name); 396end; 397 398function CompareFirstCaseInsThenSensitive(const s, h: string): integer; 399begin 400 Result:=CompareText(s,h); 401 if Result<>0 then exit; 402 Result:=CompareStr(s,h); 403end; 404 405{$IFDEF FPC_HAS_CPSTRING} 406function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string; 407var 408 p: PChar; 409 NormSrcEncoding: String; 410begin 411 Result:=Src; 412 if SrcEncoding='' then 413 SrcEncoding:=GuessEncoding(Src); 414 if Result='' then exit; 415 NormSrcEncoding:=NormalizeEncoding(SrcEncoding); 416 if NormSrcEncoding=NormalizeEncoding(EncodingUTF8) then 417 begin 418 p:=PChar(Result); 419 if (p^=#$EF) and (p[1]=#$BB) and (p[2]=#$BF) then 420 begin 421 // cut out UTF-8 BOM 422 Delete(Result,1,3); 423 end; 424 end else if (NormSrcEncoding=EncodingSystem) 425 or (NormSrcEncoding=GetDefaultTextEncoding) then 426 begin 427 Result:=SystemCPToUTF8(Result); 428 end else 429 EPas2jsFileCache.Create('invalid encoding "'+SrcEncoding+'"'); 430end; 431 432function GuessEncoding(const Src: string): string; 433var 434 p: PChar; 435 l: SizeInt; 436 i: Integer; 437begin 438 if Src='' then exit(EncodingUTF8); 439 440 if HasUTF8BOM(Src) then 441 // UTF-8 BOM 442 exit(EncodingUTF8); 443 444 // try UTF-8 (this includes ASCII) 445 l:=length(Src); 446 p:=PChar(Src); 447 repeat 448 if ord(p^)<128 then 449 begin 450 // ASCII 451 if (p^=#0) and (p-PChar(Src)>=l) then 452 exit(EncodingUTF8); 453 inc(p); 454 end else begin 455 i:=UTF8CharacterStrictLength(p); 456 if i=0 then 457 break; 458 inc(p,i); 459 end; 460 until false; 461 462 // check binary 463 p:=PChar(Src); 464 repeat 465 case p^ of 466 #0: 467 if (p-PChar(Src)>=l) then 468 break 469 else 470 exit(EncodingBinary); 471 #1..#8,#11,#14..#31: 472 exit(EncodingBinary); 473 end; 474 inc(p); 475 until false; 476 477 // use system encoding 478 Result:=GetDefaultTextEncoding; 479end; 480 481function HasUTF8BOM(const s: string): boolean; 482var 483 p: PChar; 484begin 485 if s='' then exit(false); 486 p:=PChar(s); 487 Result:=(p^=#$EF) and (p[1]=#$BB) and (p[2]=#$BF); 488end; 489 490function RemoveUTFBOM(const s: string): string; 491begin 492 Result:=s; 493 if not HasUTF8BOM(Result) then exit; 494 Delete(Result,1,3); 495end; 496{$ENDIF} 497 498 499{ TPas2jsCachedDirectory } 500 501// inline 502function TPas2jsCachedDirectory.IndexOfFile(const ShortFilename: String 503 ): integer; 504begin 505 {$IFDEF CaseInsensitiveFilenames} 506 Result:=IndexOfFileCaseInsensitive(ShortFilename); 507 {$ELSE} 508 Result:=IndexOfFileCaseSensitive(ShortFilename); 509 {$ENDIF} 510end; 511 512// inline 513function TPas2jsCachedDirectory.GetEntries(Index: integer 514 ): TPas2jsCachedDirectoryEntry; 515begin 516 Result:=TPas2jsCachedDirectoryEntry(FEntries[Index]); 517end; 518 519// inline 520function TPas2jsCachedDirectory.NeedsUpdate: boolean; 521begin 522 Result:=(Pool.ChangeStamp<>FChangeStamp) or (FChangeStamp=InvalidChangeStamp); 523end; 524 525procedure TPas2jsCachedDirectory.SetSorted(const AValue: boolean); 526begin 527 if FSorted=AValue then Exit; 528 FSorted:=AValue; 529 if not FSorted then exit; 530 FEntries.Sort(@ComparePas2jsDirectoryEntries); // sort descending 531end; 532 533procedure TPas2jsCachedDirectory.DoReadDir; 534var 535 Info: TUnicodeSearchRec; 536begin 537 if Assigned(Pool.OnReadDirectory) then 538 if Pool.OnReadDirectory(Self) then exit; 539 540 // Note: do not add a 'if not DirectoryExists then exit'. 541 // This will not work on automounted directories. You must use FindFirst. 542 if FindFirst(UnicodeString(Path+AllFilesMask),faAnyFile,Info)=0 then 543 begin 544 repeat 545 // check if special file 546 if (Info.Name='.') or (Info.Name='..') or (Info.Name='') 547 then 548 continue; 549 // add file 550 Add(String(Info.Name),Info.Time,Info.Attr,Info.Size); 551 until FindNext(Info)<>0; 552 end; 553 FindClose(Info); 554end; 555 556constructor TPas2jsCachedDirectory.Create(aPath: string; 557 aPool: TPas2jsCachedDirectories); 558begin 559 FRefCount:=1; 560 FPath:=IncludeTrailingPathDelimiter(aPath); 561 FEntries:=TFPList.Create; 562 FPool:=aPool; 563 FChangeStamp:=InvalidChangeStamp; 564end; 565 566destructor TPas2jsCachedDirectory.Destroy; 567begin 568 Clear; 569 FreeAndNil(FEntries); 570 inherited Destroy; 571end; 572 573function TPas2jsCachedDirectory.Count: integer; 574begin 575 Result:=FEntries.Count; 576end; 577 578procedure TPas2jsCachedDirectory.Clear; 579var 580 i: Integer; 581begin 582 for i:=0 to FEntries.Count-1 do 583 TObject(FEntries[i]).{$IFDEF Pas2js}Destroy{$ELSE}Free{$ENDIF}; 584 FEntries.Clear; 585 FSorted:=true; 586end; 587 588procedure TPas2jsCachedDirectory.Update; 589begin 590 if not NeedsUpdate then exit; 591 Clear; 592 DoReadDir; 593 FChangeStamp:=Pool.ChangeStamp; 594 Sorted:=true; 595 {$IFDEF VerbosePas2JSDirCache} 596 writeln('TPas2jsCachedDirectories.Update "',Path,'" Count=',Count); 597 CheckConsistency; 598 {$ENDIF} 599end; 600 601procedure TPas2jsCachedDirectory.Reference; 602begin 603 inc(FRefCount); 604end; 605 606procedure TPas2jsCachedDirectory.Release; 607begin 608 if FRefCount<1 then 609 raise Exception.Create('TPas2jsCachedDirectory.Release [20180126090800] "'+Path+'"'); 610 dec(FRefCount); 611 if FRefCount=0 then Free; 612end; 613 614function TPas2jsCachedDirectory.Add(const Name: string; 615Time: TPas2jsFileAgeTime; Attr: TPas2jsFileAttr; Size: TPas2jsFileSize 616 ): TPas2jsCachedDirectoryEntry; 617begin 618 Result:=TPas2jsCachedDirectoryEntry.Create; 619 Result.Name:=Name; 620 Result.Time:=Time; 621 Result.Attr:=Attr; 622 Result.Size:=Size; 623 FEntries.Add(Result); 624 FSorted:=false; 625end; 626 627function TPas2jsCachedDirectory.FindFile(const ShortFilename: string; 628 const FileCase: TPas2jsSearchFileCase): string; 629var 630 i: Integer; 631begin 632 case FileCase of 633 sfcCaseSensitive: i:=IndexOfFileCaseSensitive(ShortFilename); 634 sfcCaseInsensitive: i:=IndexOfFileCaseInsensitive(ShortFilename); 635 else 636 i:=IndexOfFile(ShortFilename); 637 end; 638 if i>=0 then 639 Result:=Entries[i].Name 640 else 641 Result:=''; 642end; 643 644function TPas2jsCachedDirectory.FileAge(const ShortFilename: string 645 ): TPas2jsFileAgeTime; 646var 647 i: Integer; 648begin 649 i:=IndexOfFile(ShortFilename); 650 if i>=0 then 651 Result:=Entries[i].Time 652 else 653 Result:=-1; 654end; 655 656function TPas2jsCachedDirectory.FileAttr(const ShortFilename: string 657 ): TPas2jsFileAttr; 658var 659 i: Integer; 660begin 661 i:=IndexOfFile(ShortFilename); 662 if i>=0 then 663 Result:=Entries[i].Attr 664 else 665 Result:=0; 666end; 667 668function TPas2jsCachedDirectory.FileSize(const ShortFilename: string 669 ): TPas2jsFileSize; 670var 671 i: Integer; 672begin 673 i:=IndexOfFile(ShortFilename); 674 if i>=0 then 675 Result:=Entries[i].Size 676 else 677 Result:=-1; 678end; 679 680function TPas2jsCachedDirectory.IndexOfFileCaseInsensitive( 681 const ShortFilename: String): integer; 682var 683 l, r, cmp, m: Integer; 684 Entry: TPas2jsCachedDirectoryEntry; 685begin 686 Sorted:=true; 687 l:=0; 688 r:=Count-1; 689 while l<=r do begin 690 m:=(l+r) shr 1; 691 Entry:=Entries[m]; 692 cmp:=CompareText(Entry.Name,ShortFilename); 693 if cmp>0 then 694 r:=m-1 695 else if cmp<0 then 696 l:=m+1 697 else 698 exit(m); 699 end; 700 Result:=-1; 701end; 702 703function TPas2jsCachedDirectory.IndexOfFileCaseSensitive( 704 const ShortFilename: String): integer; 705var 706 l, r, cmp, m: Integer; 707 Entry: TPas2jsCachedDirectoryEntry; 708begin 709 Sorted:=true; 710 l:=0; 711 r:=Count-1; 712 while l<=r do begin 713 m:=(l+r) shr 1; 714 Entry:=Entries[m]; 715 cmp:=CompareFirstCaseInsThenSensitive(Entry.Name,ShortFilename); 716 if cmp>0 then 717 r:=m-1 718 else if cmp<0 then 719 l:=m+1 720 else 721 exit(m); 722 end; 723 Result:=-1; 724end; 725 726function TPas2jsCachedDirectory.CountSameNamesCaseInsensitive(Index: integer 727 ): integer; 728var 729 i: Integer; 730 Filename: String; 731begin 732 Filename:=Entries[Index].Name; 733 Result:=1; 734 for i:=Index-1 downto 0 do 735 begin 736 if CompareText(Entries[i].Name,Filename)<>0 then break; 737 inc(Result); 738 end; 739 for i:=Index+1 to Count-1 do 740 begin 741 if CompareText(Entries[i].Name,Filename)<>0 then break; 742 inc(Result); 743 end; 744end; 745 746procedure TPas2jsCachedDirectory.GetSameNamesCaseInsensitive(Index: integer; 747 List: TStrings); 748var 749 i: Integer; 750 Filename: String; 751begin 752 Filename:=Entries[Index].Name; 753 List.Add(Filename); 754 for i:=Index-1 downto 0 do 755 begin 756 if CompareText(Entries[i].Name,Filename)<>0 then break; 757 List.Add(Entries[i].Name); 758 end; 759 for i:=Index+1 to Count-1 do 760 begin 761 if CompareText(Entries[i].Name,Filename)<>0 then break; 762 List.Add(Entries[i].Name); 763 end; 764end; 765 766procedure TPas2jsCachedDirectory.GetFiles(var Files: TStrings; 767 IncludeDirs: boolean); 768var 769 i: Integer; 770 Entry: TPas2jsCachedDirectoryEntry; 771begin 772 if Files=nil then 773 Files:=TStringList.Create; 774 if (Self=nil) or (Path='') then exit; 775 Update; 776 for i:=0 to Count-1 do begin 777 Entry:=Entries[i]; 778 if IncludeDirs or ((Entry.Attr and faDirectory)=0) then 779 Files.Add(Entry.Name); 780 end; 781end; 782 783procedure TPas2jsCachedDirectory.CheckConsistency; 784{AllowWriteln} 785 786 procedure E(Msg: string); 787 begin 788 WriteDebugReport; 789 writeln('TPas2jsCachedDirectory.CheckConsistency Failed for "',Path,'": '+Msg); 790 end; 791 792var 793 i, cmp, j: Integer; 794 Entry, LastEntry: TPas2jsCachedDirectoryEntry; 795begin 796 if Path<>IncludeTrailingPathDelimiter(Path) then 797 E('Path<>IncludeTrailingPathDelimiter(Path)'); 798 LastEntry:=nil; 799 for i:=0 to Count-1 do begin 800 Entry:=Entries[i]; 801 if (Entry.Name='') or (Entry.Name='.') or (Entry.Name='..') then 802 E('invalid entry "'+Entry.Name+'"'); 803 if (Entry.Size<0) then 804 E('invalid size "'+Entry.Name+'" '+IntToStr(Entry.Size)); 805 if Sorted then 806 begin 807 if (LastEntry<>nil) then 808 begin 809 if LastEntry.Name=Entry.Name then 810 E('duplicate "'+Entry.Name+'"'); 811 cmp:=CompareText(LastEntry.Name,Entry.Name); 812 if cmp>0 then 813 E('sorted wrong case insensitive "'+LastEntry.Name+'" "'+Entry.Name+'"'); 814 if (cmp=0) and (CompareStr(LastEntry.Name,Entry.Name)>0) then 815 E('sorted wrong case sensitive "'+LastEntry.Name+'" "'+Entry.Name+'"'); 816 end; 817 j:=IndexOfFileCaseSensitive(Entry.Name); 818 if i<>j then 819 E('IndexOfFileCaseSensitive failed "'+Entry.Name+'" expected '+IntToStr(i)+', but was '+IntToStr(j)); 820 end; 821 LastEntry:=Entry; 822 end; 823 {AllowWriteln-} 824end; 825 826procedure TPas2jsCachedDirectory.WriteDebugReport; 827var 828 i: Integer; 829 Entry: TPas2jsCachedDirectoryEntry; 830begin 831 {AllowWriteln} 832 writeln('TPas2jsCachedDirectory.WriteDebugReport Count=',Count,' Path="',Path,'"'); 833 for i:=0 to Count-1 do begin 834 Entry:=Entries[i]; 835 writeln(i,' "',Entry.Name,'" Size=',Entry.Size,' Time=',DateTimeToStr(FileDateToDateTime(Entry.Time)),' Dir=',faDirectory and Entry.Attr>0); 836 end; 837 {AllowWriteln-} 838end; 839 840{ TPas2jsCachedDirectories } 841 842function TPas2jsCachedDirectories.GetFileInfo(var Info: TFileInfo): boolean; 843begin 844 Info.Filename:=ChompPathDelim(ResolveDots(Info.Filename)); 845 if Info.Filename='' then exit(false); 846 if not FilenameIsAbsolute(Info.Filename) then 847 Info.Filename:=WorkingDirectory+Info.Filename; 848 Info.ShortFilename:=ExtractFilename(Info.Filename); 849 Info.DirPath:=ExtractFilePath(Info.Filename); 850 if (Info.ShortFilename<>'') and (Info.ShortFilename<>'.') and (Info.ShortFilename<>'..') 851 then 852 begin 853 Info.Dir:=GetDirectory(Info.DirPath,true,false); 854 end else begin 855 Info.Dir:=nil; 856 end; 857 Result:=true; 858end; 859 860procedure TPas2jsCachedDirectories.SetWorkingDirectory(const AValue: string); 861begin 862 FWorkingDirectory:=IncludeTrailingPathDelimiter(ResolveDots(AValue)); 863end; 864 865constructor TPas2jsCachedDirectories.Create; 866begin 867 IncreaseChangeStamp(FChangeStamp); 868 FDirectories:=TPasAnalyzerKeySet.Create( 869 {$IFDEF pas2js} 870 @Pas2jsCacheDirToKeyName,@PtrFilenameToKeyName 871 {$ELSE} 872 @ComparePas2jsCacheDirectories,@CompareAnsiStringWithDirectoryCache 873 {$ENDIF}); 874end; 875 876destructor TPas2jsCachedDirectories.Destroy; 877begin 878 Clear; 879 FreeAndNil(FDirectories); 880 inherited Destroy; 881end; 882 883procedure TPas2jsCachedDirectories.Invalidate; 884begin 885 IncreaseChangeStamp(FChangeStamp); 886end; 887 888procedure TPas2jsCachedDirectories.Clear; 889var 890 Dir: TPas2jsCachedDirectory; 891 List: TFPList; 892 i: Integer; 893begin 894 List:=FDirectories.GetList; 895 try 896 for i:=0 to List.Count-1 do 897 begin 898 Dir:=TPas2jsCachedDirectory(List[i]); 899 if Dir.FRefCount<>1 then 900 raise Exception.Create('TPas2jsCachedDirectories.Clear [20180126090807] "'+Dir.Path+'" '+IntToStr(Dir.FRefCount)); 901 Dir.Release; 902 end; 903 finally 904 List.Free; 905 end; 906 FDirectories.Clear; 907end; 908 909function TPas2jsCachedDirectories.DirectoryExists(Filename: string): boolean; 910var 911 Info: TFileInfo; 912 Dir: TPas2jsCachedDirectory; 913begin 914 Info.Filename:=Filename; 915 if not GetFileInfo(Info) then exit(false); 916 if Info.Dir<>nil then 917 Result:=(Info.Dir.FileAttr(Info.ShortFilename) and faDirectory)>0 918 else 919 begin 920 Dir:=GetDirectory(Filename,true,false); 921 if Dir<>nil then 922 Result:=Dir.Count>0 923 else 924 begin 925 Filename:=ChompPathDelim(ResolveDots(Filename)); 926 if not FilenameIsAbsolute(Filename) then 927 Filename:=WorkingDirectory+Filename; 928 Result:={$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Filename); 929 end; 930 end; 931end; 932 933function TPas2jsCachedDirectories.FileExists(Filename: string): boolean; 934var 935 Info: TFileInfo; 936begin 937 Info.Filename:=Filename; 938 if not GetFileInfo(Info) then exit(false); 939 if Info.Dir<>nil then 940 Result:=Info.Dir.IndexOfFile(Info.ShortFilename)>=0 941 else 942 Result:={$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename); 943end; 944 945function TPas2jsCachedDirectories.FileExistsI(var Filename: string): integer; 946var 947 Info: TFileInfo; 948 i: Integer; 949begin 950 Result:=0; 951 Info.Filename:=Filename; 952 if not GetFileInfo(Info) then exit; 953 if Info.Dir=nil then 954 begin 955 if {$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename) then 956 Result:=1; 957 end 958 else 959 begin 960 i:=Info.Dir.IndexOfFileCaseInsensitive(Info.ShortFilename); 961 if i<0 then 962 exit; 963 Filename:=Info.Dir.Path+Info.Dir[i].Name; 964 Result:=Info.Dir.CountSameNamesCaseInsensitive(i); 965 end; 966end; 967 968function TPas2jsCachedDirectories.FileAge(Filename: string): TPas2jsFileAgeTime; 969var 970 Info: TFileInfo; 971begin 972 Info.Filename:=Filename; 973 if GetFileInfo(Info) and (Info.Dir<>nil) then 974 Result:=Info.Dir.FileAge(Info.ShortFilename) 975 else 976 Result:=-1; 977end; 978 979function TPas2jsCachedDirectories.FileAttr(Filename: string): TPas2jsFileAttr; 980var 981 Info: TFileInfo; 982begin 983 Info.Filename:=Filename; 984 if GetFileInfo(Info) and (Info.Dir<>nil) then 985 Result:=Info.Dir.FileAttr(Info.ShortFilename) 986 else 987 Result:=0; 988end; 989 990function TPas2jsCachedDirectories.FileSize(Filename: string): TPas2jsFileSize; 991var 992 Info: TFileInfo; 993begin 994 Info.Filename:=Filename; 995 if GetFileInfo(Info) and (Info.Dir<>nil) then 996 Result:=Info.Dir.FileSize(Info.ShortFilename) 997 else 998 Result:=-1; 999end; 1000 1001function TPas2jsCachedDirectories.FindDiskFilename(const Filename: string; 1002 SearchCaseInsensitive: boolean): string; 1003var 1004 ADirectory: String; 1005 Cache: TPas2jsCachedDirectory; 1006 DiskShortFilename: String; 1007begin 1008 Result:=ChompPathDelim(ResolveDots(Filename)); 1009 if Result='' then exit; 1010 //debugln(['TPas2jsCachedDirectories.FindDiskFilename Filename=',Result]); 1011 {$IF defined(NotLiteralFilenames) or defined(CaseInsensitiveFilenames)} 1012 {$ELSE} 1013 if (not SearchCaseInsensitive) then exit; 1014 {$ENDIF} 1015 ADirectory:=ExtractFilePath(Result); 1016 if ADirectory=Result then 1017 exit; // root directory, e.g. / under Linux or C: under Windows 1018 if SearchCaseInsensitive then 1019 // search recursively all directory parts 1020 ADirectory:=IncludeTrailingPathDelimiter(FindDiskFilename(ADirectory,true)); 1021 Cache:=GetDirectory(ADirectory,true,false); 1022 //debugln(['TPas2jsCachedDirectories.FindDiskFilename Dir=',Cache.Directory]); 1023 Result:=ExtractFileName(Result); 1024 DiskShortFilename:=Cache.FindFile(Result,sfcCaseInsensitive); 1025 //debugln(['TPas2jsCachedDirectories.FindDiskFilename DiskShortFilename=',DiskShortFilename]); 1026 if DiskShortFilename<>'' then Result:=DiskShortFilename; 1027 Result:=Cache.Path+Result; 1028end; 1029 1030procedure TPas2jsCachedDirectories.GetListing(const aDirectory: string; 1031 var Files: TStrings; IncludeDirs: boolean); 1032begin 1033 GetDirectory(aDirectory,true,false).GetFiles(Files,IncludeDirs); 1034end; 1035 1036function TPas2jsCachedDirectories.GetDirectory(const Directory: string; 1037 CreateIfNotExists: boolean; DoReference: boolean): TPas2jsCachedDirectory; 1038var 1039 Dir: String; 1040begin 1041 Dir:=ResolveDots(Directory); 1042 if not FilenameIsAbsolute(Dir) then 1043 Dir:=WorkingDirectory+Dir; 1044 Dir:=IncludeTrailingPathDelimiter(Dir); 1045 Result:=TPas2jsCachedDirectory(FDirectories.FindKey(Pointer(Dir))); 1046 if Result<>nil then 1047 begin 1048 if DoReference then 1049 Result.Reference; 1050 Result.Update; 1051 end else if DoReference or CreateIfNotExists then 1052 begin 1053 {$IFDEF VerbosePas2JSDirCache} 1054 writeln('TPas2jsCachedDirectories.GetDirectory "',Dir,'"'); 1055 {$ENDIF} 1056 Result:=TPas2jsCachedDirectory.Create(Dir,Self); 1057 FDirectories.Add(Result); 1058 if DoReference then 1059 Result.Reference; 1060 Result.Update; 1061 end else 1062 Result:=nil; 1063end; 1064 1065{ TPas2jsFileLineReader } 1066 1067procedure TPas2jsFileLineReader.IncLineNumber; 1068begin 1069 if (CachedFile<>nil) and (CachedFile.Cache<>nil) then 1070 CachedFile.Cache.IncReadLineCounter; 1071 inherited IncLineNumber; 1072end; 1073 1074constructor TPas2jsFileLineReader.Create(const AFilename: string); 1075begin 1076 raise Exception.Create('TPas2jsFileLineReader.Create [20180126090825] no cache "'+AFilename+'"'); 1077end; 1078 1079constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile); 1080begin 1081 inherited Create(aFile.Filename,aFile.Source); 1082 FCachedFile:=aFile; 1083end; 1084 1085 1086{ TPas2jsCachedFile } 1087 1088// inline 1089function TPas2jsCachedFile.GetIsBinary: boolean; 1090begin 1091 Result:=FFileEncoding=EncodingBinary; 1092end; 1093 1094function TPas2jsCachedFile.GetCache: TPas2jsFilesCache; 1095begin 1096 Result:=TPas2jsFilesCache(FS); 1097end; 1098 1099constructor TPas2jsCachedFile.Create(aCache: TPas2jsFilesCache; 1100 const aFilename: string); 1101begin 1102 inHerited Create(aCache,aFileName); 1103 FChangeStamp:=InvalidChangeStamp; 1104 FCacheStamp:=Cache.ResetStamp; 1105end; 1106 1107function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean 1108 ): boolean; 1109 1110 procedure Err(const ErrorMsg: string); 1111 begin 1112 {$IFDEF VerboseFileCache} 1113 writeln('TPas2jsCachedFile.Load.Err ErrorMsg="',ErrorMsg,'"'); 1114 {$ENDIF} 1115 FLastErrorMsg:=ErrorMsg; 1116 if RaiseOnError then 1117 raise EPas2jsFileCache.Create(FLastErrorMsg); 1118 end; 1119 1120var 1121 NewSource: string; 1122 b: Boolean; 1123begin 1124 {$IFDEF VerboseFileCache} 1125 writeln('TPas2jsCachedFile.Load START "',Filename,'" Loaded=',Loaded); 1126 {$ENDIF} 1127 if Loaded then 1128 begin 1129 // already loaded, check if it still valid 1130 if (Cache.ResetStamp=FCacheStamp) then 1131 begin 1132 // nothing changed 1133 Result:=FLastErrorMsg=''; 1134 if (not Result) and RaiseOnError then 1135 raise EPas2jsFileCache.Create(FLastErrorMsg); 1136 exit; 1137 end; 1138 {$IFDEF VerboseFileCache} 1139 writeln('TPas2jsCachedFile.Load CHECK FILEAGE "',Filename,'"'); 1140 {$ENDIF} 1141 if LoadedFileAge=Cache.DirectoryCache.FileAge(Filename) then 1142 exit(true); 1143 end; 1144 {$IFDEF VerboseFileCache} 1145 writeln('TPas2jsCachedFile.Load FIRST or RELOAD ',Filename,' Loaded=',Loaded); 1146 {$ENDIF} 1147 // needs (re)load 1148 Result:=false; 1149 if not Cache.FileExists(Filename) then 1150 begin 1151 Err('File not found "'+Filename+'"'); 1152 exit; 1153 end; 1154 if Cache.DirectoryExists(Filename) then 1155 begin 1156 Err('File is a directory "'+Filename+'"'); 1157 exit; 1158 end; 1159 NewSource:=''; 1160 if RaiseOnError then 1161 b:=Cache.ReadFile(Filename,NewSource) 1162 else 1163 try 1164 b:=Cache.ReadFile(Filename,NewSource); 1165 except 1166 end; 1167 if not b then begin 1168 Err('Read error "'+Filename+'"'); 1169 exit; 1170 end; 1171 1172 {$IFDEF VerboseFileCache} 1173 writeln('TPas2jsCachedFile.Load ENCODE ',Filename,' FFileEncoding=',FFileEncoding); 1174 {$ENDIF} 1175 if Binary then 1176 begin 1177 SetSource(NewSource); 1178 FFileEncoding:=EncodingBinary; 1179 end else 1180 begin 1181 {$IFDEF FPC_HAS_CPSTRING} 1182 SetSource(ConvertTextToUTF8(NewSource,FFileEncoding)); 1183 {$ELSE} 1184 SetSource(NewSource); 1185 {$ENDIF} 1186 end; 1187 FLoaded:=true; 1188 FCacheStamp:=Cache.ResetStamp; 1189 FLoadedFileAge:=Cache.DirectoryCache.FileAge(Filename); 1190 {$IFDEF VerboseFileCache} 1191 writeln('TPas2jsCachedFile.Load END ',Filename,' FFileEncoding=',FFileEncoding); 1192 {$ENDIF} 1193end; 1194 1195function TPas2jsCachedFile.CreateLineReader(RaiseOnError: boolean 1196 ): TSourceLineReader; 1197begin 1198 if not Load(RaiseOnError) then 1199 exit(nil); 1200 Result:=TPas2jsFileLineReader.Create(Self); 1201end; 1202 1203{ TPas2jsFileResolver } 1204 1205function TPas2jsFileResolver.GetCache: TPas2jsFilesCache; 1206begin 1207 Result:=TPas2jsFilesCache(FS); 1208end; 1209 1210constructor TPas2jsFileResolver.Create(aCache: TPas2jsFilesCache); 1211begin 1212 inherited Create(aCache); 1213end; 1214 1215{ TPas2jsFilesCache } 1216 1217procedure TPas2jsFilesCache.RegisterMessages; 1218begin 1219 Log.RegisterMsg(mtInfo,nIncludeSearch,sIncludeSearch); 1220 Log.RegisterMsg(mtInfo,nUnitSearch,sUnitSearch); 1221 Log.RegisterMsg(mtInfo,nSearchingFileFound,sSearchingFileFound); 1222 Log.RegisterMsg(mtInfo,nSearchingFileNotFound,sSearchingFileNotFound); 1223 Log.RegisterMsg(mtFatal,nDuplicateFileFound,sDuplicateFileFound); 1224 Log.RegisterMsg(mtFatal,nCustomJSFileNotFound,sCustomJSFileNotFound); 1225end; 1226 1227function TPas2jsFilesCache.GetHasPCUSupport: Boolean; 1228begin 1229 Result:=False; 1230end; 1231 1232procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string); 1233begin 1234 AValue:=Pas2jsFileUtils.ExpandDirectory(AValue); 1235 if FBaseDirectory=AValue then Exit; 1236 FBaseDirectory:=AValue; 1237 DirectoryCache.WorkingDirectory:=BaseDirectory; 1238end; 1239 1240function TPas2jsFilesCache.AddSearchPaths(const Paths: string; 1241 Kind: TPas2jsSearchPathKind; FromCmdLine: boolean; var List: TStringList; 1242 var CmdLineCount: integer): string; 1243// cmd line paths are added in front of the cfg paths 1244// cmd line paths are added in order, cfg paths are added in reverse order 1245// multi paths separated by semicolon are added in order 1246// duplicates are removed 1247var 1248 Added: Integer; 1249 1250 function Add(aPath: string): boolean; 1251 var 1252 Remove: Boolean; 1253 i: Integer; 1254 begin 1255 Remove:=false; 1256 // search duplicate 1257 case Kind of 1258 spkPath: 1259 begin 1260 i:=List.Count-1; 1261 while (i>=0) and (CompareFilenames(aPath,List[i])<>0) do dec(i); 1262 end; 1263 spkIdentifier: 1264 begin 1265 if aPath[length(aPath)]='-' then 1266 begin 1267 Delete(aPath,length(aPath),1); 1268 Remove:=true; 1269 end; 1270 if not IsValidIdent(aPath,true,true) then 1271 begin 1272 AddSearchPaths:=aPath; 1273 exit(false); 1274 end; 1275 i:=List.Count-1; 1276 while (i>=0) and (CompareText(aPath,List[i])<>0) do dec(i); 1277 end; 1278 end; 1279 1280 if Remove then 1281 begin 1282 // remove 1283 if i>=0 then 1284 begin 1285 List.Delete(i); 1286 if CmdLineCount>i then dec(CmdLineCount); 1287 end; 1288 exit(true); 1289 end; 1290 1291 if FromCmdLine then 1292 begin 1293 // from cmdline: append in order to the cmdline params, in front of cfg params 1294 if i>=0 then 1295 begin 1296 if i<=CmdLineCount then exit(true); 1297 List.Delete(i); 1298 end; 1299 List.Insert(CmdLineCount,aPath); 1300 inc(CmdLineCount); 1301 end else begin 1302 // from cfg: append in reverse order to the cfg params, behind cmdline params 1303 if i>=0 then 1304 begin 1305 if i<=CmdLineCount+Added then exit(true); 1306 List.Delete(i); 1307 end; 1308 List.Insert(CmdLineCount+Added,aPath); 1309 inc(Added); 1310 end; 1311 Result:=true; 1312 end; 1313 1314var 1315 aPath: String; 1316 p, i: integer; 1317 aPaths: TStringList; 1318begin 1319 Result:=''; 1320 p:=1; 1321 Added:=0; 1322 aPaths:=TStringList.Create; 1323 try 1324 while p<=length(Paths) do begin 1325 aPath:=GetNextDelimitedItem(Paths,';',p); 1326 if aPath='' then continue; 1327 if Kind=spkPath then 1328 begin 1329 aPath:=ExpandDirectory(aPath); 1330 if aPath='' then continue; 1331 end; 1332 aPaths.Clear; 1333 FindMatchingFiles(aPath,1000,aPaths); 1334 if aPaths.Count=0 then 1335 begin 1336 if not Add(aPath) then exit; 1337 end else begin 1338 for i:=0 to aPaths.Count-1 do 1339 if not Add(aPaths[i]) then exit; 1340 end; 1341 end; 1342 finally 1343 aPaths.Free; 1344 end; 1345end; 1346 1347procedure TPas2jsFilesCache.SetOnReadDirectory(AValue: TReadDirectoryEvent); 1348begin 1349 DirectoryCache.OnReadDirectory:=AValue; 1350end; 1351 1352function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string 1353 ): boolean; 1354{$IFDEF Pas2js} 1355{$ELSE} 1356var 1357 ms: TMemoryStream; 1358{$ENDIF} 1359begin 1360 Result:=false; 1361 try 1362 if Assigned(OnReadFile) then 1363 Result:=OnReadFile(Filename,Source); 1364 if Result then 1365 Exit; 1366 {$IFDEF Pas2js} 1367 try 1368 Source:=NJS_FS.readFileSync(Filename,new(['encoding','utf8'])); 1369 except 1370 raise EReadError.Create(String(JSExceptValue)); 1371 end; 1372 Result:=true; 1373 {$ELSE} 1374 ms:=TMemoryStream.Create; 1375 try 1376 ms.LoadFromFile(Filename); 1377 SetLength(Source,ms.Size); 1378 ms.Position:=0; 1379 if Source<>'' then 1380 ms.Read(Source[1],length(Source)); 1381 Result:=true; 1382 finally 1383 ms.Free; 1384 end; 1385 {$ENDIF} 1386 except 1387 on E: Exception do begin 1388 EPas2jsFileCache.Create('Error reading file "'+Filename+'": '+E.Message); 1389 end; 1390 end; 1391end; 1392 1393procedure TPas2jsFilesCache.FindMatchingFiles(Mask: string; MaxCount: integer; 1394 Files: TStrings); 1395 1396 procedure TooMany(id: TMaxPrecInt); 1397 begin 1398 raise EListError.Create('found too many files "'+Mask+'". Max='+IntToStr(MaxCount)+' ['+IntToStr(id)+']'); 1399 end; 1400 1401 procedure Find(aMask: string; p: integer); 1402 var 1403 Dir: TPas2jsCachedDirectory; 1404 StartP, i: Integer; 1405 CurMask, Filename: String; 1406 Entry: TPas2jsCachedDirectoryEntry; 1407 begin 1408 while p<=length(aMask) do begin 1409 if aMask[p] in ['*','?'] then 1410 begin 1411 while (p>1) and not (aMask[p-1] in AllowDirectorySeparators) do dec(p); 1412 Dir:=DirectoryCache.GetDirectory(LeftStr(aMask,p-1),true,false); 1413 StartP:=p; 1414 while (p<=length(aMask)) and not (aMask[p] in AllowDirectorySeparators) do 1415 inc(p); 1416 CurMask:=copy(aMask,StartP,p-StartP); 1417 for i:=0 to Dir.Count-1 do begin 1418 Entry:=Dir.Entries[i]; 1419 if (Entry.Name='') or (Entry.Name='.') or (Entry.Name='..') then continue; 1420 if not MatchGlobbing(CurMask,Entry.Name) then continue; 1421 Filename:=Dir.Path+Entry.Name; 1422 if p>length(aMask) then 1423 begin 1424 // e.g. /path/unit*.pas 1425 if Files.Count>=MaxCount then 1426 TooMany(20180126091916); 1427 Files.Add(Filename); 1428 end else begin 1429 // e.g. /path/sub*path/... 1430 Find(Filename+copy(aMask,p,length(aMask)),length(Filename)+1); 1431 end; 1432 end; 1433 exit; 1434 end; 1435 inc(p); 1436 end; 1437 // mask has no placeholder -> search directly 1438 if FileExists(aMask) then 1439 begin 1440 if Files.Count>=MaxCount then 1441 TooMany(20180126091913); 1442 Files.Add(aMask); 1443 end; 1444 end; 1445 1446begin 1447 Mask:=ResolveDots(Mask); 1448 Find(Mask,1); 1449end; 1450 1451constructor TPas2jsFilesCache.Create(aLog: TPas2jsLogger); 1452begin 1453 inherited Create; 1454 FResetStamp:=InvalidChangeStamp; 1455 FLog:=aLog; 1456 FIncludePaths:=TStringList.Create; 1457 FForeignUnitPaths:=TStringList.Create; 1458 FUnitPaths:=TStringList.Create; 1459 FResourcePaths:=TStringList.Create; 1460 FFiles:=TPasAnalyzerKeySet.Create( 1461 {$IFDEF Pas2js} 1462 @Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName 1463 {$ELSE} 1464 @CompareCachedFiles,@CompareFilenameWithCachedFile 1465 {$ENDIF}); 1466 FDirectoryCache:=TPas2jsCachedDirectories.Create; 1467 RegisterMessages; 1468end; 1469 1470destructor TPas2jsFilesCache.Destroy; 1471begin 1472 FLog:=nil; 1473 FFiles.FreeItems; 1474 FreeAndNil(FDirectoryCache); 1475 FreeAndNil(FFiles); 1476 FreeAndNil(FIncludePaths); 1477 FreeAndNil(FForeignUnitPaths); 1478 FreeAndNil(FUnitPaths); 1479 FreeAndNil(FPCUPaths); 1480 inherited Destroy; 1481end; 1482 1483procedure TPas2jsFilesCache.Reset; 1484begin 1485 Inherited; 1486 IncreaseChangeStamp(FResetStamp); 1487 FDirectoryCache.Invalidate; 1488 // FFiles: keep data, files are checked against LoadedFileAge 1489 FBaseDirectory:=''; 1490 FForeignUnitPaths.Clear; 1491 FForeignUnitPathsFromCmdLine:=0; 1492 FUnitPaths.Clear; 1493 FUnitPathsFromCmdLine:=0; 1494 FIncludePaths.Clear; 1495 FIncludePathsFromCmdLine:=0; 1496 FreeAndNil(FPCUPaths); 1497 // FOnReadFile: TPas2jsReadFileEvent; keep 1498 // FOnWriteFile: TPas2jsWriteFileEvent; keep 1499end; 1500 1501procedure TPas2jsFilesCache.WriteFoldersAndSearchPaths; 1502 1503 procedure WriteFolder(aName, Folder: string); 1504 begin 1505 if Folder='' then exit; 1506 Folder:=ChompPathDelim(Folder); 1507 Log.LogMsgIgnoreFilter(nUsingPath,[aName,Folder]); 1508 if not DirectoryExists(Folder) then 1509 Log.LogMsgIgnoreFilter(nFolderNotFound,[aName,QuoteStr(Folder)]); 1510 end; 1511 1512var 1513 i: Integer; 1514begin 1515 WriteFolder('working directory',BaseDirectory); 1516 for i:=0 to ForeignUnitPaths.Count-1 do 1517 WriteFolder('foreign unit path',ForeignUnitPaths[i]); 1518 for i:=0 to UnitPaths.Count-1 do 1519 WriteFolder('unit path',UnitPaths[i]); 1520 for i:=0 to IncludePaths.Count-1 do 1521 WriteFolder('include path',IncludePaths[i]); 1522 WriteFolder('unit output path',UnitOutputPath); 1523 WriteFolder('main output path',MainOutputPath); 1524end; 1525 1526procedure TPas2jsFilesCache.GetPCUDirs(aList: TStrings; const aBaseDir: String); 1527var 1528 i: Integer; 1529begin 1530 if FPCUPaths=nil then 1531 begin 1532 FPCUPaths:=TStringList.Create; 1533 inherited GetPCUDirs(FPCUPaths, aBaseDir); 1534 FPCUPaths.AddStrings(UnitPaths); 1535 for i:=0 to FPCUPaths.Count-1 do 1536 FPCUPaths[i]:=IncludeTrailingPathDelimiter(FPCUPaths[i]); 1537 DeleteDuplicateFiles(FPCUPaths); 1538 end; 1539 aList.Assign(FPCUPaths); 1540end; 1541 1542function TPas2jsFilesCache.PCUExists(var aFileName: string): Boolean; 1543begin 1544 Result:=SearchLowUpCase(aFileName); 1545end; 1546 1547function TPas2jsFilesCache.SameFileName(const File1, File2: String): Boolean; 1548begin 1549 Result:=Pas2jsFileUtils.CompareFilenames(File1,File2)=0; 1550end; 1551 1552function TPas2jsFilesCache.File1IsNewer(const File1, File2: String): Boolean; 1553begin 1554 Result:=FileAge(File1)>FileAge(File2); 1555end; 1556 1557function TPas2jsFilesCache.AddIncludePaths(const Paths: string; 1558 FromCmdLine: boolean; out ErrorMsg: string): boolean; 1559begin 1560 ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FIncludePaths,FIncludePathsFromCmdLine); 1561 Result:=ErrorMsg=''; 1562end; 1563 1564function TPas2jsFilesCache.AddUnitPaths(const Paths: string; 1565 FromCmdLine: boolean; out ErrorMsg: string): boolean; 1566begin 1567 ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FUnitPaths,FUnitPathsFromCmdLine); 1568 Result:=ErrorMsg=''; 1569end; 1570 1571function TPas2jsFilesCache.AddSrcUnitPaths(const Paths: string; 1572 FromCmdLine: boolean; out ErrorMsg: string): boolean; 1573begin 1574 ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FForeignUnitPaths,FForeignUnitPathsFromCmdLine); 1575 Result:=ErrorMsg=''; 1576end; 1577 1578function TPas2jsFilesCache.CreateResolver: TPas2jsFSResolver; 1579 1580begin 1581 Result := TPas2jsFileResolver.Create(Self); 1582 {$IFDEF HasStreams} 1583 Result.UseStreams:=false; 1584 {$ENDIF} 1585 Result.BaseDirectory:=BaseDirectory; // beware: will be changed by Scanner.OpenFile 1586end; 1587 1588function TPas2jsFilesCache.FormatPath(const aPath: string): string; 1589begin 1590 Result:=aPath; 1591 if (Result='') or (BaseDirectory='') then exit; 1592 if FilenameIsAbsolute(aPath) then 1593 begin 1594 if not ShowFullPaths then 1595 begin 1596 if BaseDirectory=LeftStr(Result,length(BaseDirectory)) then 1597 Delete(Result,1,length(BaseDirectory)); 1598 end; 1599 end else begin 1600 if ShowFullPaths then 1601 Result:=BaseDirectory+Result; 1602 end; 1603end; 1604 1605 1606 1607function TPas2jsFilesCache.DirectoryExists(const Filename: string): boolean; 1608begin 1609 Result:=DirectoryCache.DirectoryExists(FileName); 1610end; 1611 1612function TPas2jsFilesCache.FileExists(const Filename: string): boolean; 1613begin 1614 Result:=DirectoryCache.FileExists(FileName); 1615end; 1616 1617function TPas2jsFilesCache.FileExistsI(var Filename: string): integer; 1618begin 1619 Result:=DirectoryCache.FileExistsI(FileName); 1620end; 1621 1622function TPas2jsFilesCache.FileAge(const Filename: string): TPas2jsFileAgeTime; 1623begin 1624 Result:=DirectoryCache.FileAge(FileName); 1625end; 1626 1627function TPas2jsFilesCache.FindFile(Filename: string): TPas2jsCachedFile; 1628begin 1629 Filename:=NormalizeFilename(Filename,true); 1630 Result:=TPas2jsCachedFile(FFiles.FindKey(Pointer(Filename))); 1631end; 1632 1633function TPas2jsFilesCache.LoadFile(Filename: string; Binary: boolean 1634 ): TPas2jsFile; 1635begin 1636 Result:=FindFile(FileName); 1637 if Result=nil then 1638 begin 1639 // new file 1640 Result:=TPas2jsCachedFile.Create(Self,Filename); 1641 FFiles.Add(Result); 1642 end; 1643 Result.Load(true,Binary); 1644end; 1645 1646function TPas2jsFilesCache.NormalizeFilename(const Filename: string; 1647 RaiseOnError: boolean): string; 1648begin 1649 Result:=Filename; 1650 if ExtractFilename(Result)='' then 1651 if RaiseOnError then 1652 raise EFileNotFoundError.Create('invalid file name "'+Filename+'"'); 1653 Result:=ExpandFileNamePJ(Result,BaseDirectory); 1654 if (ExtractFilename(Result)='') or not FilenameIsAbsolute(Result) then 1655 if RaiseOnError then 1656 raise EFileNotFoundError.Create('invalid file name "'+Filename+'"'); 1657end; 1658 1659procedure TPas2jsFilesCache.GetListing(const aDirectory: string; 1660 var Files: TStrings; FullPaths: boolean); 1661begin 1662 DirectoryCache.GetDirectory(aDirectory,true,false).GetFiles(Files,FullPaths); 1663end; 1664 1665procedure TPas2jsFilesCache.RaiseDuplicateFile(aFilename: string); 1666 1667 procedure E(const File1, File2: string); 1668 begin 1669 raise EPas2jsFileCache.Create(SafeFormat(sDuplicateFileFound,[File1,File2])); 1670 end; 1671 1672var 1673 Dir: TPas2jsCachedDirectory; 1674 i: Integer; 1675 List: TStringList; 1676 ShortFilename: String; 1677begin 1678 Dir:=DirectoryCache.GetDirectory(ExtractFilePath(aFilename),true,false); 1679 ShortFilename:=ExtractFilename(aFilename); 1680 i:=Dir.IndexOfFileCaseSensitive(ShortFilename); 1681 if i<0 then 1682 E(aFilename,'?'); 1683 List:=TStringList.Create; 1684 try 1685 Dir.GetSameNamesCaseInsensitive(i,List); 1686 if List.Count<2 then 1687 E(aFilename,'?'); 1688 E(Dir.Path+List[0],List[1]); 1689 finally 1690 List.Free; 1691 end; 1692end; 1693 1694procedure TPas2jsFilesCache.SaveToFile(ms: TFPJSStream; Filename: string); 1695var 1696 s: string; 1697 {$IFDEF FPC} 1698 i: Integer; 1699 l: TMaxPrecInt; 1700 {$ENDIF} 1701begin 1702 if Assigned(OnWriteFile) then 1703 begin 1704 {$IFDEF Pas2js} 1705 s:=ms.join(''); 1706 {$ELSE} 1707 l:=ms.Size-ms.Position; 1708 if l>0 then 1709 begin 1710 s:=''; 1711 SetLength(s,l); 1712 ms.Read(s[1],l); 1713 end 1714 else 1715 s:=''; 1716 {$ENDIF} 1717 OnWriteFile(Filename,s); 1718 end else 1719 begin 1720 {$IFDEF Pas2js} 1721 try 1722 s:=ms.join(''); 1723 NJS_FS.writeFileSync(Filename,s,new(['encoding','utf8'])); 1724 except 1725 raise EWriteError.Create(String(JSExceptValue)); 1726 end; 1727 {$ELSE} 1728 try 1729 ms.SaveToFile(Filename); 1730 except 1731 on E: Exception do begin 1732 i:=GetLastOSError; 1733 if i<>0 then 1734 Log.LogPlain('Note: '+SysErrorMessage(i)); 1735 if not DirectoryExists(ChompPathDelim(ExtractFilePath(Filename))) then 1736 Log.LogPlain('Note: file cache inconsistency: folder does not exist "'+ChompPathDelim(ExtractFilePath(Filename))+'"'); 1737 if FileExists(Filename) and not FileIsWritable(Filename) then 1738 Log.LogPlain('Note: file is not writable "'+Filename+'"'); 1739 raise; 1740 end; 1741 end; 1742 {$ENDIF} 1743 end; 1744end; 1745 1746function TPas2jsFilesCache.ExpandDirectory(const Filename: string): string; 1747begin 1748 if Filename='' then exit(''); 1749 Result:=ExpandFileNamePJ(Filename,BaseDirectory); 1750 if Result='' then exit; 1751 Result:=IncludeTrailingPathDelimiter(Result); 1752end; 1753 1754function TPas2jsFilesCache.ExpandFileName(const Filename: string): string; 1755begin 1756 Result:=ExpandFileNamePJ(Filename,BaseDirectory); 1757end; 1758 1759function TPas2jsFilesCache.ExpandExecutable(const Filename: string): string; 1760 1761 function TryFile(CurFilename: string): boolean; 1762 begin 1763 Result:=false; 1764 CurFilename:=ResolveDots(CurFilename); 1765 if not FileExists(CurFilename) then exit; 1766 ExpandExecutable:=CurFilename; 1767 Result:=true; 1768 end; 1769 1770var 1771 PathVar, CurPath: String; 1772 p, StartPos: Integer; 1773begin 1774 if Filename='' then exit(''); 1775 if ExtractFilePath(Filename)='' then 1776 begin 1777 // no file path -> search 1778 {$IFDEF Windows} 1779 // search in BaseDir 1780 if BaseDirectory<>'' then 1781 begin 1782 if TryFile(IncludeTrailingPathDelimiter(BaseDirectory)+Filename) then exit; 1783 end; 1784 {$ENDIF} 1785 // search in PATH 1786 PathVar:=GetEnvironmentVariablePJ('PATH'); 1787 p:=1; 1788 while p<=length(PathVar) do 1789 begin 1790 while (p<=length(PathVar)) and (PathVar[p]=PathSeparator) do inc(p); 1791 StartPos:=p; 1792 while (p<=length(PathVar)) and (PathVar[p]<>PathSeparator) do inc(p); 1793 CurPath:=copy(PathVar,StartPos,p-StartPos); 1794 if CurPath='' then continue; 1795 CurPath:=ExpandFileNamePJ(CurPath); 1796 if CurPath='' then continue; 1797 if TryFile(IncludeTrailingPathDelimiter(CurPath)+Filename) then exit; 1798 end; 1799 end else 1800 Result:=ExpandFileName(Filename); 1801end; 1802 1803function TPas2jsFilesCache.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; 1804 1805Var 1806 ErrorMsg : String; 1807 1808begin 1809 Result:=''; 1810 case C of 1811 'E': MainOutputPath:=aValue; 1812 'i': if not AddIncludePaths(aValue,FromCmdLine,ErrorMsg) then 1813 Result:='invalid include path (-Fi) "'+ErrorMsg+'"'; 1814 'u': if not AddUnitPaths(aValue,FromCmdLine,ErrorMsg) then 1815 Result:='invalid unit path (-Fu) "'+ErrorMsg+'"'; 1816 'U': UnitOutputPath:=aValue; 1817 else 1818 Result:=inherited HandleOptionPaths(C, aValue, FromCmdLine); 1819 end; 1820end; 1821 1822function TPas2jsFilesCache.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; 1823begin 1824 AddSrcUnitPaths(aValue,FromCmdLine,Result); 1825end; 1826 1827function TPas2jsFilesCache.TryCreateRelativePath(const Filename, 1828 BaseDirectory: String; UsePointDirectory, 1829 AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; 1830begin 1831 Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory, 1832 UsePointDirectory, AlwaysRequireSharedBaseFolder, RelPath); 1833end; 1834 1835function TPas2jsFilesCache.FindIncludeFileName(const aFilename, 1836 ModuleDir: string): String; 1837 1838 function SearchCasedInIncPath(const Filename: string): string; 1839 var 1840 i: Integer; 1841 begin 1842 // file name is relative 1843 // first search in the same directory as the unit 1844 if ModuleDir<>'' then 1845 begin 1846 Result:=IncludeTrailingPathDelimiter(ModuleDir)+Filename; 1847 if SearchLowUpCase(Result) then exit; 1848 end; 1849 // then search in include path 1850 for i:=0 to IncludePaths.Count-1 do begin 1851 Result:=IncludeTrailingPathDelimiter(IncludePaths[i])+Filename; 1852 if SearchLowUpCase(Result) then exit; 1853 end; 1854 Result:=''; 1855 end; 1856 1857var 1858 Filename : string; 1859begin 1860 Result := ''; 1861 1862 // convert pathdelims to system 1863 Filename:=SetDirSeparators(aFilename); 1864 if ShowTriedUsedFiles then 1865 Log.LogMsgIgnoreFilter(nIncludeSearch,[Filename]); 1866 1867 if FilenameIsAbsolute(Filename) then 1868 begin 1869 Result:=Filename; 1870 if not SearchLowUpCase(Result) then 1871 Result:=''; 1872 exit; 1873 end; 1874 1875 // search with the given file extension (even if no ext) 1876 Result:=SearchCasedInIncPath(Filename); 1877 if Result<>'' then exit; 1878 1879 if ExtractFileExt(Filename)='' then 1880 begin 1881 // search with the default file extensions 1882 Result:=SearchCasedInIncPath(Filename+'.inc'); 1883 if Result<>'' then exit; 1884 Result:=SearchCasedInIncPath(Filename+'.pp'); 1885 if Result<>'' then exit; 1886 Result:=SearchCasedInIncPath(Filename+'.pas'); 1887 if Result<>'' then exit; 1888 end; 1889end; 1890 1891function TPas2jsFilesCache.FindSourceFileName(const aFilename: string): String; 1892 1893Var 1894 Found: Boolean; 1895 i: Integer; 1896 1897begin 1898 Result:=aFilename; 1899 if StrictFileCase or SearchLikeFPC then 1900 Found:=FileExists(Result) 1901 else 1902 begin 1903 i:=FileExistsI(Result); 1904 Found:=i=1; 1905 if i>1 then 1906 RaiseDuplicateFile(Result); 1907 end; 1908 if not Found then 1909 raise EFileNotFoundError.Create(aFilename) 1910end; 1911 1912 1913function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename, 1914 ModuleDir: string; out IsForeign: boolean): String; 1915var 1916 SearchedDirs: TStringList; 1917 1918 function SearchInDir(Dir: string; var Filename: string): boolean; 1919 // search in Dir for pp, pas, p times given case, lower case, upper case 1920 begin 1921 Dir:=IncludeTrailingPathDelimiter(Dir); 1922 if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false); 1923 SearchedDirs.Add(Dir); 1924 Filename:=Dir+aUnitname+'.pp'; 1925 if SearchLowUpCase(Filename) then exit(true); 1926 Filename:=Dir+aUnitname+'.pas'; 1927 if SearchLowUpCase(Filename) then exit(true); 1928 Filename:=Dir+aUnitname+'.p'; 1929 if SearchLowUpCase(Filename) then exit(true); 1930 Result:=false; 1931 end; 1932 1933var 1934 i: Integer; 1935 aFilename: String; 1936begin 1937 //writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"'); 1938 Result:=''; 1939 IsForeign:=false; 1940 SearchedDirs:=TStringList.Create; 1941 try 1942 if InFilename<>'' then 1943 begin 1944 aFilename:=SetDirSeparators(InFilename); 1945 Result:=ResolveDots(aFilename); 1946 if FilenameIsAbsolute(Result) then 1947 begin 1948 if SearchLowUpCase(Result) then exit; 1949 end else 1950 begin 1951 Result:=ResolveDots(ModuleDir+Result); 1952 if SearchLowUpCase(Result) then exit; 1953 end; 1954 exit(''); 1955 end; 1956 1957 // first search in foreign unit paths 1958 IsForeign:=true; 1959 for i:=0 to ForeignUnitPaths.Count-1 do 1960 if SearchInDir(ForeignUnitPaths[i],Result) then 1961 begin 1962 IsForeign:=true; 1963 exit; 1964 end; 1965 1966 // then in ModuleDir 1967 IsForeign:=false; 1968 if SearchInDir(ModuleDir,Result) then exit; 1969 1970 // then in BaseDirectory 1971 IsForeign:=false; 1972 if SearchInDir(BaseDirectory,Result) then exit; 1973 1974 // finally search in unit paths 1975 for i:=0 to UnitPaths.Count-1 do 1976 if SearchInDir(UnitPaths[i],Result) then exit; 1977 finally 1978 SearchedDirs.Free; 1979 end; 1980 1981 Result:=''; 1982end; 1983 1984function TPas2jsFilesCache.FindResourceFileName(const aFilename, ModuleDir: string): String; 1985 1986var 1987 SearchedDirs: TStringList; 1988 1989 function SearchInDir(Dir: string; var Filename: string): boolean; 1990 // search in Dir for pp, pas, p times given case, lower case, upper case 1991 var 1992 CurFile : String; 1993 begin 1994 Dir:=IncludeTrailingPathDelimiter(Dir); 1995 if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false); 1996 SearchedDirs.Add(Dir); 1997 CurFile:=Dir+Filename; 1998 if SearchLowUpCase(CurFile) then 1999 begin 2000 FileName:=CurFile; 2001 exit(true); 2002 end; 2003 Result:=false; 2004 end; 2005 2006var 2007 i: Integer; 2008 2009begin 2010 //writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"'); 2011 Result:=''; 2012 SearchedDirs:=TStringList.Create; 2013 try 2014 Result:=SetDirSeparators(aFilename); 2015 2016 // First search in ModuleDir 2017 if SearchInDir(ModuleDir,Result) then 2018 exit; 2019 2020 // Then in resource paths 2021 for i:=0 to ResourcePaths.Count-1 do 2022 if SearchInDir(ResourcePaths[i],Result) then 2023 exit; 2024 // Not sure 2025 // finally search in unit paths 2026 // for i:=0 to UnitPaths.Count-1 do 2027 // if SearchInDir(UnitPaths[i],Result) then exit; 2028 finally 2029 SearchedDirs.Free; 2030 end; 2031 2032 Result:=''; 2033end; 2034 2035function TPas2jsFilesCache.FindUnitJSFileName(const aUnitFilename: string): String; 2036 2037begin 2038 Result:=''; 2039 if aUnitFilename='' then exit; 2040 begin 2041 if UnitOutputPath<>'' then 2042 Result:=UnitOutputPath+ChangeFileExt(ExtractFileName(aUnitFilename),'.js') 2043 else if MainOutputPath<>'' then 2044 Result:=MainOutputPath+ChangeFileExt(ExtractFileName(aUnitFilename),'.js') 2045 else 2046 Result:=ChangeFileExt(aUnitFilename,'.js'); 2047 end; 2048end; 2049 2050function TPas2jsFilesCache.FindCustomJSFileName(const aFilename: string): String; 2051 2052Var 2053 FN : String; 2054 2055 function SearchInDir(Dir: string): boolean; 2056 var 2057 CurFilename: String; 2058 begin 2059 Dir:=IncludeTrailingPathDelimiter(Dir); 2060 CurFilename:=Dir+FN; 2061 Result:=FileExistsLogged(CurFilename); 2062 if Result then 2063 FindCustomJSFileName:=CurFilename; 2064 end; 2065 2066var 2067 i: Integer; 2068begin 2069 Result:=''; 2070 FN:=ResolveDots(aFileName); 2071 if FilenameIsAbsolute(FN) then 2072 begin 2073 Result:=FN; 2074 if not FileExistsLogged(Result) then 2075 Result:=''; 2076 exit; 2077 end; 2078 2079 if ExtractFilePath(FN)<>'' then 2080 begin 2081 Result:=ExpandFileNamePJ(FN,BaseDirectory); 2082 if not FileExistsLogged(Result) then 2083 Result:=''; 2084 exit; 2085 end; 2086 2087 // first search in foreign unit paths 2088 for i:=0 to ForeignUnitPaths.Count-1 do 2089 if SearchInDir(ForeignUnitPaths[i]) then 2090 exit; 2091 2092 // then in BaseDirectory 2093 if SearchInDir(BaseDirectory) then exit; 2094 2095 // finally search in unit paths 2096 for i:=0 to UnitPaths.Count-1 do 2097 if SearchInDir(UnitPaths[i]) then exit; 2098 2099 Result:=''; 2100end; 2101 2102function TPas2jsFilesCache.FileExistsLogged(const Filename: string): boolean; 2103begin 2104 Result:=FileExists(Filename); 2105 if ShowTriedUsedFiles then 2106 if Result then 2107 Log.LogMsgIgnoreFilter(nSearchingFileFound,[FormatPath(Filename)]) 2108 else 2109 Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]); 2110end; 2111 2112function TPas2jsFilesCache.GetOnReadDirectory: TReadDirectoryEvent; 2113begin 2114 Result:=DirectoryCache.OnReadDirectory; 2115end; 2116 2117function TPas2jsFilesCache.FileExistsILogged(var Filename: string): integer; 2118begin 2119 Result:=DirectoryCache.FileExistsI(Filename); 2120 if ShowTriedUsedFiles then 2121 if Result>0 then 2122 Log.LogMsgIgnoreFilter(nSearchingFileFound,[FormatPath(Filename)]) 2123 else 2124 Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]); 2125end; 2126 2127function TPas2jsFilesCache.SearchLowUpCase(var Filename: string): boolean; 2128var 2129 i: Integer; 2130{$IFNDEF CaseInsensitiveFilenames} 2131 CasedFilename: String; 2132{$ENDIF} 2133begin 2134 if StrictFileCase or SearchLikeFPC then 2135 begin 2136 if FileExistsLogged(Filename) then 2137 exit(true); 2138 if StrictFileCase then 2139 exit(false); 2140 {$IFNDEF CaseInsensitiveFilenames} 2141 // FPC like search: 2142 // first as written, then lowercase, then uppercase 2143 CasedFilename:=ExtractFilePath(Filename)+LowerCase(ExtractFileName(Filename)); 2144 if (Filename<>CasedFilename) and FileExistsLogged(CasedFilename) then 2145 begin 2146 Filename:=CasedFilename; 2147 exit(true); 2148 end; 2149 CasedFilename:=ExtractFilePath(Filename)+UpperCase(ExtractFileName(Filename)); 2150 if (Filename<>CasedFilename) and FileExistsLogged(CasedFilename) then 2151 begin 2152 Filename:=CasedFilename; 2153 exit(true); 2154 end; 2155 {$ENDIF} 2156 end else 2157 begin 2158 // search case insensitive 2159 i:=FileExistsILogged(Filename); 2160 if i=1 then exit(true); 2161 if i>1 then 2162 RaiseDuplicateFile(Filename); 2163 end; 2164 Result:=false; 2165end; 2166 2167end. 2168 2169