paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 21:59:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed crash on readonly projects

Browse Source 
git-svn-id: trunk@6409 -
This commit is contained in:
mattias 2004-12-23 00:33:43 +00:00
parent af94739be1
commit 03a3931754
2 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
ide/project.pp
View File

@ -380,7 +380,6 @@ type
fTargetFileExt: String; fTargetFileExt: String;
fUnitList: TList; // list of _all_ units (TUnitInfo) fUnitList: TList; // list of _all_ units (TUnitInfo)
FUpdateLock: integer; FUpdateLock: integer;
xmlconfig: TXMLConfig;
function GetFirstAutoRevertLockedUnit: TUnitInfo; function GetFirstAutoRevertLockedUnit: TUnitInfo;
function GetFirstLoadedUnit: TUnitInfo; function GetFirstLoadedUnit: TUnitInfo;
function GetFirstPartOfProject: TUnitInfo; function GetFirstPartOfProject: TUnitInfo;
@ -1173,7 +1172,6 @@ begin
inherited Create(ProjectDescription); inherited Create(ProjectDescription);
Assert(False, 'Trace:Project Class Created'); Assert(False, 'Trace:Project Class Created');
xmlconfig := nil;
//fProjectType:=TheProjectType; //fProjectType:=TheProjectType;
@ -1209,7 +1207,6 @@ begin
fDestroying:=true; fDestroying:=true;
Clear; Clear;
FreeThenNil(fBookmarks); FreeThenNil(fBookmarks);
FreeThenNil(xmlconfig);
FreeThenNil(fUnitList); FreeThenNil(fUnitList);
FreeThenNil(fJumpHistory); FreeThenNil(fJumpHistory);
FreeThenNil(fPublishOptions); FreeThenNil(fPublishOptions);
@ -1228,6 +1225,7 @@ function TProject.WriteProject(ProjectWriteFlags: TProjectWriteFlags;
var var
confPath: String; confPath: String;
Path: String; Path: String;
xmlconfig: TXMLConfig;
procedure SaveFlags; procedure SaveFlags;
var f: TProjectFlag; var f: TProjectFlag;
@ -1368,7 +1366,10 @@ begin
mtError,[mbRetry,mbAbort],0); mtError,[mbRetry,mbAbort],0);
end; end;
end; end;
xmlconfig.Free; try
xmlconfig.Free;
except
end;
xmlconfig:=nil; xmlconfig:=nil;
until Result<>mrRetry; until Result<>mrRetry;
end; end;
@ -1400,6 +1401,7 @@ var
OldSrcPath: String; OldSrcPath: String;
Path: String; Path: String;
OldProjectType: TOldProjectType; OldProjectType: TOldProjectType;
xmlconfig: TXMLConfig;
procedure LoadCompilerOptions; procedure LoadCompilerOptions;
var var
@ -1541,7 +1543,10 @@ begin
finally finally
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF} {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF}
fPathDelimChanged:=false; fPathDelimChanged:=false;
xmlconfig.Free; try
xmlconfig.Free;
except
end;
xmlconfig:=nil; xmlconfig:=nil;
end; end;
finally finally
@ -1654,8 +1659,6 @@ var i:integer;
begin begin
BeginUpdate(true); BeginUpdate(true);
FreeThenNil(xmlconfig);
// break and free removed dependencies // break and free removed dependencies
while FFirstRemovedDependency<>nil do while FFirstRemovedDependency<>nil do
DeleteRemovedDependency(FFirstRemovedDependency); DeleteRemovedDependency(FFirstRemovedDependency);
@ -3129,6 +3132,9 @@ end.
{ {
$Log$ $Log$
Revision 1.172 2004/12/23 00:33:43 mattias
fixed crash on readonly projects
Revision 1.171 2004/12/13 16:43:37 mattias Revision 1.171 2004/12/13 16:43:37 mattias
fixed loading project flags and added RTTI example for readonly properties fixed loading project flags and added RTTI example for readonly properties

5
lcl/controls.pp
View File

@ -1160,7 +1160,7 @@ type
AsLast: boolean); AsLast: boolean);
procedure RemoveHandlerOnChangeBounds(OnChangeBoundsEvent: TNotifyEvent); procedure RemoveHandlerOnChangeBounds(OnChangeBoundsEvent: TNotifyEvent);
public public
// standard properties, which should be supported by all descendents // standard properties, which should be supported by all descendants
property Action: TBasicAction read GetAction write SetAction; property Action: TBasicAction read GetAction write SetAction;
property Align: TAlign read FAlign write SetAlign; property Align: TAlign read FAlign write SetAlign;
property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored; property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored;
@ -2600,6 +2600,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.260 2004/12/23 00:33:43 mattias
fixed crash on readonly projects
Revision 1.259 2004/12/22 23:54:20 mattias Revision 1.259 2004/12/22 23:54:20 mattias
started TControl.AnchorSide started TControl.AnchorSide