mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-20 10:09:17 +02:00
* store the original filename on case-aware systems in the dircache, so
we can return it from FileExistsNonCase in case of {$define usedircache} (which is the default). This is needed so we write the correct file names in the debug info, which is required by gdb (mantis #9172) git-svn-id: trunk@7879 -
This commit is contained in:
parent
b8822c88b5
commit
3fa669594a
@ -50,11 +50,14 @@ interface
|
|||||||
TCachedDirectory = class(TFPHashObject)
|
TCachedDirectory = class(TFPHashObject)
|
||||||
private
|
private
|
||||||
FDirectoryEntries : TFPHashList;
|
FDirectoryEntries : TFPHashList;
|
||||||
|
procedure FreeDirectoryEntries;
|
||||||
|
function GetItemAttr(const AName: TCmdStr): byte;
|
||||||
public
|
public
|
||||||
constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
|
constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
|
||||||
destructor destroy;override;
|
destructor destroy;override;
|
||||||
procedure Reload;
|
procedure Reload;
|
||||||
function FileExists(const AName:TCmdStr):boolean;
|
function FileExists(const AName:TCmdStr):boolean;
|
||||||
|
function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
||||||
function DirectoryExists(const AName:TCmdStr):boolean;
|
function DirectoryExists(const AName:TCmdStr):boolean;
|
||||||
property DirectoryEntries:TFPHashList read FDirectoryEntries;
|
property DirectoryEntries:TFPHashList read FDirectoryEntries;
|
||||||
end;
|
end;
|
||||||
@ -67,6 +70,12 @@ interface
|
|||||||
EntryIndex : longint;
|
EntryIndex : longint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
PCachedDirectoryEntry = ^TCachedDirectoryEntry;
|
||||||
|
TCachedDirectoryEntry = record
|
||||||
|
RealName: TCmdStr;
|
||||||
|
Attr : byte;
|
||||||
|
end;
|
||||||
|
|
||||||
TDirectoryCache = class
|
TDirectoryCache = class
|
||||||
private
|
private
|
||||||
FDirectories : TFPHashObjectList;
|
FDirectories : TFPHashObjectList;
|
||||||
@ -75,6 +84,7 @@ interface
|
|||||||
constructor Create;
|
constructor Create;
|
||||||
destructor destroy;override;
|
destructor destroy;override;
|
||||||
function FileExists(const AName:TCmdStr):boolean;
|
function FileExists(const AName:TCmdStr):boolean;
|
||||||
|
function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
||||||
function DirectoryExists(const AName:TCmdStr):boolean;
|
function DirectoryExists(const AName:TCmdStr):boolean;
|
||||||
function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
|
function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
|
||||||
function FindNext(var Res:TCachedSearchRec):boolean;
|
function FindNext(var Res:TCachedSearchRec):boolean;
|
||||||
@ -136,15 +146,49 @@ implementation
|
|||||||
|
|
||||||
destructor TCachedDirectory.destroy;
|
destructor TCachedDirectory.destroy;
|
||||||
begin
|
begin
|
||||||
|
FreeDirectoryEntries;
|
||||||
FDirectoryEntries.Free;
|
FDirectoryEntries.Free;
|
||||||
inherited destroy;
|
inherited destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TCachedDirectory.FreeDirectoryEntries;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
if not(tf_files_case_aware in source_info.flags) then
|
||||||
|
exit;
|
||||||
|
for i := 0 to DirectoryEntries.Count-1 do
|
||||||
|
dispose(PCachedDirectoryEntry(DirectoryEntries[i]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TCachedDirectory.GetItemAttr(const AName: TCmdStr): byte;
|
||||||
|
var
|
||||||
|
entry: PCachedDirectoryEntry;
|
||||||
|
begin
|
||||||
|
if not(tf_files_case_sensitive in source_info.flags) then
|
||||||
|
if (tf_files_case_aware in source_info.flags) then
|
||||||
|
begin
|
||||||
|
entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
|
||||||
|
if assigned(entry) then
|
||||||
|
Result:=entry^.Attr
|
||||||
|
else
|
||||||
|
Result:=0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result:=PtrInt(DirectoryEntries.Find(Lower(AName)))
|
||||||
|
else
|
||||||
|
Result:=PtrInt(DirectoryEntries.Find(AName));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TCachedDirectory.Reload;
|
procedure TCachedDirectory.Reload;
|
||||||
var
|
var
|
||||||
dir : TSearchRec;
|
dir : TSearchRec;
|
||||||
|
entry : PCachedDirectoryEntry;
|
||||||
begin
|
begin
|
||||||
|
FreeDirectoryEntries;
|
||||||
DirectoryEntries.Clear;
|
DirectoryEntries.Clear;
|
||||||
if findfirst(IncludeTrailingPathDelimiter(Name)+'*',faAnyFile or faDirectory,dir) = 0 then
|
if findfirst(IncludeTrailingPathDelimiter(Name)+'*',faAnyFile or faDirectory,dir) = 0 then
|
||||||
begin
|
begin
|
||||||
@ -154,7 +198,15 @@ implementation
|
|||||||
(dir.Name<>'..') then
|
(dir.Name<>'..') then
|
||||||
begin
|
begin
|
||||||
if not(tf_files_case_sensitive in source_info.flags) then
|
if not(tf_files_case_sensitive in source_info.flags) then
|
||||||
DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
|
if (tf_files_case_aware in source_info.flags) then
|
||||||
|
begin
|
||||||
|
new(entry);
|
||||||
|
entry^.RealName:=Dir.Name;
|
||||||
|
entry^.Attr:=Dir.Attr;
|
||||||
|
DirectoryEntries.Add(Lower(Dir.Name),entry)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
|
||||||
else
|
else
|
||||||
DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
|
DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
|
||||||
end;
|
end;
|
||||||
@ -168,10 +220,7 @@ implementation
|
|||||||
var
|
var
|
||||||
Attr : Longint;
|
Attr : Longint;
|
||||||
begin
|
begin
|
||||||
if not(tf_files_case_sensitive in source_info.flags) then
|
Attr:=GetItemAttr(AName);
|
||||||
Attr:=PtrInt(DirectoryEntries.Find(Lower(AName)))
|
|
||||||
else
|
|
||||||
Attr:=PtrInt(DirectoryEntries.Find(AName));
|
|
||||||
if Attr<>0 then
|
if Attr<>0 then
|
||||||
Result:=((Attr and faDirectory)=0)
|
Result:=((Attr and faDirectory)=0)
|
||||||
else
|
else
|
||||||
@ -179,14 +228,37 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TCachedDirectory.FileExistsCaseAware(const AName: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
|
||||||
|
begin
|
||||||
|
Attr:=entry^.Attr;
|
||||||
|
FoundName:=entry^.RealName
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Attr:=0;
|
||||||
|
if Attr<>0 then
|
||||||
|
Result:=((Attr and faDirectory)=0)
|
||||||
|
else
|
||||||
|
Result:=false
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{ should not be called in this case, use plain FileExists }
|
||||||
|
Result:=False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean;
|
function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean;
|
||||||
var
|
var
|
||||||
Attr : Longint;
|
Attr : Longint;
|
||||||
begin
|
begin
|
||||||
if not(tf_files_case_sensitive in source_info.flags) then
|
Attr:=GetItemAttr(AName);
|
||||||
Attr:=PtrInt(DirectoryEntries.Find(Lower(AName)))
|
|
||||||
else
|
|
||||||
Attr:=PtrInt(DirectoryEntries.Find(AName));
|
|
||||||
if Attr<>0 then
|
if Attr<>0 then
|
||||||
Result:=((Attr and faDirectory)=faDirectory)
|
Result:=((Attr and faDirectory)=faDirectory)
|
||||||
else
|
else
|
||||||
@ -242,6 +314,17 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDirectoryCache.FileExistsCaseAware(const AName:TCmdStr; out FoundName:TCmdStr):boolean;
|
||||||
|
var
|
||||||
|
CachedDir : TCachedDirectory;
|
||||||
|
begin
|
||||||
|
Result:=false;
|
||||||
|
CachedDir:=GetDirectory(ExtractFileDir(AName));
|
||||||
|
if assigned(CachedDir) then
|
||||||
|
Result:=CachedDir.FileExistsCaseAware(ExtractFileName(AName),FoundName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean;
|
function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean;
|
||||||
var
|
var
|
||||||
CachedDir : TCachedDirectory;
|
CachedDir : TCachedDirectory;
|
||||||
@ -418,11 +501,24 @@ implementation
|
|||||||
1. NormalCase
|
1. NormalCase
|
||||||
}
|
}
|
||||||
FoundFile:=path+fn;
|
FoundFile:=path+fn;
|
||||||
If FileExists(FoundFile,allowcache) then
|
{$ifdef usedircache}
|
||||||
begin
|
if allowcache then
|
||||||
result:=true;
|
begin
|
||||||
exit;
|
result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
|
||||||
end;
|
if (result) then
|
||||||
|
begin
|
||||||
|
FoundFile:=path+fn2;
|
||||||
|
exit
|
||||||
|
end
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{$endif usedircache}
|
||||||
|
If FileExists(FoundFile,allowcache) then
|
||||||
|
begin
|
||||||
|
{ don't know the real name in this case }
|
||||||
|
result:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user