Handle Pointer fields, properties and parameters - stored as python integers.

Author: pyscripter

Source/PythonEngine.pas

@@ -1649,7 +1649,7 @@   TPythonInterface=class(TDynamicDll)
     PyLong_FromLongLong:function(val:Int64): PPyObject; cdecl;
     PyLong_FromUnsignedLongLong:function(val:UInt64) : PPyObject; cdecl;
     PyLong_AsLongLong:function(ob:PPyObject): Int64; cdecl;
-    PyLong_AsVoidPtr:function(ob:PPyObject): Pointer;
+    PyLong_AsVoidPtr:function(ob:PPyObject): Pointer; cdecl;
     PyLong_FromVoidPtr:function(p: Pointer): PPyObject; cdecl;
     PyMapping_Check:function (ob:PPyObject):integer; cdecl;
     PyMapping_GetItemString:function (ob:PPyObject;key:PAnsiChar):PPyObject; cdecl;

Source/WrapDelphi.pas

@@ -1042,7 +1042,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';
+  rsExpectedPointer = 'Expected a Pointer';
   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 '+
@@ -2188,23 +2188,38 @@ function ValidateDynArray(PyValue: PPyObject; const RttiType: TRttiType;
   end;
 end;
 
-function ValidatePPyObject(PyValue: PPyObject; const RttiType: TRttiType;
+function ValidatePointer(PyValue: PPyObject; const RttiType: TRttiType;
   out ParamValue: TValue; out ErrMsg: string): Boolean;
 var
   RefType: TRttiType;
+  PyEngine: TPythonEngine;
+  P: Pointer;
 begin
   Result := False;
+  PyEngine := GetPythonEngine;
+
   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
+    else if PyEngine.PyLong_Check(PyValue) then
+    begin
+      P := PyEngine.PyLong_AsVoidPtr(PyValue);
+      if PyEngine.PyErr_Occurred = nil then
+      begin
+        Result := True;
+        ParamValue := TValue.From<Pointer>(P);
+      end
+      else
+        PyEngine.PyErr_Clear;
     end;
   end;
   if not Result then
-    ErrMsg := rsExpectedPPyObject;
+    ErrMsg := rsExpectedPointer;
 end;
 
 function PyObjectToTValue(PyArg: PPyObject; ArgType: TRttiType;
@@ -2238,7 +2253,7 @@ function PyObjectToTValue(PyArg: PPyObject; ArgType: TRttiType;
     tkDynArray:
       Result := ValidateDynArray(PyArg, ArgType, Arg, ErrMsg);
     tkPointer:
-      Result := ValidatePPyObject(PyArg, ArgType, Arg, ErrMsg);
+      Result := ValidatePointer(PyArg, ArgType, Arg, ErrMsg);
   else
     Result := SimplePythonToValue(PyArg, ArgType.Handle, Arg, ErrMsg);
   end;
@@ -2277,7 +2292,7 @@ function TValueToPyObject(const Value: TValue;
    DelphiWrapper: TPyDelphiWrapper; out ErrMsg: string): PPyObject;
 begin
   if Value.IsEmpty then
-    Result := GetPythonEngine.ReturnNone
+    Result := DelphiWrapper.Engine.ReturnNone
   else
     case Value.Kind of
       tkClass: Result := DelphiWrapper.Wrap(Value.AsObject);
@@ -2288,13 +2303,10 @@ function TValueToPyObject(const Value: TValue;
       tkArray, tkDynArray:
         Result := DynArrayToPython(Value, DelphiWrapper, ErrMsg);
       tkPointer:
-        if Value.IsType<PPyObject> then
+        if Value.TypeInfo = TypeInfo(PPyObject) then
           Result := Value.AsType<PPyObject>
         else
-        begin
-          Result := nil;
-          ErrMsg := rs_ErrValueToPython;
-        end;
+          Result := DelphiWrapper.Engine.PyLong_FromVoidPtr(Value.AsType<Pointer>);
     else
       Result := SimpleValueToPython(Value, ErrMsg);
     end;

Tests/WrapDelphiTest.pas

@@ -55,6 +55,7 @@   TTestRttiAccess = class
     ObjectField: TObject;
     RecordField: TTestRecord;
     InterfaceField: ITestInterface;
+    PointerField: Pointer;
     ClassRef: TClass;
     function GetData: TObject;
     procedure BuyFruits(AFruits: TFruits);
@@ -160,6 +161,8 @@   TTestWrapDelphi = class(TObject)
     procedure TestVarArgs;
     [Test]
     procedure TestPPyObjects;
+    [Test]
+    procedure TestPointers;
   end;
 
 implementation
@@ -439,6 +442,12 @@ procedure TTestWrapDelphi.TestPPyObjects;
   Assert.AreEqual<string>(List.GetItem(0), 'abc');
 end;
 
+procedure TTestWrapDelphi.TestPointers;
+begin
+  rtti_var.PointerField := $FFFF;
+  Assert.AreEqual<NativeUInt>(rtti_var.PointerField, $FFFF);
+end;
+
 procedure TTestWrapDelphi.TestRecord;
 begin
   Rtti_rec.StringField := 'abcd';