paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-17 04:29:25 +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;
ThePool: TCTDirectoryCachePool);
procedure RaiseDirNotAbsolute;
begin
raise Exception.Create('directory not absolute "'+FDirectory+'"');
end;
begin
FDirectory:=AppendPathDelim(TrimFilename(TheDirectory));
if FDirectory='.' then FDirectory:='';
if (FDirectory<>'') and not FilenameIsAbsolute(FDirectory) then
raise Exception.Create('directory not absolute');
RaiseDirNotAbsolute;
FPool:=ThePool;
FRefCount:=1;
end;
@ -522,7 +529,7 @@ var
UnitSrc: TCTDirectoryUnitSources;
begin
ClearUnitLinks;
Pool.DoRemove(Self);
if Pool<>nil then Pool.DoRemove(Self);
FreeAndNil(FListing);
for UnitSrc:=Low(TCTDirectoryUnitSources) to High(TCTDirectoryUnitSources) do
FreeAndNil(FUnitSources[UnitSrc].Files);
@ -981,9 +988,17 @@ end;
function TCTDirectoryCachePool.FindUnitInUnitLinks(const Directory,
UnitName: string): string;
procedure RaiseDirNotAbsolute;
begin
raise Exception.Create('TCTDirectoryCachePool.FindUnitInUnitLinks not absolute Directory="'+Directory+'"');
end;
var
Cache: TCTDirectoryCache;
begin
if (Directory<>'') and not FilenameIsAbsolute(Directory) then
RaiseDirNotAbsolute;
Cache:=GetCache(Directory,true,false);
Result:=Cache.FindUnitLink(UnitName);
end;

2
ide/lazarusidestrconsts.pas
View File

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

2
packager/packagesystem.pas
View File

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

7
packager/pkgmanager.pas
View File

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