spinettaro / delphi-event-bus

Delphi Event Bus (for short DEB) is an Event Bus framework for Delphi
Apache License 2.0
466 stars 110 forks source link

'Access violation' in TDuckTypedList.CanBeWrappedAsList (line 169) #18

Closed edwinyzh closed 5 years ago

edwinyzh commented 5 years ago

Hi,

Do you have any idea why the following error might happen? It seems happens when duplicating the event object. Currently I workaround it using the TObjectClone class (shown at the end), but I really want my copy of delphi-event-bus to be fully in sync with the official repository, otherwise it's really a pain when committing changes.

error details:

compiled with      : Delphi XE4
madExcept version  : 4.0.19
callstack crc      : $e81d85aa, $52a6acdb, $8ac0e71b
exception number   : 1
exception class    : EAccessViolation
exception message  : Access violation at address 00C6882F in module 'Program1.exe'. Read of address 00000000.

main thread ($3850):
00c6882f +02b Program1.exe DuckListU         169  +1 TDuckTypedList.CanBeWrappedAsList
00d4ba7c +220 Program1.exe RTTIUtilsU        589 +31 TRTTIUtils.CopyObject
00d4c39f +377 Program1.exe RTTIUtilsU        833 +59 TRTTIUtils.Clone
00d4c351 +329 Program1.exe RTTIUtilsU        827 +53 TRTTIUtils.Clone
00e5b203 +00f Program1.exe EventBus           89  +8 TEventBus.CloneEvent
00e5bc8a +0e6 Program1.exe EventBus          204 +20 TEventBus.Post
0102510f +067 Program1.exe WorkSpaceForm     757  +3 TfrmWorkSpace.TryOpenMostRencelyProject$237291$ActRec.$1$Body
00929d3a +08e Program1.exe OtlTaskControl   4220  +7 TOmniMessageExec.OnMessage
00926969 +1c1 Program1.exe OtlTaskControl   3170 +18 TOmniTaskControl.ForwardTaskMessage
0040fc8a +012 Program1.exe System          34138 +12 @IntfCast
00929707 +03b Program1.exe OtlTaskControl   4114  +1 TOmniTaskControlEventMonitor.ForwardTaskMessage
0092b837 +07f Program1.exe OtlEventMonitor   330  +6 ProcessMessages
0092ba49 +0a1 Program1.exe OtlEventMonitor   363  +7 TOmniEventMonitor.WndProc
007f562f +07f Program1.exe DSiWin32         6175 +15 DSiClassWndProc
762e7885 +00a USER32.dll                                   DispatchMessageW
006a2143 +0f3 Program1.exe Vcl.Forms       10288 +23 TApplication.ProcessMessage
006a2186 +00a Program1.exe Vcl.Forms       10318  +1 TApplication.HandleMessage
006a24c1 +0c9 Program1.exe Vcl.Forms       10456 +26 TApplication.Run
010df31a +0f2 Program1.exe Program1    150 +44 initialization
76cc343b +010 kernel32.dll                                 BaseThreadInitThunk

My workaround (I got TObjectClone from the Internet but forgot the source :p):

class function TObjectClone.From<T>(Source: T): T;
var
  Context: TRttiContext;
  IsComponent, LookOutForNameProp: Boolean;
  RttiType: TRttiType;
  Method: TRttiMethod;
  MinVisibility: TMemberVisibility;
  Params: TArray<TRttiParameter>;
  Prop: TRttiProperty;
  SourceAsPointer, ResultAsPointer: Pointer;
begin
  RttiType := Context.GetType(Source.ClassType);
  //find a suitable constructor, though treat components specially
  IsComponent := (Source is TComponent);
  for Method in RttiType.GetMethods do
    if Method.IsConstructor then
    begin
      Params := Method.GetParameters;
      if Params = nil then Break;
      if (Length(Params) = 1) and IsComponent and
         (Params[0].ParamType is TRttiInstanceType) and
         SameText(Method.Name, 'Create') then Break;
    end;
  if Params = nil then
    Result := Method.Invoke(Source.ClassType, []).AsType<T>
  else
    Result := Method.Invoke(Source.ClassType, [TComponent(Source).Owner]).AsType<T>;
  try
    //many VCL control properties require the Parent property to be set first
    if Source is TControl then TControl(Result).Parent := TControl(Source).Parent;
    //loop through the props, copying values across for ones that are read/write
    Move(Source, SourceAsPointer, SizeOf(Pointer));
    Move(Result, ResultAsPointer, SizeOf(Pointer));
    LookOutForNameProp := IsComponent and (TComponent(Source).Owner <> nil);
    if IsComponent then
      MinVisibility := mvPublished //an alternative is to build an exception list
    else
      MinVisibility := mvPublic;
    for Prop in RttiType.GetProperties do
      if (Prop.Visibility >= MinVisibility) and Prop.IsReadable and Prop.IsWritable then
        if LookOutForNameProp and (Prop.Name = 'Name') and
          (Prop.PropertyType is TRttiStringType) then
          LookOutForNameProp := False
        else
          Prop.SetValue(ResultAsPointer, Prop.GetValue(SourceAsPointer));
  except
    Result.Free;
    raise;
  end;
end;
spinettaro commented 5 years ago

Hi, It's very hard to understand the problem in this way... could you provide me an example that raise this error? (A delphi project would be perfect).

How your TObjectClone works? Because RTTIUtils.Clone it's ok but have some limitation: for example it serialize fine a property also if is an object, but fails when there is a circular reference. What I mean is under TestPostEntityWithItsSelfInChildObject. If your TObjectClone is better than RTTIUtils or it's equal but more easy to use etc... we can use it instead of RTTIUtils. What is the reason you use it instead of RTTIUtils.Clone?

Best regards, Daniele

Il giorno lun 1 apr 2019 alle ore 18:23 Edwin Yip notifications@github.com ha scritto:

Hi,

Do you have any idea why the following error might happen? It seems happens when duplicating the event object. Currently I workaround it using the TObjectClone class (shown at the end), but I really want my copy of delphi-event-bus to be fully in sync with the official repository, otherwise it's really a pain when committing changes. error details:

compiled with : Delphi XE4 madExcept version : 4.0.19 callstack crc : $e81d85aa, $52a6acdb, $8ac0e71b exception number : 1 exception class : EAccessViolation exception message : Access violation at address 00C6882F in module 'Program1.exe'. Read of address 00000000.

main thread ($3850): 00c6882f +02b Program1.exe DuckListU 169 +1 TDuckTypedList.CanBeWrappedAsList 00d4ba7c +220 Program1.exe RTTIUtilsU 589 +31 TRTTIUtils.CopyObject 00d4c39f +377 Program1.exe RTTIUtilsU 833 +59 TRTTIUtils.Clone 00d4c351 +329 Program1.exe RTTIUtilsU 827 +53 TRTTIUtils.Clone 00e5b203 +00f Program1.exe EventBus 89 +8 TEventBus.CloneEvent 00e5bc8a +0e6 Program1.exe EventBus 204 +20 TEventBus.Post 0102510f +067 Program1.exe WorkSpaceForm 757 +3 TfrmWorkSpace.TryOpenMostRencelyProject$237291$ActRec.$1$Body 00929d3a +08e Program1.exe OtlTaskControl 4220 +7 TOmniMessageExec.OnMessage 00926969 +1c1 Program1.exe OtlTaskControl 3170 +18 TOmniTaskControl.ForwardTaskMessage 0040fc8a +012 Program1.exe System 34138 +12 @IntfCast 00929707 +03b Program1.exe OtlTaskControl 4114 +1 TOmniTaskControlEventMonitor.ForwardTaskMessage 0092b837 +07f Program1.exe OtlEventMonitor 330 +6 ProcessMessages 0092ba49 +0a1 Program1.exe OtlEventMonitor 363 +7 TOmniEventMonitor.WndProc 007f562f +07f Program1.exe DSiWin32 6175 +15 DSiClassWndProc 762e7885 +00a USER32.dll DispatchMessageW 006a2143 +0f3 Program1.exe Vcl.Forms 10288 +23 TApplication.ProcessMessage 006a2186 +00a Program1.exe Vcl.Forms 10318 +1 TApplication.HandleMessage 006a24c1 +0c9 Program1.exe Vcl.Forms 10456 +26 TApplication.Run 010df31a +0f2 Program1.exe Program1 150 +44 initialization 76cc343b +010 kernel32.dll BaseThreadInitThunk

My workaround (I got TObjectClone from the Internet but forgot the source :p):

class function TObjectClone.From(Source: T): T; var Context: TRttiContext; IsComponent, LookOutForNameProp: Boolean; RttiType: TRttiType; Method: TRttiMethod; MinVisibility: TMemberVisibility; Params: TArray; Prop: TRttiProperty; SourceAsPointer, ResultAsPointer: Pointer; begin RttiType := Context.GetType(Source.ClassType); //find a suitable constructor, though treat components specially IsComponent := (Source is TComponent); for Method in RttiType.GetMethods do if Method.IsConstructor then begin Params := Method.GetParameters; if Params = nil then Break; if (Length(Params) = 1) and IsComponent and (Params[0].ParamType is TRttiInstanceType) and SameText(Method.Name, 'Create') then Break; end; if Params = nil then Result := Method.Invoke(Source.ClassType, []).AsType else Result := Method.Invoke(Source.ClassType, [TComponent(Source).Owner]).AsType; try //many VCL control properties require the Parent property to be set first if Source is TControl then TControl(Result).Parent := TControl(Source).Parent; //loop through the props, copying values across for ones that are read/write Move(Source, SourceAsPointer, SizeOf(Pointer)); Move(Result, ResultAsPointer, SizeOf(Pointer)); LookOutForNameProp := IsComponent and (TComponent(Source).Owner <> nil); if IsComponent then MinVisibility := mvPublished //an alternative is to build an exception list else MinVisibility := mvPublic; for Prop in RttiType.GetProperties do if (Prop.Visibility >= MinVisibility) and Prop.IsReadable and Prop.IsWritable then if LookOutForNameProp and (Prop.Name = 'Name') and (Prop.PropertyType is TRttiStringType) then LookOutForNameProp := False else Prop.SetValue(ResultAsPointer, Prop.GetValue(SourceAsPointer)); except Result.Free; raise; end; end;

— You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub https://github.com/spinettaro/delphi-event-bus/issues/18, or mute the thread https://github.com/notifications/unsubscribe-auth/ABvgLFLkNzw6V1lToBcsfnAS3VrbkIq0ks5vckCtgaJpZM4cWPqh .

edwinyzh commented 5 years ago

@spinettaro, I'll see what I can do to provide an example to reproduce this error.

I found the source of TObjectClone: Object cloning using the high level RTTI

IIRC, I switched to TObjectClone because few years ago RTTIUtils had issues handling circular object reference, we discussed it here. However, I just run the EventBus tests with RTTIUtils replaced by TObjectClone it emits two errors shown below.

So although I'm having an unknown issue with RTTIUtils as reported in the original post, I'm not sure which one is more stable...

DUnitX - [DEBDUnitXTests.exe] - Starting Tests.

.........................E...F..

Tests Found   : 16
Tests Ignored : 0
Tests Passed  : 14
Tests Leaked  : 0
Tests Failed  : 1
Tests Errored : 1

Failing Tests
  EventBusTestU.TEventBusTest.TestPostEntityWithObjectList
  Message: Expected 2 but got 0

Tests With Errors
  EventBusTestU.TEventBusTest.TestPostEntityWithChildObject
  Message: Invalid pointer operation
spinettaro commented 5 years ago

@edwinyzh , yes the problem is that TObjectClone doesn't make a deep serialization. What I mean is that if you have an object with a property that is another object ( also a list ) this is not serialized. TObjectClone maybe is good because is a bad practice to pass a complex event (an object with other objects as children) and I want to avoid this. But some developer use a complex event. What do you think about?

edwinyzh commented 5 years ago

@spinettaro, I think you have raised a very good question. Maybe it's time to re-think the 'event cloning' logic that happens before invoking each subscriber method.

There are two types of fields/properties of an object:

Actually I haven't looked at the implementation details of TObjectClone nor RTTIUtils, I wish you I described it clear.

Does it make sense?

spinettaro commented 5 years ago

@edwinyzh yes sure, but this is the dilemma:

edwinyzh commented 5 years ago

@spinettaro, I think there is a misunderstanding here, and maybe a misunderstanding on my side too, because I haven't reviewed the 'event object cloning' code yet, I'll do that later.

I don't mean not to duplicate the event object, I think your current design is OK - the event is a derived class of TObject, that's very flexible, and we certainly can't change that, otherwise it'll break backward compatibility.

I'll need to review the event object cloning code before I can discuss further in this direction. But I'll focus on reproducing the original reported issue first.

mgpensar commented 5 years ago

Shallow clone seems ok for me and the documentation should notice event objects should not own any other objects, just hold references to them. I think this is very reasonable. One alternative solution if the deep clone is chosen would be to use annotation to indicate sub-objects that are not owned by the event object or should not be cloned for any other reason. These would be annotated with [DO_NOT_CLONE]. I prefer the shallow clone solution.

I also noticed the clone method was not checking for nil in some places and changed it accordingly (see below). That was the reason for some exceptions I was getting. I did not prepared a pull request because I want to test the TObjectClone option.

class procedure TRTTIUtils.CopyObject(SourceObj, TargetObj: TObject);
var
  _ARttiType: TRttiType;
  Field: TRttiField;
  master, cloned: TObject;
  Src: TObject;
  sourceStream: TStream;
  SavedPosition: Int64;
  targetStream: TStream;
  targetCollection: IWrappedList;
  sourceCollection: IWrappedList;
  I: Integer;
  sourceObject: TObject;
  targetObject: TObject;
  Tar: TObject;
begin
  if not Assigned(TargetObj) then
    Exit;

  _ARttiType := ctx.GetType(SourceObj.ClassType);
  cloned := TargetObj;
  master := SourceObj;
  for Field in _ARttiType.GetFields do
  begin
    if not Field.FieldType.IsInstance then
      Field.SetValue(cloned, Field.GetValue(master))
    else
    begin
      Src := Field.GetValue(SourceObj).AsObject;
      if Assigned (Src) then
      begin
        if Src is TStream then
        begin
          sourceStream := TStream(Src);
          SavedPosition := sourceStream.Position;
          sourceStream.Position := 0;
          if Field.GetValue(cloned).IsEmpty then
          begin
            targetStream := TMemoryStream.Create;
            Field.SetValue(cloned, targetStream);
          end
          else
            targetStream := Field.GetValue(cloned).AsObject as TStream;
          targetStream.Position := 0;
          targetStream.CopyFrom(sourceStream, sourceStream.Size);
          targetStream.Position := SavedPosition;
          sourceStream.Position := SavedPosition;
        end
        else if TDuckTypedList.CanBeWrappedAsList(Src) then
        begin
          sourceCollection := WrapAsList(Src);
          Tar := Field.GetValue(cloned).AsObject;
          if Assigned(Tar) then
          begin
            targetCollection := WrapAsList(Tar);
            targetCollection.Clear;
            for I := 0 to sourceCollection.Count - 1 do
              targetCollection.Add(TRTTIUtils.Clone(sourceCollection.GetItem(I)));
          end;
        end
        else
        begin
          sourceObject := Src;

          if Field.GetValue(cloned).IsEmpty then
          begin
            targetObject := TRTTIUtils.Clone(sourceObject);
            Field.SetValue(cloned, targetObject);
          end
          else
          begin
            targetObject := Field.GetValue(cloned).AsObject;
            TRTTIUtils.CopyObject(sourceObject, targetObject);
          end;
        end;
      end
      else
        targetObject := nil;
    end;
  end;
end;

class function TRTTIUtils.Clone(Obj: TObject): TObject;
var
  _ARttiType: TRttiType;
  Field: TRttiField;
  master, cloned: TObject;
  Src: TObject;
  sourceStream: TStream;
  SavedPosition: Int64;
  targetStream: TStream;
  targetCollection: TObjectList<TObject>;
  sourceCollection: TObjectList<TObject>;
  I: Integer;
  sourceObject: TObject;
  targetObject: TObject;
begin
  Result := nil;
  if not Assigned(Obj) then
    Exit;

  _ARttiType := ctx.GetType(Obj.ClassType);
  cloned := CreateObject(_ARttiType);
  master := Obj;
  for Field in _ARttiType.GetFields do
  begin
    if not Field.FieldType.IsInstance then
      Field.SetValue(cloned, Field.GetValue(master))
    else
    begin
      Src := Field.GetValue(Obj).AsObject;
      if Src is TStream then
      begin
        sourceStream := TStream(Src);
        SavedPosition := sourceStream.Position;
        sourceStream.Position := 0;
        if Field.GetValue(cloned).IsEmpty then
        begin
          targetStream := TMemoryStream.Create;
          Field.SetValue(cloned, targetStream);
        end
        else
          targetStream := Field.GetValue(cloned).AsObject as TStream;
        targetStream.Position := 0;
        targetStream.CopyFrom(sourceStream, sourceStream.Size);
        targetStream.Position := SavedPosition;
        sourceStream.Position := SavedPosition;
      end
      else if Src is TObjectList<TObject> then
      begin
        sourceCollection := TObjectList<TObject>(Src);
        if Field.GetValue(cloned).IsEmpty then
        begin
          targetCollection := TObjectList<TObject>.Create;
          Field.SetValue(cloned, targetCollection);
        end
        else
          targetCollection := Field.GetValue(cloned).AsObject as TObjectList<TObject>;
        for I := 0 to sourceCollection.Count - 1 do
        begin
          targetCollection.Add(TRTTIUtils.Clone(sourceCollection[I]));
        end;
      end
      else
      begin
        sourceObject := Src;
        if Assigned (sourceObject) then
        begin
          if Field.GetValue(cloned).IsEmpty then
          begin
            targetObject := TRTTIUtils.Clone(sourceObject);
            Field.SetValue(cloned, targetObject);
          end
          else
          begin
            targetObject := Field.GetValue(cloned).AsObject;
            TRTTIUtils.CopyObject(sourceObject, targetObject);
          end;
          Field.SetValue(cloned, targetObject);
        end
        else
          Field.SetValue(cloned, nil);
      end;
    end;

  end;
  Result := cloned;
end;
edwinyzh commented 5 years ago

Thanks for sharing. In this pull request I changed the TEvent.CloneEvent method virtual so I can override the behavior.

spinettaro commented 5 years ago

Thanks for PR @edwinyzh ! @mgpensar yes, my thought was to allow a mechanism that is a bit more flexible of simple String in Event data. This is why you can pass an object, but if you try to pass a complex object maybe this is a synthom that there is something wrong in your architecture because it is, in the most of case, an antipattern. This is why, in my opinion, an Event should be only a simple object.

edwinyzh commented 5 years ago

The built-in TRTTIUtils.Clone is really not very stable, aside from the above discussions, I had experiece with the 'stack overflow' errors.

I agree that an Event should use only simple objects, and I also agree with @mgpensar about we should use shallow copy for the event objects.

Actually, IMHO the best option would be use System.TypInfo.pas, AKA the good-old, fast RTTI, which means only published event properties will be copied, this is a tiny rule and I think it's perfectly OK. mORMot had a great performance success with the good old, fast RTTI, check CopyObject in mORMot.pas for an idea.

But the bottom-line is, we should not break backward compatibility, so maybe implement a new TEvent.PostEx :)

spinettaro commented 5 years ago

Hi guys, @edwinyzh @mgpensar , what about to create a service inside DEB that clone the object? You can also specify your custom cloning for a specific type otherwise the stndard one (RTTI) is used or you can also inject your clone service... What are your thoughts?

edwinyzh commented 5 years ago

Good idea! To simplify things, maybe a single call back is enough, something like TOnCloneEventObject = procedure (aEventObject: TObject) of TObject And the client code to use it: TEventBus.Default.EventObjectCloneProc = ...

spinettaro commented 5 years ago

added mechanism to customize event cloning. See last commit and unit tests to understand how it works.

edwinyzh commented 5 years ago

Thanks! I see you took the anonymous method approach, not sure if how it performs comparing with the traditional method call back.

spinettaro commented 5 years ago

@edwinyzh changed with TCloneEventCallback (function of object) and TCloneEventMethod (reference to function)