Fix #327 (Support for class references).

Added test

Author: pyscripter

Source/PythonEngine.pas

@@ -1759,6 +1759,8 @@   TPythonTraceback = class
       property Limit : Integer read FLimit write FLimit;
   end;
 
+  TPythonType = class; //forward declaration
+
   {$IF not Defined(FPC) and (CompilerVersion >= 23)}
   [ComponentPlatformsAttribute(pidSupportedPlatforms)]
   {$IFEND}
@@ -1859,6 +1861,7 @@   TPythonEngine = class(TPythonInterface)
     procedure  AddClient( client : TEngineClient );
     procedure  RemoveClient( client : TEngineClient );
     function   FindClient( const aName : string ) : TEngineClient;
+    function   FindPythonType( const TypeName : AnsiString ) : TPythonType;
     function   TypeByName( const aTypeName : AnsiString ) : PPyTypeObject;
     function   ModuleByName( const aModuleName : AnsiString ) : PPyObject;
     function   MethodsByName( const aMethodsContainer: string ) : PPyMethodDef;
@@ -2286,9 +2289,6 @@   TPythonModule = class(TMethodsContainer)
 //--                                                   --
 //-------------------------------------------------------
 
-type
-  TPythonType = class; //forward declaration
-
 {
         A                    B                                                      C
         +-------------------++------------------------------------------------------+
@@ -5768,6 +5768,19 @@ function TPythonEngine.FindModule( const ModuleName : AnsiString ) : PPyObject;
     Result := nil;
 end;
 
+function TPythonEngine.FindPythonType(const TypeName: AnsiString): TPythonType;
+var
+  i : Integer;
+begin
+  Result := nil;
+  for i := 0 to ClientCount - 1 do
+    if (Clients[i] is TPythonType) and (TPythonType(Clients[i]).TypeName = TypeName) then
+    begin
+      Result := TPythonType(Clients[i]);
+      Break;
+    end;
+end;
+
 function TPythonEngine.FindFunction(const ModuleName,FuncName: AnsiString): PPyObject;
 var
   module,func: PPyObject;
@@ -8885,22 +8898,6 @@ function pyio_GetTypesStats(self, args : PPyObject) : PPyObject;
       end;
   end;
 
-  function FindType( const TName : AnsiString ) : TPythonType;
-  var
-    i : Integer;
-  begin
-    Result := nil;
-    with GetPythonEngine do
-      for i := 0 to ClientCount - 1 do
-        if Clients[i] is TPythonType then
-          with TPythonType(Clients[i]) do
-            if TypeName = TName then
-              begin
-                Result := TPythonType(Clients[i]);
-                Break;
-              end;
-  end;
-
 var
   i : Integer;
   T : TPythonType;
@@ -8914,7 +8911,7 @@ function pyio_GetTypesStats(self, args : PPyObject) : PPyObject;
         for i := 0 to PyTuple_Size(args)-1 do
           begin
             str := AnsiString(PyObjectAsString( PyTuple_GetItem(args, i) ));
-            T := FindType( str );
+            T := FindPythonType( str );
             if Assigned(T) then
               begin
                 obj := HandleType( T );

Source/WrapDelphi.pas

@@ -920,6 +920,7 @@ implementation
   rs_ExpectedObject = 'Expected a Pascal object';
   rs_ExpectedRecord = 'Expected a Pascal record';
   rs_ExpectedInterface = 'Expected a Pascal interface';
+  rs_ExpectedClass = 'Expected a Pascal class';
   rs_InvalidClass = 'Invalid class';
   rs_ErrEventNotReg = 'No Registered EventHandler for events of type "%s';
   rs_ErrEventNoSuport = 'Class %s does not support events because it must '+
@@ -1131,6 +1132,46 @@ function ValidateInterfaceProperty(PyValue: PPyObject; RttiType: TRttiInterfaceT
     ErrMsg := rs_ExpectedInterface;
 end;
 
+function ValidateClassRef(PyValue: PPyObject; TypeInfo: PTypeInfo;
+  out ClassRef: TClass; out ErrMsg: string): Boolean;
+var
+  LTypeName: AnsiString;
+  LPythonType: TPythonType;
+begin
+  ClassRef := nil;
+  if (PyValue = GetPythonEngine.Py_None) then begin
+     Result := True;
+     Exit;
+  end;
+
+  Result := False;
+  // Is PyValue a Python type?
+  if PyValue^.ob_type^.tp_name = 'type' then
+    LTypeName := PPyTypeObject(PyValue).tp_name
+  else
+  begin
+    ErrMsg := rs_ExpectedClass;
+    Exit;
+  end;
+
+  LPythonType := GetPythonEngine.FindPythonType(LTypeName);
+  if Assigned(LPythonType) then
+  begin
+    if Assigned(LPythonType) and LPythonType.PyObjectClass.InheritsFrom(TPyDelphiObject) then
+    begin
+      ClassRef := TPyDelphiObjectClass(LPythonType.PyObjectClass).DelphiObjectClass;
+      TypeInfo := TypeInfo^.TypeData^.InstanceType^;
+      if Assigned(TypeInfo) and (ClassRef.InheritsFrom(TypeInfo^.TypeData^.ClassType)) then
+        Result := True
+      else
+        ErrMsg := rs_IncompatibleClasses;
+    end
+    else
+      ErrMsg := rs_ExpectedClass;
+  end
+  else
+    ErrMsg := rs_ExpectedClass;
+end;
 {$ENDIF}
 
 function ValidateClassProperty(PyValue: PPyObject; TypeInfo: PTypeInfo;
@@ -2831,6 +2872,7 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject;
     Index: Integer;
     ErrMsg: string;
     Obj: TObject;
+    ClassRef: TClass;
     PyValue : PPyObject;
     Param: TRttiParameter;
     Params : TArray<TRttiParameter>;
@@ -2872,6 +2914,15 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject;
                 Break
               end
             end
+            else if (Param.ParamType.TypeKind = tkClassRef) then
+            begin
+              if ValidateClassRef(PyValue, Param.ParamType.Handle, ClassRef, ErrMsg) then
+                Args[Index] := ClassRef
+              else begin
+                Result := nil;
+                Break
+              end
+            end
             else if (Param.ParamType.TypeKind = tkDynArray) and PythonType.Engine.PyList_Check(PyValue) then
             begin
               if ParamAsDynArray(PyValue, Param, Args[Index]) then

Tests/WrapDelphiTest.pas

@@ -6,7 +6,8 @@
 interface
 
 uses
-  Types,
+  System.Types,
+  System.Classes,
   DUnitX.TestFramework,
   PythonEngine,
   WrapDelphi;
@@ -35,6 +36,7 @@   TTestRecord = record
 
   TFruitDynArray = TArray<TFruit>;
   TStaticArray = array[0..999] of Int64;
+
   TTestRttiAccess = class
   private
     FFruit: TFruit;
@@ -58,6 +60,7 @@   TTestRttiAccess = class
     function SetStringField(var Value: Integer): string; overload;
     function SetStringField(const Value: string): string; overload;
     procedure PassVariantArray(const Value: Variant);
+    function ClassRefParam(ClassRef: TPersistentClass): string;
   end;
 
   TTestInterfaceImpl = class(TInterfacedObject, ITestInterface)
@@ -122,14 +125,15 @@   TTestWrapDelphi = class(TObject)
     procedure TestFreeReturnedObject;
     [Test]
     procedure TestPassVariantArray;
+    [Test]
+    procedure TestClassRefParam;
   end;
 
 implementation
 
 Uses
   System.SysUtils,
   System.Variants,
-  System.Classes,
   System.Rtti,
   VarPyth,
   WrapDelphiClasses;
@@ -201,7 +205,7 @@ procedure TTestWrapDelphi.SetupFixture;
   Py := PyDelphiWrapper.WrapInterface(TValue.From(FTestInterface));
   DelphiModule.SetVar('rtti_interface', Py);
   PythonEngine.Py_DecRef(Py);
-  PythonEngine.ExecString('from delphi import rtti_var, rtti_rec, rtti_interface');
+  PythonEngine.ExecString('from delphi import rtti_var, rtti_rec, rtti_interface, Object, Collection, Strings');
   Rtti_Var := MainModule.rtti_var;
   Rtti_Rec := MainModule.rtti_rec;
   Rtti_Interface := MainModule.rtti_interface;
@@ -218,6 +222,16 @@ procedure TTestWrapDelphi.TearDownFixture;
   TestRttiAccess.Free;
 end;
 
+procedure TTestWrapDelphi.TestClassRefParam;
+begin
+  Assert.AreEqual<string>(Rtti_Var.ClassRefParam(MainModule.Collection), 'TCollection');
+  Assert.AreEqual<string>(Rtti_Var.ClassRefParam(MainModule.Strings), 'TStrings');
+  Assert.WillRaise(procedure
+  begin
+    Rtti_Var.ClassRefParam(MainModule.Object)
+  end);
+end;
+
 procedure TTestWrapDelphi.TestDoubleField;
 begin
   TestRttiAccess.DoubleField := 3.14;
@@ -442,6 +456,11 @@ function TTestRttiAccess.SetStringField(var Value: Integer): string;
   Result := StringField;
 end;
 
+function TTestRttiAccess.ClassRefParam(ClassRef: TPersistentClass): string;
+begin
+  Result := ClassRef.ClassName;
+end;
+
 function TTestRttiAccess.GetData: TObject;
 begin
   Result := TStringList.Create;