Browse Source

* 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 -

Jonas Maebe 18 years ago
parent
commit
3fa669594a
1 changed files with 111 additions and 15 deletions
  1. 111 15
      compiler/cfileutl.pas

+ 111 - 15
compiler/cfileutl.pas

@@ -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:=PtrInt(DirectoryEntries.Find(Lower(AName)))
-        else
-          Attr:=PtrInt(DirectoryEntries.Find(AName));
+        Attr:=GetItemAttr(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:=PtrInt(DirectoryEntries.Find(Lower(AName)))
-        else
-          Attr:=PtrInt(DirectoryEntries.Find(AName));
+        Attr:=GetItemAttr(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
-               begin
-                 result:=true;
-                 exit;
-               end;
+{$ifdef usedircache}
+              if allowcache then
+                begin
+                  result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
+                  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