From fd8b77b7bb985e14ee36a1cf14b5b5a5dab5e9b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20Repe=C4=87?= Date: Tue, 15 Dec 2020 01:05:14 +0100 Subject: [PATCH 1/2] fmx dependency removed FireDAC.FMXUI.Wait --- Source/WrapFireDAC.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/WrapFireDAC.pas b/Source/WrapFireDAC.pas index 8c2467d2..2d87498b 100644 --- a/Source/WrapFireDAC.pas +++ b/Source/WrapFireDAC.pas @@ -13,7 +13,7 @@ interface Windows, System.AnsiStrings, System.Rtti, DB, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, - FireDAC.Phys, FireDAC.FMXUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, + FireDAC.Phys, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.Client, FireDAC.Comp.DataSet, FireDAC.Comp.UI, FireDAC.Stan.ExprFuncs; From 0c73fc554355671589053095fbc51502c2b18f6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20Repe=C4=87?= Date: Tue, 15 Dec 2020 01:06:55 +0100 Subject: [PATCH 2/2] rtti method invoke with dynamic arrays as parameters and class methods --- Source/WrapDelphi.pas | 47 +++++++++++++++++++++++++++++++++++++--- Tests/WrapDelphiTest.pas | 46 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 90 insertions(+), 3 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index b336cdcf..943e0e9e 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -327,7 +327,7 @@ interface uses - SysUtils, Classes, PythonEngine, TypInfo, + SysUtils, Classes, PythonEngine, TypInfo, Types, Variants, {$IFNDEF FPC} {$IFDEF EXTENDED_RTTI} @@ -2745,6 +2745,39 @@ function TPyDelphiObject.Wrap(AObject: TObject; {$IFDEF EXTENDED_RTTI} function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; + function ParamAsDynArray(PyValue: PPyObject; const RttiParam: TRttiParameter; out ParamValue: TValue): Boolean; + var + Arr: array of TValue; + I: Integer; + elType: PPTypeInfo; + V: Variant; + Num: Int64; + begin + Result := False; + if (RttiParam.ParamType = nil) or (RttiParam.ParamType.Handle = nil) or (RttiParam.ParamType.Handle.TypeData = nil) then + Exit; + elType := RttiParam.ParamType.Handle.TypeData.elType; + if elType = nil then + elType := RttiParam.ParamType.Handle.TypeData.elType2; + if elType = nil then + Exit; + + SetLength(Arr, PythonType.Engine.PyList_Size(PyValue)); + for I := 0 to PythonType.Engine.PyList_Size(PyValue) - 1 do + begin + V := PythonType.Engine.PyObjectAsVariant(PythonType.Engine.PyList_GetItem(PyValue, i)); + if elType^.Kind = tkEnumeration then + begin + Num := TValue.FromVariant(V).Cast(TypeInfo(Int64)).AsInt64; + Arr[i] := TValue.FromOrdinal(elType^, Num); + end + else + Arr[i] := TValue.FromVariant(V).Cast(elType^); + end; + ParamValue := TValue.FromArray(RttiParam.ParamType.Handle, Arr); + Result := True; + end; + function FindMethod(const MethName:string; RttiType : TRttiType; PyArgs: PPyObject; var Args: array of TValue):TRttiMethod; // Deals with overloaded methods @@ -2793,8 +2826,12 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; Break end end - else + else if (Param.ParamType.TypeKind = tkDynArray) and PythonType.Engine.PyList_Check(PyValue) then begin + if ParamAsDynArray(PyValue, Param, Args[Index]) then + Continue; //to avoid last check + end + else begin if not SimplePythonToValue(PyValue, Param.ParamType.Handle, Args[Index], ErrMsg) then begin @@ -2802,6 +2839,7 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; Break end; end; + if (Param.ParamType <> nil) and not Args[Index].IsType(Param.ParamType.Handle) then begin Result :=nil; @@ -2846,7 +2884,10 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; try if ParentRtti is TRttiInstanceType then - Addr := TValue.From(TObject(ParentAddress)) + if meth.IsClassMethod then + Addr := TValue.From(TObject(ParentAddress).ClassType) + else + Addr := TValue.From(TObject(ParentAddress)) else if ParentRtti is TRttiInterfaceType then TValue.Make(@ParentAddress, ParentRtti.Handle, Addr) else diff --git a/Tests/WrapDelphiTest.pas b/Tests/WrapDelphiTest.pas index 92c43cef..58f0ae5b 100644 --- a/Tests/WrapDelphiTest.pas +++ b/Tests/WrapDelphiTest.pas @@ -6,6 +6,7 @@ interface uses + Types, DUnitX.TestFramework, PythonEngine, WrapDelphi; @@ -32,6 +33,7 @@ TTestRecord = record procedure SetStringField(S: string); end; + TFruitDynArray = TArray; TTestRttiAccess = class private FFruit: TFruit; @@ -45,8 +47,11 @@ TTestRttiAccess = class RecordField: TTestRecord; InterfaceField: ITestInterface; procedure BuyFruits(AFruits: TFruits); + procedure SellFruits(const AFruits: TFruitDynArray); + procedure SellFruitsInt(const AFruits:TIntegerDynArray); property Fruit: TFruit read FFruit write FFruit; property Fruits: TFruits read FFruits write FFruits; + end; TTestInterfaceImpl = class(TInterfacedObject, ITestInterface) @@ -99,6 +104,8 @@ TTestWrapDelphi = class(TObject) procedure TestInterface; [Test] procedure TestInterfaceField; + [Test] + procedure TestDynArrayParameters; end; implementation @@ -339,6 +346,45 @@ procedure TTestWrapDelphi.TestStringField; Assert.AreEqual(TestRttiAccess.StringField, 'P4D'); end; +procedure TTestWrapDelphi.TestDynArrayParameters; +{var + rc: TRttiContext; + rt: TRttiType; + rm: TRttiMethod; + rp: TArray; + ra: TArray;} +begin +{ rc := TRttiContext.Create; + rt := rc.GetType(TypeInfo(TTestRttiAccess)); + rm := rt.GetMethod('SellFruitsInt'); + rp := rm.GetParameters; + SetLength(ra, 1); + ra[0] := TValue.FromArray(TypeInfo(TIntegerDynArray), [TValue.From(0)]); + rm.Invoke(TestRttiAccess, ra);} + TestRttiAccess.Fruits := [TFruit.Apple, TFruit.Banana, TFruit.Orange]; + Rtti_Var.SellFruitsInt(VarPythonCreate([0, 1], stList)); + Assert.IsTrue(TestRttiAccess.Fruits = [Orange]); + TestRttiAccess.Fruits := [TFruit.Apple, TFruit.Banana, TFruit.Orange]; + Rtti_Var.SellFruits(VarPythonCreate([Ord(TFruit.Apple), Ord(TFruit.Banana)], stList)); + Assert.IsTrue(TestRttiAccess.Fruits = [Orange]); +end; + +procedure TTestRttiAccess.SellFruits(const AFruits: TFruitDynArray); +var + Fruit: TFruit; +begin + for Fruit in AFruits do + Exclude(FFruits, Fruit); +end; + +procedure TTestRttiAccess.SellFruitsInt(const AFruits:TIntegerDynArray); +var + Fruit: Integer; +begin + for Fruit in AFruits do + Exclude(FFruits, TFruit(Fruit)); +end; + { TTestRecord } procedure TTestRecord.SetStringField(S: string);