paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 07:50:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed crash in PackageGraphFindFPCUnit

Browse Source 
git-svn-id: trunk@8954 -
This commit is contained in:
mattias 2006-03-18 00:57:47 +00:00
parent f1671aa7a9
commit 1f0d4ffeee
4 changed files with 25 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
components/codetools/directorycacher.pas
View File

@ -509,10 +509,17 @@ end;
constructor TCTDirectoryCache.Create(const TheDirectory: string; constructor TCTDirectoryCache.Create(const TheDirectory: string;
ThePool: TCTDirectoryCachePool); ThePool: TCTDirectoryCachePool);
procedure RaiseDirNotAbsolute;
begin
raise Exception.Create('directory not absolute "'+FDirectory+'"');
end;
begin begin
FDirectory:=AppendPathDelim(TrimFilename(TheDirectory)); FDirectory:=AppendPathDelim(TrimFilename(TheDirectory));
if FDirectory='.' then FDirectory:='';
if (FDirectory<>'') and not FilenameIsAbsolute(FDirectory) then if (FDirectory<>'') and not FilenameIsAbsolute(FDirectory) then
raise Exception.Create('directory not absolute'); RaiseDirNotAbsolute;
FPool:=ThePool; FPool:=ThePool;
FRefCount:=1; FRefCount:=1;
end; end;
@ -522,7 +529,7 @@ var
UnitSrc: TCTDirectoryUnitSources; UnitSrc: TCTDirectoryUnitSources;
begin begin
ClearUnitLinks; ClearUnitLinks;
Pool.DoRemove(Self); if Pool<>nil then Pool.DoRemove(Self);
FreeAndNil(FListing); FreeAndNil(FListing);
for UnitSrc:=Low(TCTDirectoryUnitSources) to High(TCTDirectoryUnitSources) do for UnitSrc:=Low(TCTDirectoryUnitSources) to High(TCTDirectoryUnitSources) do
FreeAndNil(FUnitSources[UnitSrc].Files); FreeAndNil(FUnitSources[UnitSrc].Files);
@ -981,9 +988,17 @@ end;
function TCTDirectoryCachePool.FindUnitInUnitLinks(const Directory, function TCTDirectoryCachePool.FindUnitInUnitLinks(const Directory,
UnitName: string): string; UnitName: string): string;
procedure RaiseDirNotAbsolute;
begin
raise Exception.Create('TCTDirectoryCachePool.FindUnitInUnitLinks not absolute Directory="'+Directory+'"');
end;
var var
Cache: TCTDirectoryCache; Cache: TCTDirectoryCache;
begin begin
if (Directory<>'') and not FilenameIsAbsolute(Directory) then
RaiseDirNotAbsolute;
Cache:=GetCache(Directory,true,false); Cache:=GetCache(Directory,true,false);
Result:=Cache.FindUnitLink(UnitName); Result:=Cache.FindUnitLink(UnitName);
end; end;

2
ide/lazarusidestrconsts.pas
View File

@ -1094,7 +1094,7 @@ resourcestring
lisCOScanForFPCMessages = 'Scan for FPC messages'; lisCOScanForFPCMessages = 'Scan for FPC messages';
lisCOScanForMakeMessages = 'Scan for Make messages'; lisCOScanForMakeMessages = 'Scan for Make messages';
lisCOShowAllMessages = 'Show all messages'; lisCOShowAllMessages = 'Show all messages';
dlgUnitOutp = 'Unit output directory (-FE):'; dlgUnitOutp = 'Unit output directory (-FU):';
lisCOdefault = 'default (%s)'; lisCOdefault = 'default (%s)';
dlgButApply = 'Apply'; dlgButApply = 'Apply';
dlgCOShowOptions = 'Show Options'; dlgCOShowOptions = 'Show Options';

2
packager/packagesystem.pas
View File

@ -1746,6 +1746,8 @@ function TLazPackageGraph.FindFPCConflictUnit(APackage: TLazPackage;
begin begin
Result:=false; Result:=false;
if (Directory<>'') and not FilenameIsAbsolute(Directory) then
RaiseGDBException(Directory);
File1:=nil; File1:=nil;
ConflictPkg:=nil; ConflictPkg:=nil;
MarkAllPackagesAsNotVisited; MarkAllPackagesAsNotVisited;

7
packager/pkgmanager.pas
View File

@ -955,8 +955,11 @@ end;
procedure TPkgManager.PackageGraphFindFPCUnit(const UnitName, procedure TPkgManager.PackageGraphFindFPCUnit(const UnitName,
Directory: string; var Filename: string); Directory: string; var Filename: string);
begin begin
Filename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitLinks(UnitName, if (Directory<>'') and not FilenameIsAbsolute(Directory) then
Directory); RaiseGDBException(Directory);
//DebugLn('TPkgManager.PackageGraphFindFPCUnit "',Directory,'"');
Filename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitLinks(Directory,
UnitName);
end; end;
function TPkgManager.PackageGraphExplorerUninstallPackage(Sender: TObject; function TPkgManager.PackageGraphExplorerUninstallPackage(Sender: TObject;