Browse Source

pastojs: fixed invalidate directory cache

mattias 3 years ago
parent
commit
6c1c4a66e8

+ 25 - 4
packages/pastojs/src/pas2jsfilecache.pp

@@ -65,7 +65,7 @@ type
   private
   private
     FChangeStamp: TChangeStamp;
     FChangeStamp: TChangeStamp;
     FPath: string;
     FPath: string;
-    FEntries: TFPList; // list of TPas2jsCachedDirectoryEntry
+    FEntries: TFPList; // list of TPas2jsCachedDirectoryEntry, sorted first case insensitive then sensitive
     FPool: TPas2jsCachedDirectories;
     FPool: TPas2jsCachedDirectories;
     FRefCount: integer;
     FRefCount: integer;
     FSorted: boolean;
     FSorted: boolean;
@@ -78,6 +78,7 @@ type
     destructor Destroy; override;
     destructor Destroy; override;
     function Count: integer;
     function Count: integer;
     procedure Clear;
     procedure Clear;
+    procedure Invalidate; inline;
     property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp
     property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp
     function NeedsUpdate: boolean;
     function NeedsUpdate: boolean;
     procedure Update;
     procedure Update;
@@ -132,6 +133,7 @@ type
     destructor Destroy; override;
     destructor Destroy; override;
     property ChangeStamp: TChangeStamp read FChangeStamp;
     property ChangeStamp: TChangeStamp read FChangeStamp;
     procedure Invalidate; inline;
     procedure Invalidate; inline;
+    procedure InvalidateDirectory(const aDirectory: string); virtual;
     procedure Clear;
     procedure Clear;
     function DirectoryExists(Filename: string): boolean;
     function DirectoryExists(Filename: string): boolean;
     function FileExists(Filename: string): boolean;
     function FileExists(Filename: string): boolean;
@@ -290,10 +292,9 @@ type
     Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override;
     Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override;
     function TryCreateRelativePath(const Filename, BaseDirectory: String;
     function TryCreateRelativePath(const Filename, BaseDirectory: String;
       UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; override;
       UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; override;
-  Protected
-    property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache;
   public
   public
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
+    property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache;
     property ForeignUnitPaths: TStringList read FForeignUnitPaths;
     property ForeignUnitPaths: TStringList read FForeignUnitPaths;
     property ResourcePaths : TStringList read FResourcePaths;
     property ResourcePaths : TStringList read FResourcePaths;
     property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
     property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
@@ -593,6 +594,11 @@ begin
   FSorted:=true;
   FSorted:=true;
 end;
 end;
 
 
+procedure TPas2jsCachedDirectory.Invalidate;
+begin
+  FChangeStamp:=InvalidChangeStamp;
+end;
+
 procedure TPas2jsCachedDirectory.Update;
 procedure TPas2jsCachedDirectory.Update;
 begin
 begin
   if not NeedsUpdate then exit;
   if not NeedsUpdate then exit;
@@ -890,7 +896,22 @@ end;
 
 
 procedure TPas2jsCachedDirectories.Invalidate;
 procedure TPas2jsCachedDirectories.Invalidate;
 begin
 begin
-  IncreaseChangeStamp(FChangeStamp);
+  FChangeStamp:=IncreaseChangeStamp(FChangeStamp);
+end;
+
+procedure TPas2jsCachedDirectories.InvalidateDirectory(const aDirectory: string
+  );
+var
+  Dir: String;
+  CacheDir: TPas2jsCachedDirectory;
+begin
+  Dir:=ResolveDots(aDirectory);
+  if not FilenameIsAbsolute(Dir) then
+    Dir:=WorkingDirectory+Dir;
+  Dir:=IncludeTrailingPathDelimiter(Dir);
+  CacheDir:=TPas2jsCachedDirectory(FDirectories.FindKey(Pointer(Dir)));
+  if CacheDir=nil then exit;
+  CacheDir.Invalidate;
 end;
 end;
 
 
 procedure TPas2jsCachedDirectories.Clear;
 procedure TPas2jsCachedDirectories.Clear;

+ 1 - 1
packages/pastojs/src/pas2jspcucompiler.pp

@@ -240,7 +240,7 @@ function TFilerPCUSupport.FindPCU(const UseUnitName: string;
   end;
   end;
 
 
 var
 var
-  L: TstringList;
+  L: TStringList;
   i: Integer;
   i: Integer;
 
 
 begin
 begin

+ 1 - 1
packages/pastojs/tests/tcunitsearch.pas

@@ -466,7 +466,7 @@ begin
   try
   try
     try
     try
       //writeln('TCustomTestCLI.Compile WorkDir=',WorkDir);
       //writeln('TCustomTestCLI.Compile WorkDir=',WorkDir);
-      Compiler.Run(CompilerExe,WorkDir,Params,false);
+      Compiler.Run(CompilerExe,WorkDir,Params,true);
     except
     except
       on E: ECompilerTerminate do
       on E: ECompilerTerminate do
       begin
       begin