From 7ff975686861123bb2b7fff8b38c51f5a3138741 Mon Sep 17 00:00:00 2001 From: ElminsterAU Date: Sat, 9 Oct 2021 17:45:26 +1000 Subject: [PATCH 1/6] Add support for interface and record function results --- Source/WrapDelphi.pas | 112 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 104 insertions(+), 8 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index df12da7a..bc74de57 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -606,9 +606,10 @@ TPyDelphiVarParameter = class(TPyObject) { Base class for exposing Records and Interfaces when Extended RTTI is available } TPyRttiObject = class (TPyObject) private - fAddr: Pointer; - fRttiType: TRttiStructuredType; - function GetValue: TValue; virtual; abstract; + fCopy: PValue; + fAddr: Pointer; + fRttiType: TRttiStructuredType; + function GetValue: TValue; virtual; abstract; protected // Exposed Methods function SetProps(args, keywords : PPyObject) : PPyObject; cdecl; @@ -616,7 +617,9 @@ TPyRttiObject = class (TPyObject) public PyDelphiWrapper : TPyDelphiWrapper; constructor Create( APythonType : TPythonType ); override; + destructor Destroy; override; procedure SetAddrAndType(Address: Pointer; Typ: TRttiStructuredType); + procedure KeepCopy(const aValue: TValue); function GetAttrO( key: PPyObject) : PPyObject; override; function SetAttrO( key, value: PPyObject) : Integer; override; @@ -842,10 +845,12 @@ TPyDelphiWrapper = class(TEngineClient, IFreeNotificationSubscriber) {$IFDEF EXTENDED_RTTI} // Function that provides a Python object wrapping a record function WrapRecord(Address: Pointer; Typ: TRttiStructuredType): PPyObject; + function WrapRecordCopy(const IValue: TValue): PPyObject; // Function that provides a Python object wrapping an interface // Note the the interface must be compiled in {$M+} mode and have a guid // Usage: WrapInterface(TValue.From(YourInterfaceReference)) function WrapInterface(const IValue: TValue): PPyObject; + function WrapInterfaceCopy(const IValue: TValue): PPyObject; {$ENDIF} // properties property EventHandlers : TEventHandlers read fEventHandlerList; @@ -2051,6 +2056,15 @@ constructor TPyRttiObject.Create(APythonType: TPythonType); PyDelphiWrapper := TPyDelphiWrapper(APythonType.Owner); end; +destructor TPyRttiObject.Destroy; +begin + if Assigned(fCopy) then begin + Dispose(fCopy); + fCopy := nil; + end; + inherited; +end; + function TPyRttiObject.Dir_Wrapper(args: PPyObject): PPyObject; var i : Integer; @@ -2092,6 +2106,30 @@ function TPyRttiObject.GetAttrO(key: PPyObject): PPyObject; PyUnicodeFromString(Format(rs_ErrAttrGet,[KeyName, ErrMsg]))); end; +procedure TPyRttiObject.KeepCopy(const aValue: TValue); +var + Context: TRttiContext; + RttiType: TRttiStructuredType; + Addr : Pointer; +begin + Context := TRttiContext.Create(); + try + RttiType := Context.GetType(aValue.TypeInfo) as TRttiStructuredType; + finally + Context.Free; + end; + if Assigned(fCopy) then begin + Dispose(fCopy); + fCopy := nil; + end; + New(fCopy); + fCopy^ := aValue; + Addr := fCopy^.GetReferenceToRawData; + if RttiType.TypeKind = tkInterface then + Addr := PPointer(Addr)^; + SetAddrAndType(Addr, RttiType); +end; + class procedure TPyRttiObject.RegisterMethods(PythonType: TPythonType); begin inherited; @@ -2158,7 +2196,10 @@ procedure TPyRttiObject.SetAddrAndType(Address: Pointer; Typ: TRttiStructuredTyp function TPyPascalRecord.GetValue: TValue; begin - TValue.Make(fAddr, RttiType.Handle, Result); + if Assigned(fCopy) then + Result := fCopy^ + else + TValue.Make(fAddr, RttiType.Handle, Result); end; class procedure TPyPascalRecord.SetupType(PythonType: TPythonType); @@ -2172,7 +2213,10 @@ class procedure TPyPascalRecord.SetupType(PythonType: TPythonType); function TPyPascalInterface.GetValue: TValue; begin - TValue.Make(@fAddr, RttiType.Handle, Result); + if Assigned(fCopy) then + Result := fCopy^ + else + TValue.Make(@fAddr, RttiType.Handle, Result); end; class procedure TPyPascalInterface.SetupType(PythonType: TPythonType); @@ -2994,9 +3038,14 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; ret := meth.Invoke(Addr, Args); if ret.IsEmpty then Result := GetPythonEngine.ReturnNone - else if ret.Kind = tkClass then - Result := fDelphiWrapper.Wrap(ret.AsObject) - else begin + else case ret.Kind of + tkClass: + Result := fDelphiWrapper.Wrap(ret.AsObject); + tkInterface: + Result := fDelphiWrapper.WrapInterfaceCopy(ret); + tkRecord: + Result := fDelphiWrapper.WrapRecordCopy(ret); + else Result := SimpleValueToPython(ret, ErrMsg); if Result = nil then with PythonType.Engine do @@ -3842,6 +3891,28 @@ function TPyDelphiWrapper.WrapRecord(Address: Pointer; Typ: TRttiStructuredType) end; end; +function TPyDelphiWrapper.WrapRecordCopy(const IValue: TValue) : PPyObject; +var + PythonType: TPythonType; +begin + CheckEngine; + if IValue.IsEmpty then begin + Result := Engine.ReturnNone; + Exit; + end; + PythonType := GetHelperType('PascalRecordType'); + if not Assigned(PythonType) or (IValue.Kind <> tkRecord) then + begin + Result := Engine.ReturnNone; + Exit; + end; + Result := PythonType.CreateInstance; + with PythonToDelphi(Result) as TPyPascalRecord do begin + KeepCopy(IValue); + PyDelphiWrapper := Self; + end; +end; + function TPyDelphiWrapper.WrapInterface(const IValue: TValue): PPyObject; var PythonType: TPythonType; @@ -3868,6 +3939,31 @@ function TPyDelphiWrapper.WrapInterface(const IValue: TValue): PPyObject; end; end; +function TPyDelphiWrapper.WrapInterfaceCopy(const IValue: TValue): PPyObject; +var + PythonType: TPythonType; + Typ: TRttiStructuredType; +begin + CheckEngine; + if IValue.IsEmpty then begin + Result := Engine.ReturnNone; + Exit; + end; + PythonType := GetHelperType('PascalInterfaceType'); + if not Assigned(PythonType) or (IValue.Kind <> tkInterface) then + begin + Result := Engine.ReturnNone; + Exit; + end; + Result := PythonType.CreateInstance; + Typ := TRttiContext.Create.GetType(IValue.TypeInfo) as TRttiStructuredType; + with PythonToDelphi(Result) as TPyPascalInterface do begin + KeepCopy(IValue); + PyDelphiWrapper := Self; + end; +end; + + // To keep the RTTI Pool alive and avoid continuously creating/destroying it // See also https://stackoverflow.com/questions/27368556/trtticontext-multi-thread-issue Var From 369639b8611d1d84291128324902ff799dda9129 Mon Sep 17 00:00:00 2001 From: ElminsterAU Date: Sun, 10 Oct 2021 01:19:40 +1000 Subject: [PATCH 2/6] fixed unused variable from previous commit --- Source/WrapDelphi.pas | 2 -- 1 file changed, 2 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index bc74de57..ddc7c555 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -3942,7 +3942,6 @@ function TPyDelphiWrapper.WrapInterface(const IValue: TValue): PPyObject; function TPyDelphiWrapper.WrapInterfaceCopy(const IValue: TValue): PPyObject; var PythonType: TPythonType; - Typ: TRttiStructuredType; begin CheckEngine; if IValue.IsEmpty then begin @@ -3956,7 +3955,6 @@ function TPyDelphiWrapper.WrapInterfaceCopy(const IValue: TValue): PPyObject; Exit; end; Result := PythonType.CreateInstance; - Typ := TRttiContext.Create.GetType(IValue.TypeInfo) as TRttiStructuredType; with PythonToDelphi(Result) as TPyPascalInterface do begin KeepCopy(IValue); PyDelphiWrapper := Self; From 6a0c62f98b438b50721a050266b6e24880435eb0 Mon Sep 17 00:00:00 2001 From: ElminsterAU Date: Sun, 10 Oct 2021 01:20:56 +1000 Subject: [PATCH 3/6] support interfaces and records (including var/out) as parameters of calls --- Source/WrapDelphi.pas | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index ddc7c555..f0ea6341 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -2937,9 +2937,13 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; if (Param.ParamType = nil) or (Param.Flags * [TParamFlag.pfVar, TParamFlag.pfOut] <> []) then begin - Result := nil; - SearchContinue := True; - Break; + if Assigned(Param.ParamType) and (Param.ParamType.TypeKind = tkRecord) then + //ok + else begin + Result := nil; + SearchContinue := True; + Break; + end end; PyValue := PythonType.Engine.PyTuple_GetItem(PyArgs, Index); @@ -2967,6 +2971,22 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; Break end end + else if Param.ParamType.TypeKind = tkInterface then + begin + if not ValidateInterfaceProperty(PyValue, Param.ParamType as TRttiInterfaceType, Args[Index], ErrMsg) + then begin + Result := nil; + Break + end + end + else if Param.ParamType.TypeKind = tkRecord then + begin + if not ValidateRecordProperty(PyValue, Param.ParamType.Handle, Args[Index], ErrMsg) + then 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 From 2f627f6647e22620916095cb5f7a1945ca373b0f Mon Sep 17 00:00:00 2001 From: ElminsterAU Date: Sun, 10 Oct 2021 01:38:04 +1000 Subject: [PATCH 4/6] added support for tkMRecord --- Source/WrapDelphi.pas | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index f0ea6341..9b2d4670 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -1004,7 +1004,7 @@ function SimpleValueToPython(const Value: TValue; out ErrMsg: string): PPyObject tkArray, tkDynArray: Result := DynArrayToPython(Value); tkClass, tkMethod, - tkRecord, tkInterface, + tkRecord, tkInterface, {$IFDEF MANAGED_RECORD} tkMRecord,{$ENDIF} tkClassRef, tkPointer, tkProcedure: ErrMsg := rs_ErrValueToPython; else @@ -1070,7 +1070,7 @@ function SimplePythonToValue(PyValue: PPyObject; TypeInfo: PTypeInfo; Result := True; end; tkClass, tkMethod, tkArray, - tkRecord, tkInterface, + tkRecord, tkInterface,{$IFDEF MANAGED_RECORD} tkMRecord,{$ENDIF} tkClassRef, tkPointer, tkProcedure: ErrMsg := rs_ErrPythonToValue; else @@ -1928,7 +1928,7 @@ function GetRttiAttr(ParentAddr: Pointer; ParentType: TRttiStructuredType; Result := PyDelphiWrapper.Wrap(Field.GetValue(ParentAddr).AsObject); // Returns None if Field is nil tkInterface: Result := PyDelphiWrapper.WrapInterface(Field.GetValue(ParentAddr)); - tkRecord: + tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: if Field.FieldType is TRttiStructuredType then //Result := PyDelphiWrapper.WrapRecord(Pointer(PPByte(ParentAddr)^ + Field.Offset), TRttiStructuredType(Field.FieldType)); Result := PyDelphiWrapper.WrapRecord(PByte(ParentAddr) + Field.Offset, TRttiStructuredType(Field.FieldType)); @@ -1981,7 +1981,7 @@ function SetRttiAttr(const ParentAddr: Pointer; ParentType: TRttiStructuredType Prop.SetValue(ParentAddr, ValueOut); Result := True; end; - tkRecord: + tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: if ValidateRecordProperty(Value, Prop.PropertyType.Handle, ValueOut, ErrMsg) then begin Prop.SetValue(ParentAddr, ValueOut); Result := True; @@ -2026,7 +2026,7 @@ function SetRttiAttr(const ParentAddr: Pointer; ParentType: TRttiStructuredType Field.SetValue(ParentAddr, ValueOut); Result := True; end; - tkRecord: + tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: if ValidateRecordProperty(Value, Field.FieldType.Handle, ValueOut, ErrMsg) then begin Field.SetValue(ParentAddr, ValueOut); Result := True; @@ -2937,7 +2937,7 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; if (Param.ParamType = nil) or (Param.Flags * [TParamFlag.pfVar, TParamFlag.pfOut] <> []) then begin - if Assigned(Param.ParamType) and (Param.ParamType.TypeKind = tkRecord) then + if Assigned(Param.ParamType) and (Param.ParamType.TypeKind in [tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}]) then //ok else begin Result := nil; @@ -2979,7 +2979,7 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; Break end end - else if Param.ParamType.TypeKind = tkRecord then + else if Param.ParamType.TypeKind in [tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}] then begin if not ValidateRecordProperty(PyValue, Param.ParamType.Handle, Args[Index], ErrMsg) then begin @@ -3063,7 +3063,7 @@ function TPyDelphiMethodObject.Call(ob1, ob2: PPyObject): PPyObject; Result := fDelphiWrapper.Wrap(ret.AsObject); tkInterface: Result := fDelphiWrapper.WrapInterfaceCopy(ret); - tkRecord: + tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: Result := fDelphiWrapper.WrapRecordCopy(ret); else Result := SimpleValueToPython(ret, ErrMsg); @@ -3921,7 +3921,7 @@ function TPyDelphiWrapper.WrapRecordCopy(const IValue: TValue) : PPyObject; Exit; end; PythonType := GetHelperType('PascalRecordType'); - if not Assigned(PythonType) or (IValue.Kind <> tkRecord) then + if not Assigned(PythonType) or not (IValue.Kind in [tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}]) then begin Result := Engine.ReturnNone; Exit; From 61d3319de6baa32d22fdcce335c14db9b2f5dbb8 Mon Sep 17 00:00:00 2001 From: ElminsterAU Date: Sun, 10 Oct 2021 01:57:44 +1000 Subject: [PATCH 5/6] added support for reading record properties (setting them was already supported) --- Source/WrapDelphi.pas | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index 9b2d4670..4330a3ea 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -1004,7 +1004,7 @@ function SimpleValueToPython(const Value: TValue; out ErrMsg: string): PPyObject tkArray, tkDynArray: Result := DynArrayToPython(Value); tkClass, tkMethod, - tkRecord, tkInterface, {$IFDEF MANAGED_RECORD} tkMRecord,{$ENDIF} + tkRecord, tkInterface, {$IFDEF MANAGED_RECORD} tkMRecord,{$ENDIF} tkClassRef, tkPointer, tkProcedure: ErrMsg := rs_ErrValueToPython; else @@ -1905,6 +1905,9 @@ function GetRttiAttr(ParentAddr: Pointer; ParentType: TRttiStructuredType; Result := PyDelphiWrapper.Wrap(Prop.GetValue(ParentAddr).AsObject); tkInterface: Result := PyDelphiWrapper.WrapInterface(Prop.GetValue(ParentAddr)); + tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: + // Must be a copy, property getters are not allowed to leak access to underlying storage + Result := PyDelphiWrapper.WrapRecordCopy(Prop.GetValue(ParentAddr)); tkMethod: if (ParentType is TRttiInstanceType) and (Prop is TRttiInstanceProperty) then Result := PyDelphiWrapper.fEventHandlerList.GetCallable(TObject(ParentAddr), @@ -1930,7 +1933,13 @@ function GetRttiAttr(ParentAddr: Pointer; ParentType: TRttiStructuredType; Result := PyDelphiWrapper.WrapInterface(Field.GetValue(ParentAddr)); tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: if Field.FieldType is TRttiStructuredType then - //Result := PyDelphiWrapper.WrapRecord(Pointer(PPByte(ParentAddr)^ + Field.Offset), TRttiStructuredType(Field.FieldType)); + //Potentially dangerous as the returned value, which is a pointer into the object, + //could be stored on the python side, then the object freed, and the stored pointer later + //used to access no longer allocated memory + //But I can't see any good alternative if Python should be able to write directly into + //fields of a record that's part of an object. + //Maybe a relationship should be established between this wrapper and the wrapper of the parent object + //such that a free notification on the parent object will disable access through this wrapper? Result := PyDelphiWrapper.WrapRecord(PByte(ParentAddr) + Field.Offset, TRttiStructuredType(Field.FieldType)); else Result := SimpleValueToPython(Field.GetValue(ParentAddr), ErrMsg) From c9e9d744f8e560840228d286a4b4d0ce339db6fc Mon Sep 17 00:00:00 2001 From: ElminsterAU Date: Sun, 10 Oct 2021 02:10:19 +1000 Subject: [PATCH 6/6] fix for bug that allowed uncounted interface references to be returned when reading interface type fields or properties --- Source/WrapDelphi.pas | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index 4330a3ea..d11a7174 100644 --- a/Source/WrapDelphi.pas +++ b/Source/WrapDelphi.pas @@ -849,6 +849,10 @@ TPyDelphiWrapper = class(TEngineClient, IFreeNotificationSubscriber) // Function that provides a Python object wrapping an interface // Note the the interface must be compiled in {$M+} mode and have a guid // Usage: WrapInterface(TValue.From(YourInterfaceReference)) + // Warning: WrapInterface represents a weak (uncounted) reference! + // Use WrapInterfaceCopy to retrieve a normal counted reference + // that will keep the interface alive as long as python has a + // reference to it. function WrapInterface(const IValue: TValue): PPyObject; function WrapInterfaceCopy(const IValue: TValue): PPyObject; {$ENDIF} @@ -1904,7 +1908,9 @@ function GetRttiAttr(ParentAddr: Pointer; ParentType: TRttiStructuredType; tkClass: Result := PyDelphiWrapper.Wrap(Prop.GetValue(ParentAddr).AsObject); tkInterface: - Result := PyDelphiWrapper.WrapInterface(Prop.GetValue(ParentAddr)); + // Must be a copy, otherwise reference counting fails and the returned + // interface might be freed while python is holding a reference to it + Result := PyDelphiWrapper.WrapInterfaceCopy(Prop.GetValue(ParentAddr)); tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: // Must be a copy, property getters are not allowed to leak access to underlying storage Result := PyDelphiWrapper.WrapRecordCopy(Prop.GetValue(ParentAddr)); @@ -1930,7 +1936,9 @@ function GetRttiAttr(ParentAddr: Pointer; ParentType: TRttiStructuredType; tkClass: Result := PyDelphiWrapper.Wrap(Field.GetValue(ParentAddr).AsObject); // Returns None if Field is nil tkInterface: - Result := PyDelphiWrapper.WrapInterface(Field.GetValue(ParentAddr)); + // Must be a copy, otherwise reference counting fails and the returned + // interface might be freed while python is holding a reference to it + Result := PyDelphiWrapper.WrapInterfaceCopy(Field.GetValue(ParentAddr)); tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: if Field.FieldType is TRttiStructuredType then //Potentially dangerous as the returned value, which is a pointer into the object,