mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-16 02:50:40 +01:00
* Only start caching a directory once more than 20 lookups have been
done in it, to avoid caching very large current directories (such as
those of the testsuite) without reason. It would be better if that
decision were based on a fraction of the total number of entries in
each directory, but that information doesn not appear to be available
in a cross-platform way
git-svn-id: trunk@8938 -
This commit is contained in:
Jonas Maebe
parent
d2ecef925e
commit
71c314c550
@ -46,18 +46,26 @@ interface
|
||||
CUtils,CClasses,
|
||||
Systems;
|
||||
|
||||
const
|
||||
{ On case sensitive file systems, you have 9 lookups per used unit, }
|
||||
{ including the system unit, in the current directory }
|
||||
MinSearchesBeforeCache = 20;
|
||||
|
||||
type
|
||||
TCachedDirectory = class(TFPHashObject)
|
||||
private
|
||||
FDirectoryEntries : TFPHashList;
|
||||
FSearchCount: longint;
|
||||
procedure FreeDirectoryEntries;
|
||||
function GetItemAttr(const AName: TCmdStr): byte;
|
||||
function TryUseCache: boolean;
|
||||
procedure ForceUseCache;
|
||||
procedure Reload;
|
||||
public
|
||||
constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
|
||||
destructor destroy;override;
|
||||
procedure Reload;
|
||||
function FileExists(const AName:TCmdStr):boolean;
|
||||
function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
function FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
function DirectoryExists(const AName:TCmdStr):boolean;
|
||||
property DirectoryEntries:TFPHashList read FDirectoryEntries;
|
||||
end;
|
||||
@ -84,7 +92,7 @@ interface
|
||||
constructor Create;
|
||||
destructor destroy;override;
|
||||
function FileExists(const AName:TCmdStr):boolean;
|
||||
function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
function FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
function DirectoryExists(const AName:TCmdStr):boolean;
|
||||
function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
|
||||
function FindNext(var Res:TCachedSearchRec):boolean;
|
||||
@ -175,6 +183,32 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function TCachedDirectory.TryUseCache:boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
if (FSearchCount > MinSearchesBeforeCache) then
|
||||
exit;
|
||||
if (FSearchCount = MinSearchesBeforeCache) then
|
||||
begin
|
||||
inc(FSearchCount);
|
||||
Reload;
|
||||
exit;
|
||||
end;
|
||||
inc(FSearchCount);
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCachedDirectory.ForceUseCache;
|
||||
begin
|
||||
if (FSearchCount<=MinSearchesBeforeCache) then
|
||||
begin
|
||||
FSearchCount:=MinSearchesBeforeCache+1;
|
||||
Reload;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCachedDirectory.FreeDirectoryEntries;
|
||||
var
|
||||
i: Integer;
|
||||
@ -243,6 +277,12 @@ implementation
|
||||
var
|
||||
Attr : Longint;
|
||||
begin
|
||||
if not TryUseCache then
|
||||
begin
|
||||
{ prepend directory name again }
|
||||
result:=cfileutl.FileExists(Name+AName,false);
|
||||
exit;
|
||||
end;
|
||||
Attr:=GetItemAttr(AName);
|
||||
if Attr<>0 then
|
||||
Result:=((Attr and faDirectory)=0)
|
||||
@ -251,25 +291,28 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function TCachedDirectory.FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
function TCachedDirectory.FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
var
|
||||
entry : PCachedDirectoryEntry;
|
||||
Attr : Longint;
|
||||
begin
|
||||
if (tf_files_case_aware in source_info.flags) then
|
||||
begin
|
||||
entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
|
||||
if assigned(entry) then
|
||||
if not TryUseCache then
|
||||
begin
|
||||
Attr:=entry^.Attr;
|
||||
FoundName:=entry^.RealName
|
||||
Result:=FileExistsNonCase(path,fn,false,FoundName);
|
||||
exit;
|
||||
end;
|
||||
entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(ExtractFileName(fn))));
|
||||
if assigned(entry) and
|
||||
(entry^.Attr<>0) and
|
||||
((entry^.Attr and faDirectory) = 0) then
|
||||
begin
|
||||
FoundName:=ExtractFilePath(path+fn)+entry^.RealName;
|
||||
Result:=true
|
||||
end
|
||||
else
|
||||
Attr:=0;
|
||||
if Attr<>0 then
|
||||
Result:=((Attr and faDirectory)=0)
|
||||
else
|
||||
Result:=false
|
||||
Result:=false;
|
||||
end
|
||||
else
|
||||
{ should not be called in this case, use plain FileExists }
|
||||
@ -281,6 +324,11 @@ implementation
|
||||
var
|
||||
Attr : Longint;
|
||||
begin
|
||||
if not TryUseCache then
|
||||
begin
|
||||
Result:=PathExists(Name+AName,false);
|
||||
exit;
|
||||
end;
|
||||
Attr:=GetItemAttr(AName);
|
||||
if Attr<>0 then
|
||||
Result:=((Attr and faDirectory)=faDirectory)
|
||||
@ -313,15 +361,12 @@ implementation
|
||||
DirName : TCmdStr;
|
||||
begin
|
||||
if ADir='' then
|
||||
DirName:='.'
|
||||
DirName:='.'+source_info.DirSep
|
||||
else
|
||||
DirName:=ADir;
|
||||
CachedDir:=TCachedDirectory(FDirectories.Find(DirName));
|
||||
if not assigned(CachedDir) then
|
||||
begin
|
||||
CachedDir:=TCachedDirectory.Create(FDirectories,DirName);
|
||||
CachedDir.Reload;
|
||||
end;
|
||||
CachedDir:=TCachedDirectory.Create(FDirectories,DirName);
|
||||
Result:=CachedDir;
|
||||
end;
|
||||
|
||||
@ -331,24 +376,20 @@ implementation
|
||||
CachedDir : TCachedDirectory;
|
||||
begin
|
||||
Result:=false;
|
||||
CachedDir:=GetDirectory(ExtractFileDir(AName));
|
||||
CachedDir:=GetDirectory(ExtractFilePath(AName));
|
||||
if assigned(CachedDir) then
|
||||
Result:=CachedDir.FileExists(ExtractFileName(AName));
|
||||
end;
|
||||
|
||||
|
||||
function TDirectoryCache.FileExistsCaseAware(const AName:TCmdStr; out FoundName:TCmdStr):boolean;
|
||||
function TDirectoryCache.FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean;
|
||||
var
|
||||
CachedDir : TCachedDirectory;
|
||||
begin
|
||||
Result:=false;
|
||||
CachedDir:=GetDirectory(ExtractFileDir(AName));
|
||||
CachedDir:=GetDirectory(ExtractFilePath(path+fn));
|
||||
if assigned(CachedDir) then
|
||||
begin
|
||||
Result:=CachedDir.FileExistsCaseAware(ExtractFileName(AName),FoundName);
|
||||
if Result then
|
||||
FoundName:=ExtractFilePath(AName)+FoundName;
|
||||
end;
|
||||
Result:=CachedDir.FileExistsCaseAware(path,fn,FoundName);
|
||||
end;
|
||||
|
||||
|
||||
@ -367,6 +408,7 @@ implementation
|
||||
begin
|
||||
Res.Pattern:=ExtractFileName(APattern);
|
||||
Res.CachedDir:=GetDirectory(ExtractFilePath(APattern));
|
||||
Res.CachedDir.ForceUseCache;
|
||||
Res.EntryIndex:=0;
|
||||
if assigned(Res.CachedDir) then
|
||||
Result:=FindNext(Res)
|
||||
@ -538,11 +580,10 @@ implementation
|
||||
Search order for case aware systems:
|
||||
1. NormalCase
|
||||
}
|
||||
FoundFile:=path+fn;
|
||||
{$ifdef usedircache}
|
||||
if allowcache then
|
||||
begin
|
||||
result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
|
||||
result:=DirCache.FileExistsCaseAware(path,fn,fn2);
|
||||
if result then
|
||||
begin
|
||||
FoundFile:=fn2;
|
||||
@ -551,12 +592,15 @@ implementation
|
||||
end
|
||||
else
|
||||
{$endif usedircache}
|
||||
If FileExists(FoundFile,allowcache) then
|
||||
begin
|
||||
{ don't know the real name in this case }
|
||||
result:=true;
|
||||
exit;
|
||||
end;
|
||||
begin
|
||||
FoundFile:=path+fn;
|
||||
If FileExists(FoundFile,allowcache) then
|
||||
begin
|
||||
{ don't know the real name in this case }
|
||||
result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user