Crash when deleting Graphics32 layers

Question

I've hit an issue when trying to delete layers using Graphics32. It seems that unless you delete layers in reverse order (from the last added to the first) an exception is thrown. I created the simplest application to test this and it is repeatable every time.

I created a simple form with a TImgView32 component (properties all at default) then a button which does the following:

procedure TMainForm.btnDeleteTestClick(Sender: TObject);
var
  Layer1: TCustomLayer;
  Layer2: TCustomLayer;
begin
  Layer1 := TCustomLayer.Create(ImageView.Layers);
  Layer2 := TCustomLayer.Create(ImageView.Layers);

  Layer1.Free;
  Layer2.Free;
end;

If I reverse the order (Layer2.Free then Layer1.Free) it works fine, but this way round it crashes every time. It's also the same whether I use TCustomLayer, TPositionedLayer, TBitmapLayer, or whatever.

I've traved the error and the fault seems to originate here:

function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin 
  with FBuckets[BucketIndex] do begin 
    Result := Items[ItemIndex].Data; 
    if FCount = 0 then Exit; 
    Dec(Count); 
    if Count = 0 then SetLength(Items, 0) 
    else if (ItemIndex < Count) then 
      Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem)); 
  end; 
  Dec(FCount); 
end;

Any idea what is causing this or if I'm doing something wrong? I'm running Delphi XE, by the way.

Answer 1

Here's the code for TCustomLayer.Destroy

destructor TCustomLayer.Destroy;
var
  I: Integer;
begin
  if Assigned(FFreeNotifies) then
  begin
    for I := FFreeNotifies.Count - 1 downto 0 do
    begin
      TCustomLayer(FFreeNotifies[I]).Notification(Self);
      if FFreeNotifies = nil then Break;
    end;
    FFreeNotifies.Free;
    FFreeNotifies := nil;
  end;
  SetLayerCollection(nil);  <<-- bug, see below.
  inherited;  <<---- See note below.
end;

Notice that there's a bug in SetLayerCollection.

Buggy code

procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
  if FLayerCollection <> Value then begin
    if Assigned(FLayerCollection) then begin
      if FLayerCollection.MouseListener = Self then
        FLayerCollection.MouseListener := nil;
      FLayerCollection.RemoveItem(Self);
    end;
    if Assigned(Value) then Value.InsertItem(Self);
  end;
  /// FLayerCollection is never set!
end;

The line SetLayerCollection(nil); does not actually set the LayerCollection! The internal FLayerCollection can suffer from a use after free condition, which is possibly what's happening to you.

Change the code for SetLayerCollection like so:

Bug fix

procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
  if FLayerCollection <> Value then begin
    if Assigned(FLayerCollection) then begin
      if FLayerCollection.MouseListener = Self then begin
        FLayerCollection.MouseListener := nil;
      end;
      FLayerCollection.RemoveItem(Self);
    end;
    if Assigned(Value) then begin
      Value.InsertItem(Self)
    end;
    FLayerCollection:= Value;  // add this line.
  end;
end;

Note
My hypothesis is that the following snippet causes the error:

  SetLayerCollection(nil);
  inherited;

SetLayerCollection(value); leaves FLayerCollection unchanged.
The inherited destructor somehow calls something having to do with LayerCollection.

Let me know if this fixes the error.

I've filed a new issue: https://github.com/graphics32/graphics32/issues/13

Update: issue is off by one error in TPointerMap.Delete
The actual issue is here: https://github.com/graphics32/graphics32/issues/14

The code for TPointerMap.Delete is incorrect:

function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin
  with FBuckets[BucketIndex] do
  begin
    Result := Items[ItemIndex].Data;

    if FCount = 0 then Exit;   <<-- error: how can result be valid if count = 0?

    Dec(Count);
    if Count = 0 then
      SetLength(Items, 0)
    else
    if (ItemIndex < Count) then
       //Oops off by 1 error!  ---------------------------------------VVVVV
      Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem));
  end;
  Dec(FCount); <<-- The use of with makes this statement confusing.
end;

The code should be changed as follows:

function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
var
  Bucket: TPointerBucket ;
begin
    if FCount = 0 then Exit(nil);
    //Perhaps add some code to validate BucketIndex & ItemIndex?
    Assert(BucketIndex < Length(FBuckets));
    Bucket:= FBuckets[BucketIndex];
    if ItemIndex >= Bucket.
    Assert(ItemIndex < Length(Bucket.Items));
    Result := Bucket.Items[ItemIndex].Data;
    Dec(Bucket.Count);
    if Bucket.Count = 0 then
      SetLength(Bucket.Items, 0)
    else
     /// assume array like so: 0 1 2 3 4  , itemindex = 0
    /// result should be 1 2 3 4
    /// move(1,0,4) (because 4 items should be moved.
    /// Thus move (itemindex+1, intemindex, count-itemindex)
    if (ItemIndex < Bucket.Count) then
      Move(Items[ItemIndex + 1], Items[ItemIndex], (Bucket.Count - ItemIndex) * SizeOf(TPointerBucketItem));
  end;
  Dec(FCount);
end;