diff --git a/Source/WrapDelphi.pas b/Source/WrapDelphi.pas index df12da7a..d11a7174 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,16 @@ 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)) + // 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} // properties property EventHandlers : TEventHandlers read fEventHandlerList; @@ -999,7 +1008,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 @@ -1065,7 +1074,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 @@ -1899,7 +1908,12 @@ 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)); tkMethod: if (ParentType is TRttiInstanceType) and (Prop is TRttiInstanceProperty) then Result := PyDelphiWrapper.fEventHandlerList.GetCallable(TObject(ParentAddr), @@ -1922,10 +1936,18 @@ 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)); - tkRecord: + // 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 - //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) @@ -1976,7 +1998,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; @@ -2021,7 +2043,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; @@ -2051,6 +2073,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 +2123,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 +2213,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 +2230,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); @@ -2893,9 +2954,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 in [tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}]) then + //ok + else begin + Result := nil; + SearchContinue := True; + Break; + end end; PyValue := PythonType.Engine.PyTuple_GetItem(PyArgs, Index); @@ -2923,6 +2988,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 in [tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}] 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 @@ -2994,9 +3075,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{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}: + Result := fDelphiWrapper.WrapRecordCopy(ret); + else Result := SimpleValueToPython(ret, ErrMsg); if Result = nil then with PythonType.Engine do @@ -3842,6 +3928,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 not (IValue.Kind in [tkRecord{$IFDEF MANAGED_RECORD},tkMRecord{$ENDIF}]) 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 +3976,29 @@ function TPyDelphiWrapper.WrapInterface(const IValue: TValue): PPyObject; end; end; +function TPyDelphiWrapper.WrapInterfaceCopy(const IValue: TValue): PPyObject; +var + PythonType: TPythonType; +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; + 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