Wrap methods with parameters and/or return values PPyObjects.

Author: pyscripter

Source/WrapDelphi.pas

@@ -1038,6 +1038,7 @@ implementation
   rs_ExpectedNil = 'In static methods Self should be nil';
   rs_ExpectedInterface = 'Expected a Pascal interface';
   rs_ExpectedSequence = 'Expected a python sequence';
+  rsExpectedPPyObject = 'Expected a PPyObject';
   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 '+
@@ -2176,6 +2177,25 @@ function ValidateDynArray(PyValue: PPyObject; const RttiType: TRttiType;
   end;
 end;
 
+function ValidatePPyObject(PyValue: PPyObject; const RttiType: TRttiType;
+  out ParamValue: TValue; out ErrMsg: string): Boolean;
+var
+  RefType: TRttiType;
+begin
+  Result := False;
+  if (RTTIType is TRttiPointerType) then
+  begin
+    RefType := TRttiPointerType(RTTIType).ReferredType;
+    if Assigned(RefType) and (RefType.Name = 'PyObject') then
+    begin
+      Result := True;
+      ParamValue := TValue.From<PPyObject>(PyValue);
+    end;
+  end;
+  if not Result then
+    ErrMsg := rsExpectedPPyObject;
+end;
+
 function PyObjectToTValue(PyArg: PPyObject; ArgType: TRttiType;
   out Arg: TValue; out ErrMsg: string): Boolean;
 var
@@ -2205,7 +2225,9 @@ function PyObjectToTValue(PyArg: PPyObject; ArgType: TRttiType;
     tkRecord{$IFDEF MANAGED_RECORD}, tkMRecord{$ENDIF}:
       Result := ValidateRecordProperty(PyArg, ArgType.Handle, Arg, ErrMsg);
     tkDynArray:
-      Result := ValidateDynArray(PyArg, ArgType, Arg, ErrMsg)
+      Result := ValidateDynArray(PyArg, ArgType, Arg, ErrMsg);
+    tkPointer:
+      Result := ValidatePPyObject(PyArg, ArgType, Arg, ErrMsg);
   else
     Result := SimplePythonToValue(PyArg, ArgType.Handle, Arg, ErrMsg);
   end;
@@ -2254,6 +2276,14 @@ function TValueToPyObject(const Value: TValue;
         Result := DelphiWrapper.WrapRecord(Value);
       tkArray, tkDynArray:
         Result := DynArrayToPython(Value, DelphiWrapper, ErrMsg);
+      tkPointer:
+        if Value.IsType<PPyObject> then
+          Result := Value.AsType<PPyObject>
+        else
+        begin
+          Result := nil;
+          ErrMsg := rs_ErrValueToPython;
+        end;
     else
       Result := SimpleValueToPython(Value, ErrMsg);
     end;
@@ -4127,7 +4157,7 @@ class procedure TPyDelphiObject.ExposeMethods(AClass: TClass;
 
       // Ignore methods with unhandled return type
       if Assigned(LRttiMethod.ReturnType) and (LRttiMethod.ReturnType.TypeKind
-        in [tkUnknown, tkMethod, tkPointer, tkProcedure])
+        in [tkUnknown, tkMethod, tkProcedure])
       then
         Continue;
 
@@ -4229,7 +4259,7 @@ class procedure TPyDelphiObject.ExposeFields(AClass: TClass;
         Continue;
 
       // Skip if the type cannot be handled
-      if LRttiField.FieldType.TypeKind  in [tkUnknown, tkMethod, tkPointer, tkProcedure] then
+      if LRttiField.FieldType.TypeKind  in [tkUnknown, tkMethod, tkProcedure] then
         Continue;
 
       AddedFields := AddedFields + [LRttiField.Name];
@@ -4315,7 +4345,7 @@ class procedure TPyDelphiObject.ExposeProperties(AClass: TClass;
       else
       begin
         // Skip if the type cannot be handled
-        if LRttiProperty.PropertyType.TypeKind in [tkUnknown, tkPointer, tkMethod, tkProcedure] then
+        if LRttiProperty.PropertyType.TypeKind in [tkUnknown, tkMethod, tkProcedure] then
           Continue;
 
         // Create the exposed property
@@ -4399,7 +4429,7 @@ class procedure TPyDelphiObject.ExposeIndexedProperties(AClass: TClass;
         Continue;
 
       // Skip if the type cannot be handled
-      if LRttiProperty.PropertyType.TypeKind  in [tkUnknown, tkPointer, tkMethod, tkProcedure] then
+      if LRttiProperty.PropertyType.TypeKind  in [tkUnknown, tkMethod, tkProcedure] then
         Continue;
 
       AddedProperties := AddedProperties + [LRttiProperty.Name];

Tests/WrapDelphiTest.pas

@@ -71,6 +71,7 @@   TTestRttiAccess = class
     procedure VarArgsProc1(var I: Integer);
     function  VarArgsFunc1(var I: Integer): Integer;
     procedure VarArgsProc2(var I: Integer; var S: string);
+    function PlaceInNewList(PyObj: PPyObject): PPyObject;
     property Indexed[I: Integer]: Integer read GetIndexed write SetIndexed;
     property Indexed2[S1, S2: string]: string read GetIndexed2 write SetIndexed2; default;
     class var ClassField: string;
@@ -157,6 +158,8 @@   TTestWrapDelphi = class(TObject)
     procedure TestIndexedProperties;
     [Test]
     procedure TestVarArgs;
+    [Test]
+    procedure TestPPyObjects;
   end;
 
 implementation
@@ -427,6 +430,15 @@ procedure TTestWrapDelphi.TestPassVariantArray;
   Assert.Pass;
 end;
 
+procedure TTestWrapDelphi.TestPPyObjects;
+var
+  List: Variant;
+begin
+  List := rtti_var.PlaceInNewList('abc');
+  Assert.IsTrue(VarIsPythonList(List));
+  Assert.AreEqual<string>(List.GetItem(0), 'abc');
+end;
+
 procedure TTestWrapDelphi.TestRecord;
 begin
   Rtti_rec.StringField := 'abcd';
@@ -615,6 +627,16 @@ procedure TTestRttiAccess.PassVariantArray(const Value: Variant);
   Assert.IsTrue(VarIsArray(Value) and (VarArrayHighBound(Value, 1) = 9));
 end;
 
+function TTestRttiAccess.PlaceInNewList(PyObj: PPyObject): PPyObject;
+begin
+  with GetPythonEngine do
+  begin
+    Result := PyList_New(1);
+    Py_XIncRef(PyObj);
+    PyList_SetItem(Result, 0, PyObj);
+  end;
+end;
+
 procedure TTestRttiAccess.SellFruits(const AFruits: TFruitDynArray);
 var
   Fruit: TFruit;