delphi - 使用带有泛型列表的 Rtti 调用 GetEnumerator 发生访问冲突

Question

此过程自动调用 TObject (AObj) 的枚举器:对于 TForm 非常有用，但对于泛型列表(例如 TList)则失败!这里的访问冲突:“Value := Current.GetValue(EnumeratorObj);”为什么 ？错误发生前如何检查？

procedure (const ARType:TRttiType; AObj:TObject; ANode:PNode)
var
  Current: TRttiProperty;
  EnumType: TRttiType;
  MoveNext: TRttiMethod;
  GetEnumerator:TRttiMethod;
  EnumeratorObj:TObject;
  LObj:TObject;
  Value: TValue;
begin// Call Enumerator
  GetEnumerator := ARType.GetMethod('GetEnumerator');
  if (not Assigned(GetEnumerator)) or (GetEnumerator.MethodKind <> mkFunction)
     or (GetEnumerator.ReturnType.Handle.Kind <> tkClass) then exit;
  //
  EnumeratorObj := GetEnumerator.Invoke(AObj, []).AsObject;
  if not Assigned(EnumeratorObj) then exit;
  EnumType := _Cxt.GetType(EnumeratorObj.ClassInfo);
  // Find the Current property
  Current := EnumType.GetProperty('Current');
  if (not Assigned(Current)) or
    not (Current.PropertyType.TypeKind in [tkString, tkUString, tkClass]) then exit;

  // Find the MoveNext property
  MoveNext := EnumType.GetMethod('MoveNext');
  if (not Assigned(MoveNext)) or (Length(MoveNext.GetParameters) > 0) or
    (MoveNext.MethodKind <> mkFunction) or
    (MoveNext.ReturnType.Handle <> TypeInfo(Boolean)) then exit;

  // while MoveNext do
  while MoveNext.Invoke(EnumeratorObj, []).AsBoolean do
  begin
   // Value := Current
   Value := Current.GetValue(EnumeratorObj); //!!!error here!!!
   if Value.Kind = tkClass then
   begin
     LObj := Value.AsObject;
     if Assigned(LObj) then
       ANode.Action(_Cxt.GetType(LObj.ClassInfo), LObj, ANode.Next);//Recursif!!!
   end
   else break;
end;

例如:

uses rtti, typinfo;

procedure TForm1.Button4Click(Sender: TObject);
var
  _Cxt :TRttiContext;
  List :TList<TObject>;

  procedure Exec(const ARType:TRttiType; AObj:TObject; ANode:TObject);
  var
     Current: TRttiProperty;
     EnumType: TRttiType;
     MoveNext: TRttiMethod;
     GetEnumerator:TRttiMethod;
     EnumeratorObj:TObject;
     LObj:TObject;
     Value: TValue;
  begin// Call Enumerator
    GetEnumerator := ARType.GetMethod('GetEnumerator');
    if (not Assigned(GetEnumerator)) or (GetEnumerator.MethodKind <> mkFunction)
       or (GetEnumerator.ReturnType.Handle.Kind <> tkClass) then exit;
    //
    EnumeratorObj := GetEnumerator.Invoke(AObj, []).AsObject;
    if not Assigned(EnumeratorObj) then exit;
    EnumType := _Cxt.GetType(EnumeratorObj.ClassInfo);
    // Find the Current property
    Current := EnumType.GetProperty('Current');
    if (not Assigned(Current)) or
      not (Current.PropertyType.TypeKind in [tkString, tkUString, tkClass]) then exit;

    // Find the MoveNext property
    MoveNext := EnumType.GetMethod('MoveNext');
    if (not Assigned(MoveNext)) or (Length(MoveNext.GetParameters) > 0) or
      (MoveNext.MethodKind <> mkFunction) or
      (MoveNext.ReturnType.Handle <> TypeInfo(Boolean)) then exit;

    // while MoveNext do
    while MoveNext.Invoke(EnumeratorObj, []).AsBoolean do
    begin
     // Value := Current
     Value := Current.GetValue(EnumeratorObj); //!!boooom!! Access violation in XE4
     if Value.Kind = tkClass then
     begin
       LObj := Value.AsObject;
//       if Assigned(LObj) then
//         ANode.Action(_Cxt.GetType(LObj.ClassInfo), LObj, ANode.Next);//Recursif!!!
     end
     else break;
    end;
  end;
begin
  _Cxt := TRttiContext.Create;
  List := TList<TObject>.Create;
  List.Add(TObject(666));
  try
    Exec(_Cxt.GetType(List.ClassInfo), List, nil); // it's NOT OK
    Exec(_Cxt.GetType(Self.ClassInfo), Self, nil); // it's OK  
  finally
    List.Free;
    _Cxt.Free;
  end;
end;

Answer 1

问题是 TObject(666) 不是一个真实的对象。只要您使用实际的对象实例或nil，您的代码就可以工作。

访问冲突的原因是 GetValue 方法最终调用了 TValue.Make(Pointer, PTypeInfo, out TValue) 重载，其中包含以下代码:

// make a better-educated guess about type-info when we can
case ATypeInfo^.Kind of
  tkClass:
    if Result.FData.FAsObject <> nil then
      Result.FData.FTypeInfo := 
        GetClassInfo(TObject(Result.FData.FAsObject).ClassType);
end;

该代码要求该对象是一个真实的对象实例。该代码正在尝试获取实例的类信息。它通过 ATypeInfo 接收属性的类型信息，但随后尝试使用特定实例的实际类型信息。并且由于 TObject(666) 不是真实的对象实例，因此代码结果会导致运行时错误。