Question

This proc call enumerator automatically of a TObject (AObj) : great with a TForm but fail with a generics list (ex. TList) ! access violation here : "Value := Current.GetValue(EnumeratorObj);" why ? How check before the error ?

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;

For example :

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;
Was it helpful?

Solution

The problem is that TObject(666) is not a real object. So long as you use actual object instances, or nil, then your code works.

The reason for the access violation is that the GetValue method ends up calling the TValue.Make(Pointer, PTypeInfo, out TValue) overload which includes this code:

// 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;

And that code requires the object to be a real object instance. That code is attempting to obtain the class info for the instance. It receives the type info for the property through ATypeInfo but then attempts to use the actual type info of the specific instance. And because TObject(666) is not a real object instance, the code results leads to a runtime error.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top