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

LCL: added more loop detections

Browse Source 
git-svn-id: trunk@26748 -
This commit is contained in:
mattias 2010-07-20 11:25:18 +00:00
parent c8ac54f916
commit f151a8c563
3 changed files with 60 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/controls.pp
View File

@ -1602,7 +1602,8 @@ type
wcfBoundsRealized, // bounds were sent to the interface
wcfUpdateShowing,
wcfHandleVisible,
wcfAdjustedLogicalClientRectValid
wcfAdjustedLogicalClientRectValid,
wcfKillIntfSetBounds
);
TWinControlFlags = set of TWinControlFlag;

6
lcl/include/control.inc
View File

@ -338,12 +338,8 @@ var
end;
procedure CheckLoop;
var
TopParent: TControl;
begin
TopParent:=Self;
while TopParent.Parent<>nil do TopParent:=TopParent.Parent;
if (not KeepBase) and (cfKillChangeBounds in TopParent.FControlFlags) then
if (not KeepBase) and (cfKillChangeBounds in GetTopParent.FControlFlags) then
raise Exception.Create('TControl.ChangeBounds loop detected '+DbgSName(Self)
+' Left='+dbgs(Left)+',Top='+dbgs(Top)+',Width='+dbgs(Width)+',Height='+dbgs(Height)
+' NewLeft='+dbgs(aLeft)+',NewTop='+dbgs(aTop)+',NewWidth='+dbgs(aWidth)+',NewHeight='+dbgs(aHeight)

59
lcl/include/wincontrol.inc
View File

@ -3442,6 +3442,9 @@ procedure TWinControl.DoAllAutoSize;
AWinControl.UpdateShowing;
end;
var
RealizeCounter: Integer;
UpdateShowingCounter: Integer;
begin
if wcfAllAutoSizing in FWinControlFlags then exit;
if AutoSizeDelayed then exit;
@ -3462,6 +3465,8 @@ begin
exit;
end;
RealizeCounter:=0;
UpdateShowingCounter:=0;
while (not AutoSizeDelayed) do
begin
// compute all sizes for LCL objects without touching the widgetset
@ -3475,8 +3480,13 @@ begin
{$IFDEF VerboseAllAutoSize}
DebugLn(['TWinControl.DoAllAutoSize REALIZE BOUNDS ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]);
{$ENDIF}
inc(RealizeCounter);
if RealizeCounter=100 then
Include(FWinControlFlags,wcfKillIntfSetBounds);
RealizeBoundsRecursive;
if (cfAutoSizeNeeded in FControlFlags) then continue; // repeat computing bounds
RealizeCounter:=0;
inc(UpdateShowingCounter);
// make child handles visible
{$IFDEF VerboseAllAutoSize}
DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]);
@ -3494,7 +3504,7 @@ begin
DebugLn(['TWinControl.DoAllAutoSize END ',DbgSName(Self),' ',dbgs(BoundsRect)]);
{$ENDIF}
finally
Exclude(FWinControlFlags,wcfAllAutoSizing);
FWinControlFlags:=FWinControlFlags-[wcfAllAutoSizing,wcfKillIntfSetBounds];
end;
// make handle visible => this can trigger events like Form.OnShow where
// application does arbitrary stuff
@ -6571,6 +6581,14 @@ end;
procedure TWinControl.WMMove(var Message: TLMMove);
var
NewWidth, NewHeight: Integer;
NewBoundsRealized: TRect;
TopParent: TControl;
procedure RaiseLoop;
begin
raise Exception.Create('TWinControl.WMMove loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized));
end;
begin
{$IF defined (VerboseSizeMsg) or defined(VerboseIntfSizing)}
if (Message.MoveType and Move_SourceIsInterface)>0 then
@ -6592,7 +6610,17 @@ begin
// skip size update when window is minimized
if HandleAllocated and (not IsIconic(Handle)) then
GetWindowSize(Handle, NewWidth, NewHeight);
FBoundsRealized := Bounds(Message.XPos, Message.YPos, NewWidth, NewHeight);
NewBoundsRealized:=Bounds(Message.XPos, Message.YPos, NewWidth, NewHeight);
if CompareRect(@NewBoundsRealized,@FBoundsRealized) then exit;
TopParent:=GetTopParent;
if (TopParent is TWinControl)
and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags)
then
RaiseLoop;
FBoundsRealized := NewBoundsRealized;
if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[])
then begin
// while the LCL is creating handles the widgetset may send default bounds
@ -6626,6 +6654,13 @@ procedure TWinControl.WMSize(var Message: TLMSize);
var
NewLeft, NewTop: integer;
NewBoundsRealized: TRect;
TopParent: TControl;
procedure RaiseLoop;
begin
raise Exception.Create('TWinControl.WMSize loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized));
end;
begin
{$IF defined(VerboseSizeMsg) or defined(CHECK_POSITION) or defined(VerboseIntfSizing)}
{$IFDEF CHECK_POSITION}
@ -6673,6 +6708,12 @@ begin
' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]);
{$ENDIF}
TopParent:=GetTopParent;
if (TopParent is TWinControl)
and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags)
then
RaiseLoop;
FBoundsRealized := NewBoundsRealized;
//DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]);
if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[])
@ -6722,6 +6763,13 @@ procedure TWinControl.WMWindowPosChanged(var Message: TLMWindowPosChanged);
var
NewLeft, NewTop, NewWidth, NewHeight: integer;
NewBoundsRealized: TRect;
TopParent: TControl;
procedure RaiseLoop;
begin
raise Exception.Create('TWinControl.WMWindowPosChanged loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized));
end;
begin
if Message.WindowPos=nil then exit;
@ -6766,6 +6814,13 @@ begin
' BoundsRealized=',dbgs(FBoundsRealized),
' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]);
{ $ENDIF}
TopParent:=GetTopParent;
if (TopParent is TWinControl)
and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags)
then
RaiseLoop;
FBoundsRealized := NewBoundsRealized;
//DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]);
if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[])