paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-24 09:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: fixed directory cacher FindUnitSource

Browse Source 
git-svn-id: trunk@41202 -
This commit is contained in:
mattias 2013-05-15 08:04:34 +00:00
parent 3f6ef5ad82
commit 7f5a187f74
2 changed files with 56 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
components/codetools/directorycacher.pas
View File

@ -41,6 +41,7 @@ uses
{ $DEFINE CTDEBUG}
{ $DEFINE ShowTriedFiles}
{ $DEFINE ShowTriedUnits}
{ $DEFINE DebugDirCacheFindUnitSource}
{$ifdef Windows}
{$define CaseInsensitiveFilenames}
@ -372,20 +373,28 @@ function ComparePCharUnitNameWithFilename(UnitNameP, FilenameP: Pointer): intege
var
AUnitName: PChar absolute UnitNameP;
Filename: PChar absolute FilenameP;
cu: Char;
cf: Char;
begin
while (FPUpChars[AUnitName^]=FPUpChars[Filename^]) and (AUnitName^<>#0) do begin
inc(AUnitName);
inc(Filename);
end;
if (AUnitName^<>#0) then begin
Result:=ord(FPUpChars[AUnitName^])-ord(FPUpChars[Filename^]);
end else begin
// the unit name fits the start of the file name
if (Filename^<>'.') then
Result:=ord('.')-ord(FPUpChars[Filename^])
else
Result:=0;
end;
repeat
cu:=FPUpChars[AUnitName^];
cf:=FPUpChars[Filename^];
if cu=#0 then begin
// the unit name fits the start of the file name
if (cf<>'.') then
Result:=ord('.')-ord(cf)
else
Result:=0;
exit;
end;
if cu=cf then begin
inc(AUnitName);
inc(Filename);
end else begin
Result:=ord(cu)-ord(cf);
exit;
end;
until false;
end;
function SearchUnitInUnitLinks(const UnitLinks, TheUnitName: string;
@ -990,28 +999,35 @@ end;
function TCTDirectoryCache.FindUnitSource(const AUnitName: string;
AnyCase: boolean): string;
{$IFDEF DebugDirCacheFindUnitSource}
const
DebugUnitName = 'IDEDialogs';
DebugDirPart = 'ideintf';
{$ENDIF}
var
l: Integer;
r: Integer;
m: Integer;
cmp: LongInt;
CurFilename: PChar;
CurFilenameLen: LongInt;
Files: PChar;
p: PChar;
ExtStartPos: PChar;
begin
Result:='';
//if (CompareText(AUnitName,'AddFileToAPackageDlg')=0) {and (System.Pos('packager',directory)>0)} then
// DebugLn('TCTDirectoryCache.FindUnitSource AUnitName="',AUnitName,'" AnyCase=',dbgs(AnyCase),' Directory=',Directory);
{$IFDEF DebugDirCacheFindUnitSource}
if (CompareText(AUnitName,DebugUnitName)=0) and (System.Pos(DebugDirPart,directory)>0) then
DebugLn('TCTDirectoryCache.FindUnitSource AUnitName="',AUnitName,'" AnyCase=',dbgs(AnyCase),' Directory=',Directory);
{$ENDIF}
if AUnitName='' then exit;
if Directory<>'' then begin
UpdateListing;
Files:=FListing.Files;
if Files=nil then exit;
// binary search the nearest filename
//if (CompareText(AUnitName,'AddFileToAPackageDlg')=0) and (System.Pos('packager',directory)>0) then
// WriteListing;
{$IFDEF DebugDirCacheFindUnitSource}
if (CompareText(AUnitName,DebugUnitName)=0) and (System.Pos(DebugDirPart,directory)>0) then
WriteListing;
{$ENDIF}
l:=0;
r:=FListing.Count-1;
@ -1041,15 +1057,20 @@ begin
if (ComparePCharUnitNameWithFilename(Pointer(AUnitName),CurFilename)<>0)
then
break;
//if (CompareText(AUnitName,'AddFileToAPackageDlg')=0) {and (System.Pos('packager',directory)>0)} then
// DebugLn('TCTDirectoryCache.FindUnitSource NEXT ',CurFilename);
// check if the filename fits
CurFilenameLen:=strlen(CurFilename);
ExtStartPos:=CurFilename+length(AUnitname)+1;
ExtStartPos:=CurFilename+length(AUnitname);
{$IFDEF DebugDirCacheFindUnitSource}
if (CompareText(AUnitName,DebugUnitName)=0) and (System.Pos(DebugDirPart,directory)>0) then
DebugLn('TCTDirectoryCache.FindUnitSource NEXT "',CurFilename,'" ExtStart=',dbgstr(ExtStartPos^));
{$ENDIF}
if IsPascalUnitExt(ExtStartPos) then begin
// the extension is ok
Result:=CurFilename;
{$IFDEF DebugDirCacheFindUnitSource}
if (CompareText(AUnitName,DebugUnitName)=0) and (System.Pos(DebugDirPart,directory)>0) then
DebugLn('TCTDirectoryCache.FindUnitSource CHECKING CASE "',CurFilename,'"');
{$ENDIF}
if AnyCase then begin
exit;
end else begin
@ -1066,9 +1087,11 @@ begin
end;
inc(m);
end;
//if m<FListing.NameCount then
// if (CompareText(AUnitName,'AddFileToAPackageDlg')=0) and (System.Pos('packager',directory)>0) then
// DebugLn('TCTDirectoryCache.FindUnitSource LAST ',CurFilename);
{$IFDEF DebugDirCacheFindUnitSource}
if m<FListing.Count then
if (CompareText(AUnitName,DebugUnitName)=0) and (System.Pos(DebugDirPart,directory)>0) then
DebugLn('TCTDirectoryCache.FindUnitSource LAST ',CurFilename);
{$ENDIF}
end else begin
// this is a virtual directory
Result:=Pool.FindVirtualUnit(AUnitName);

23
components/codetools/fileprocs.pas
View File

@ -178,8 +178,7 @@ function FilenameIsPascalUnit(const Filename: string;
CaseSensitive: boolean = false): boolean;
function FilenameIsPascalUnit(Filename: PChar; FilenameLen: integer;
CaseSensitive: boolean = false): boolean;
function IsPascalUnitExt(FileExt: PChar;
CaseSensitive: boolean = false): boolean;
function IsPascalUnitExt(FileExt: PChar; CaseSensitive: boolean = false): boolean;
function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
function SearchPascalUnitInPath(const AnUnitName, BasePath, SearchPath,
@ -1025,44 +1024,36 @@ begin
end;
function IsPascalUnitExt(FileExt: PChar; CaseSensitive: boolean): boolean;
// check if asciiz FileExt is a CTPascalExtension
// check if asciiz FileExt is a CTPascalExtension '.pp', '.pas'
var
ExtLen: Integer;
p: PChar;
e: TCTPascalExtType;
i: Integer;
f: PChar;
begin
Result:=false;
if (FileExt=nil) then exit;
ExtLen:=0;
p:=FileExt;
while p^<>#0 do begin
inc(ExtLen);
inc(p);
end;
ExtLen:=strlen(FileExt);
if ExtLen=0 then exit;
for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin
if length(CTPascalExtension[e])<>ExtLen then
continue;
i:=0;
p:=PChar(Pointer(CTPascalExtension[e]));// pointer type cast avoids #0 check
f:=FileExt;
//debugln(['IsPascalUnitExt p="',dbgstr(p),'" f="',dbgstr(f),'"']);
if CaseSensitive then begin
while (i<ExtLen) and (p^=f^) do begin
inc(i);
while (p^=f^) and (p^<>#0) do begin
inc(p);
inc(f);
end;
end else begin
while (i<ExtLen) and (FPUpChars[p^]=FPUpChars[f^]) do
while (FPUpChars[p^]=FPUpChars[f^]) and (p^<>#0) do
begin
inc(i);
inc(p);
inc(f);
end;
end;
if (i=ExtLen) and (f^=#0) then
if p^=#0 then
exit(true);
end;
end;