Cannot close AnchorDocking application

[Ludovic de Jouvencel]

Hello,

I have tried to use the Anchor Docking library, but it really sucks  .

If I "dock" at least two windows in the docking site, I cannot close the application without an exception 'External:  SIGSEGV' in the file 'anchordocking.pas' at line 4026: and DockMaster.ShowHeader;

Indeed, the finalize block of the file 'anchordocking.pas' destroy the DockMaster object, but inside the destructor, the object is set to nil, before being used again.

This is what happens:

Code: [Select]

destructor TAnchorDockHostSite.Destroy;
//var i: Integer;
begin
  //debugln(['TAnchorDockHostSite.Destroy ',DbgSName(Self),' Caption="',Caption,'" Self=',dbgs(Pointer(Self)),' ComponentCount=',ComponentCount,' ControlCount=',ControlCount]);
  {for i:=0 to ComponentCount-1 do
    debugln(['TAnchorDockHostSite.Destroy Component ',i,'/',ComponentCount,' ',DbgSName(Components[i])]);
  for i:=0 to ControlCount-1 do
    debugln(['TAnchorDockHostSite.Destroy Control ',i,'/',ControlCount,' ',DbgSName(Controls[i])]);}
  FreeAndNil(FPages);
  inherited Destroy;
end;
then

Code: [Select]

destructor TWinControl.Destroy;
var
  n: Integer;
  Control: TControl;
begin
  //DebugLn('[TWinControl.Destroy] A  ',Name,':',ClassName);
  // prevent parent to try to focus a to be destroyed control
  if Parent <> nil then
    RemoveFocus(true);
  if HandleAllocated then
    DestroyHandle;
  //DebugLn('[TWinControl.Destroy] B  ',Name,':',ClassName);

  //for n:=0 to ComponentCount-1 do
  //  DebugLn('  n=',n,' ',Components[n].ClassName);

  n := ControlCount;

  while n > 0 do
  begin
    Control := Controls[n - 1];
    //DebugLn('[TWinControl.Destroy] C  ',Name,':',ClassName,' ',Control.Name,':',Control.ClassName);
    Remove(Control); // this sets Control.Parent to nil
    //DebugLn(['TWinControl.Destroy ',DbgSName(Control.HostDockSite)]);
    if Control.HostDockSite = Self then
      Control.HostDockSite := nil;
    // don't free the control, controls are freed by the owner
    n := ControlCount;
  end;

  // undock controls that use this as HostDockSite
  while DockClientCount>0 do begin
    Control:=DockClients[DockClientCount-1];
    //DebugLn(['TWinControl.Destroy ',DbgSName(Self),' undocking ',DbgSName(Control)]);
    Control.HostDockSite:=nil;
  end;

  FreeAndNil(FAlignOrder);
  FreeThenNil(FBrush);
  FreeThenNil(FChildSizing);
  if (FDockManager<>nil) then
    if FDockManager.AutoFreeByControl then
      FreeThenNil(FDockManager)
    else
      FDockManager:=nil;
  FreeThenNil(FDockClients);
  FreeThenNil(FTabList);
  //DebugLn('[TWinControl.Destroy] D  ',Name,':',ClassName);
  inherited Destroy;
  //DebugLn('[TWinControl.Destroy] END  ',Name,':',ClassName);
end;
This code unassigns the DockMaster here : FreeThenNil(FDockManager)

Then

Code: [Select]

destructor TControl.Destroy;
var
  HandlerType: TControlHandlerType;
  Side: TAnchorKind;
  i: Integer;
  CurAnchorSide: TAnchorSide;
begin
  //DebugLn('[TControl.Destroy] A ',Name,':',ClassName);
  // make sure the capture is released
  MouseCapture := False;
  // explicit notification about component destruction. this can be a drag target
  DragManager.Notification(Self, opRemove);
  Application.ControlDestroyed(Self);
  if (FHostDockSite <> nil) and not (csDestroying in FHostDockSite.ComponentState) then
  begin
    FHostDockSite.DoUndockClientMsg(nil, Self);
    SetParent(nil);
    Dock(nil, BoundsRect);
    FHostDockSite := nil;
  end else
  begin
    if Assigned(FHostDockSite) and Assigned(FHostDockSite.FDockClients) then
    begin
      FHostDockSite.FDockClients.Remove(Self);
      FHostDockSite := nil;
    end;
    SetParent(nil);
  end;
  if FAnchoredControls <> nil then
  begin
    for i := 0 to FAnchoredControls.Count - 1 do
      for Side := Low(TAnchorKind) to High(TAnchorKind) do
      begin
        CurAnchorSide := AnchoredControls[i].AnchorSide[Side];
        if (CurAnchorSide<>nil) and (CurAnchorSide.FControl = Self) then
          CurAnchorSide.FControl := nil;
      end;
    FreeThenNil(FAnchoredControls);
  end;
  FreeThenNil(FActionLink);
  for Side := Low(FAnchorSides) to High(FAnchorSides) do
    FreeThenNil(FAnchorSides[Side]);
  FreeThenNil(FBorderSpacing);
  FreeThenNil(FConstraints);
  FreeThenNil(FFont);
  FreeThenNil(FAccessibleObject);
  //DebugLn('[TControl.Destroy] B ',DbgSName(Self));
  inherited Destroy;
  //DebugLn('[TControl.Destroy] END ',DbgSName(Self));
  for HandlerType := Low(TControlHandlerType) to High(TControlHandlerType) do
    FreeThenNil(FControlHandlers[HandlerType]);
  {$IFDEF DebugDisableAutoSizing}
  FreeAndNil(FAutoSizingLockReasons);
  {$ENDIF}
end;              

Then

Code: [Select]

procedure TAnchorDockHostSite.SetParent(NewParent: TWinControl);
var
  OldCaption: string;
  OldParent: TWinControl;
begin
  OldParent:=Parent;
  if NewParent=OldParent then exit;
  inherited SetParent(NewParent);
  OldCaption:=Caption;
  UpdateDockCaption;
  if OldCaption<>Caption then begin
    // UpdateDockCaption has not updated parents => do it now
    if Parent is TAnchorDockHostSite then
      TAnchorDockHostSite(Parent).UpdateDockCaption;
    if Parent is TAnchorDockPage then
      TAnchorDockPage(Parent).UpdateDockCaption;
  end;
  UpdateHeaderShowing;

  if (BoundSplitter<>nil) and (BoundSplitter.Parent<>Parent) then begin
    //debugln(['TAnchorDockHostSite.SetParent freeing splitter: ',DbgSName(BoundSplitter)]);
    FreeAndNil(FBoundSplitter);
  end;
  if Parent=nil then
    BorderStyle:=bsSizeable
  else
    BorderStyle:=bsNone;
end;     
Then

Code: [Select]

procedure TAnchorDockHostSite.UpdateHeaderShowing;
begin
  if Header=nil then exit;
  if HeaderNeedsShowing then
    Header.Parent:=Self
  else
    Header.Parent:=nil;
end; 
Then

Code: [Select]

function TAnchorDockHostSite.HeaderNeedsShowing: boolean;
begin
  Result:=(SiteType<>adhstLayout)
      and (not (Parent is TAnchorDockPage))
      and DockMaster.ShowHeader;
end;
But DockMaster is nil

So it crashes, and it happens in the sample code, so I don't understand why this bug has not been found/fixed 

[JuhaManninen]

So it crashes, and it happens in the sample code, so I don't understand why this bug has not been found/fixed

Maybe because nobody noticed it. Or, maybe someone noticed but was too lazy to fix it and send a patch.
Which sample code crashes?
Could you please test if the following change helps. If yes, then I will apply it.

Code: [Select]

function TAnchorDockHostSite.HeaderNeedsShowing: boolean;
begin
  Result:=(SiteType<>adhstLayout)
      and (not (Parent is TAnchorDockPage))
      and Assigned(DockMaster) and DockMaster.ShowHeader;
end;

The recommended way to fix bugs is to create a patch and attach it to a bug report.
Bug report with a patch have a high priority.

Regards,
Juha

[Ludovic de Jouvencel]

Maybe because nobody noticed it. Or, maybe someone noticed but was too lazy to fix it and send a patch.
Which sample code crashes?

I see only one sample code, you'll find it in "...\lazarus\components\anchordocking\minide", so it is not possible that nobody noticed it. Indeed, the developper of this code surely knows that it crashes.

Could you please test if the following change helps. If yes, then I will apply it.

I don't know... the way I fixed it concerns the TAnchorDockHostSite.SetParent method, I have added one test:

Code: [Select]

procedure TAnchorDockHostSite.SetParent(NewParent: TWinControl);
var
  OldCaption: string;
  OldParent: TWinControl;
begin
  OldParent:=Parent;
  if NewParent=OldParent then exit;
  inherited SetParent(NewParent);

  (* here my fix *)
  if Not Assigned(NewParent) And Not Assigned(DockMaster) Then exit;
  ...

 

And I have encounter one more crash issue: when the Interfaces unit is used after the AnchorDockPkg unit in the main project file, the application crashes at closing in the method

Code: [Select]

destructor TAnchorDockMaster.Destroy; at the line

Code: [Select]

FreeAndNil(fCloseBtnBitmap);
So, don't do things like

Code: [Select]

uses
   Forms, anchordockpkg, Interfaces,
   Unit1, ... ;

in your project file, but always do:

Code: [Select]

uses
   Forms, Interfaces,  anchordockpkg,
   Unit1, ... ;


[JanRoza]

Why so much anger in your message? You can also report a bug in a friendly way. Maybe the bug was not reported because no one used this component until you did. So you reported a bug and one of the developers makes a friendly suggestion and is even willing to go after this bug. I think that deserves a  instead of a 
 

[Ludovic de Jouvencel]

The is for those who distribute the AnchorDocking API which doesn't work at all. I'm new here so I am quite a naive developper, I thought that softwares were tested before being distributed.

Anyway, all my appologize, please understand that my did not concern the person that made a friendly suggestion, even if this person didn't make any effort to find the unique sample, and proposed an inefficient resolution for that bug.   

[Martin_fr]

The code that you found crashing, probably once worked.

And it was probably not changed since it worked. Some other code, somewhere else may have been changed, and as a result of that the bug was introduced.
And yes, the code you tried to use, then escaped the proper testing.

Well, we try to test things as good as possible. But there are very few regular developers. And Lazarus is not a commercial enterprise, so developers do not get paid for the work[1]. They spent the day on a regular job, and only have a few hours over the week to spent on Lazarus.
In that time, more than a million lines of code must be maintained, fixed, extended, tested ...

[1]This is *NOT* to say, that we do not want to test. We do. It only explains that we have to fit it into very limited time.