diff --git a/python4lazarus/Definition.Inc b/python4lazarus/Definition.Inc index df5bb4a..6407265 100644 --- a/python4lazarus/Definition.Inc +++ b/python4lazarus/Definition.Inc @@ -108,7 +108,7 @@ {$DEFINE DELPHIXE6_OR_HIGHER} {$DEFINE DELPHIXE7_OR_HIGHER} {$DEFINE DELPHIXE8_OR_HIGHER} - {$DEFINE DELPHIX10_OR_HIGHER} + {$DEFINE DELPHI10_OR_HIGHER} {$ENDIF} {$IFDEF VER310} // Delphi 10.1 {$DEFINE DELPHI10_1} @@ -171,6 +171,9 @@ {$DEFINE DELPHI10_2_OR_HIGHER} {$DEFINE DELPHI10_3_OR_HIGHER} {$DEFINE DELPHI10_4_OR_HIGHER} + {$IF RTLVERSION1042} + {$DEFINE DELPHI10_4_2} //Delphi 10.4.2 + {$ENDIF RTLVERSION1042} {$ENDIF} {$IFDEF VER350} // Delphi 11 {$DEFINE DELPHI11} @@ -190,6 +193,45 @@ {$DEFINE DELPHI10_4_OR_HIGHER} {$DEFINE DELPHI11_OR_HIGHER} {$ENDIF} +{$IFDEF VER360} // Delphi 12 + {$DEFINE DELPHI2010_OR_HIGHER} + {$DEFINE DELPHIXE_OR_HIGHER} + {$DEFINE DELPHI12} + {$DEFINE DELPHIXE2_OR_HIGHER} + {$DEFINE DELPHIXE3_OR_HIGHER} + {$DEFINE DELPHIXE4_OR_HIGHER} + {$DEFINE DELPHIXE5_OR_HIGHER} + {$DEFINE DELPHIXE6_OR_HIGHER} + {$DEFINE DELPHIXE7_OR_HIGHER} + {$DEFINE DELPHIXE8_OR_HIGHER} + {$DEFINE DELPHI10_OR_HIGHER} + {$DEFINE DELPHI10_1_OR_HIGHER} + {$DEFINE DELPHI10_2_OR_HIGHER} + {$DEFINE DELPHI10_3_OR_HIGHER} + {$DEFINE DELPHI10_4_OR_HIGHER} + {$DEFINE DELPHI11_OR_HIGHER} + {$DEFINE DELPHI12_OR_HIGHER} +{$ENDIF} +{$IFDEF VER370} // Delphi 13 + {$DEFINE DELPHI2010_OR_HIGHER} + {$DEFINE DELPHIXE_OR_HIGHER} + {$DEFINE DELPHI13} + {$DEFINE DELPHIXE2_OR_HIGHER} + {$DEFINE DELPHIXE3_OR_HIGHER} + {$DEFINE DELPHIXE4_OR_HIGHER} + {$DEFINE DELPHIXE5_OR_HIGHER} + {$DEFINE DELPHIXE6_OR_HIGHER} + {$DEFINE DELPHIXE7_OR_HIGHER} + {$DEFINE DELPHIXE8_OR_HIGHER} + {$DEFINE DELPHI10_OR_HIGHER} + {$DEFINE DELPHI10_1_OR_HIGHER} + {$DEFINE DELPHI10_2_OR_HIGHER} + {$DEFINE DELPHI10_3_OR_HIGHER} + {$DEFINE DELPHI10_4_OR_HIGHER} + {$DEFINE DELPHI11_OR_HIGHER} + {$DEFINE DELPHI12_OR_HIGHER} + {$DEFINE DELPHI13_OR_HIGHER} +{$ENDIF} ///////////////////////////////////////////////////////////////////////////// // Misc @@ -201,22 +243,44 @@ {$IFDEF FPC} {$MODE DELPHI} + {$IFDEF CPU64} + {$DEFINE CPU64BITS} {$DEFINE CPUX64} {$ENDIF CPU64} - {$IFDEF CPU32} + + {$IFDEF CPU86} {$DEFINE CPUX86} - {$ENDIF CPU32} + {$ENDIF CPU86} + {$IFDEF DARWIN} + {$DEFINE OSX} {$DEFINE MACOS} - {$DEFINE ALIGN_STACK} {$IFDEF CPU32} {$DEFINE MACOS32} {$ENDIF CPU32} + {$IFDEF CPU64} + {$DEFINE MACOS64} + {$DEFINE OSX64} + {$ENDIF CPU64} {$ENDIF DARWIN} + + {$IFDEF CPUARM} + {$DEFINE CPUARM32} + {$ENDIF} + + {$IFDEF CPUAARCH64} + {$DEFINE CPUARM} + {$DEFINE CPUARM64} + {$ENDIF} + {$IFDEF UNIX} {$DEFINE POSIX} {$ENDIF UNIX} + + {$IFDEF ANDROID} + {$DEFINE POSIX} + {$ENDIF ANDROID} {$ENDIF FPC} {$IFDEF DELPHIXE_OR_HIGHER} @@ -227,10 +291,6 @@ {$LEGACYIFEND ON} {$ENDIF DELPHIXE4_OR_HIGHER} - -{$IFDEF DELPHIXE2_OR_HIGHER} - {$IFDEF MACOS} - {$DEFINE DARWIN} - {$ENDIF MACOS} -{$ENDIF DELPHIXE2_OR_HIGHER} - +{$IFDEF MACOS} + {$DEFINE DARWIN} +{$ENDIF MACOS} diff --git a/python4lazarus/MethodCallBack.pas b/python4lazarus/MethodCallBack.pas index 07f2c96..022e21d 100644 --- a/python4lazarus/MethodCallBack.pas +++ b/python4lazarus/MethodCallBack.pas @@ -17,6 +17,7 @@ (* Morgan Martinet (p4d@mmm-experts.com) *) (* Samuel Iseli (iseli@vertec.ch) *) (* Andrey Gruzdev (andrey.gruzdev@gmail.com) *) +(* Lucas Belo (lucas.belo@live.com) *) (**************************************************************************) (* This source code is distributed with no WARRANTY, for no reason or use.*) (* Everyone is allowed to use and change this code free, as long as this *) @@ -32,7 +33,7 @@ interface uses SysUtils; type - TCallType = (ctSTDCALL, ctCDECL); + TCallType = (ctSTDCALL, ctCDECL, ctARMSTD); TCallBack = procedure of object; function GetCallBack( self: TObject; method: Pointer; @@ -127,6 +128,9 @@ implementation PtrCalcType = NativeInt; {$ENDIF} + EMProtectError = class(Exception) + end; + {$IFNDEF MSWINDOWS} {$IFDEF FPC} function mmap(Addr: Pointer; Len: Integer; Prot: Integer; Flags: Integer; FileDes: Integer; Off: Integer): Pointer; cdecl; @@ -151,6 +155,9 @@ procedure GetCodeMem(var ptr: PByte; size: integer); var page: PCodeMemPage; block: PCodeMemBlock; + {$IFNDEF MSWINDOWS} + flags: integer; + {$ENDIF} begin //---allocates Block from executable memory // executable memory is requested in pages via VirtualAlloc @@ -174,13 +181,40 @@ procedure GetCodeMem(var ptr: PByte; size: integer); ptr := nil; exit; end; - mprotect(page, PageSize, PROT_READ or PROT_WRITE or PROT_EXEC); - {$ENDIF} + { + macOS for M1 has a bug (Apple Feedback FB8994773) in which mprotect + rejects a permission change from NONE -> RWX, resulting a "Permission + Denied" error. + Solution: give RW permission, make memory changes, then change RW to X + } + {$IF DEFINED(OSX) AND DEFINED(CPUARM64)} + flags := PROT_READ or PROT_WRITE; + {$ELSE} + flags := PROT_READ or PROT_WRITE or PROT_EXEC; + {$IFEND} + if mprotect(page, PageSize, flags) <> 0 then + raise EMProtectError.CreateFmt('MProtect error: %s', [ + SysErrorMessage({$IFDEF FPC}GetLastOSError{$ELSE}GetLastError{$ENDIF}())]); + {$ENDIF} page^.next:=CodeMemPages; CodeMemPages:=page; // init pointer to end of page page^.CodeBlocks:=Pointer(PtrCalcType(page) + PageSize); + {$IF DEFINED(OSX) AND DEFINED(CPUARM64)} + end else begin + { + macOS for M1 has a bug (Apple Feedback FB8994773) in which mprotect + rejects a permission change from NONE -> RWX. + Solution: give RW permission, make memory changes, then change RW to X + } + //RW permission to the entire page for new changes... + if mprotect(page, PageSize, PROT_READ or PROT_WRITE) <> 0 then + raise EMProtectError.CreateFmt('MProtect error: %s', [ + SysErrorMessage({$IFDEF FPC}GetLastOSError{$ELSE}GetLastError{$ENDIF}())]); end; + {$ELSE} + end; + {$IFEND} //---blocks are assigned starting from the end of the page block:=Pointer(PtrCalcType(page^.codeBlocks) - (size + sizeof(PCodeMemBlock))); @@ -258,6 +292,34 @@ function CodeMemPageCount: integer; end; end; +procedure DeleteCallBack( Proc: Pointer); +begin + FreeCodeMem(Proc); +end; + +procedure FreeCallBacks; +var + page, nextpage: PCodeMemPage; +begin + // free each allocated page + page := CodeMemPages; + while page <> nil do + begin + nextpage := page^.Next; + + // free the memory + {$IFDEF MSWINDOWS} + VirtualFree(page, 0, MEM_RELEASE); + {$ELSE} + //FreeMem(page); + munmap(page,PageSize); + {$ENDIF} + + page := nextpage; + end; + CodeMemPages := nil; +end; + function GetOfObjectCallBack( CallBack: TCallBack; argnum: Integer; calltype: TCallType): Pointer; begin @@ -266,15 +328,17 @@ function GetOfObjectCallBack( CallBack: TCallBack; argnum, calltype); end; -{$IFDEF CPUX64} -{$DEFINE 64_BIT_CALLBACK} -{$ELSE} -{$IFDEF MACOS} -{$DEFINE ALIGNED_32_BIT_CALLBACK} -{$ELSE} -{$DEFINE SIMPLE_32_BIT_CALLBACK} -{$ENDIF MACOS} -{$ENDIF CPUX64} +{$IFNDEF CPUARM} + {$IFDEF CPUX64} + {$DEFINE 64_BIT_CALLBACK} + {$ELSE} + {$IFDEF MACOS} + {$DEFINE ALIGNED_32_BIT_CALLBACK} + {$ELSE} + {$DEFINE SIMPLE_32_BIT_CALLBACK} + {$ENDIF MACOS} + {$ENDIF CPUX64} +{$ENDIF CPUARM} {$IFDEF SIMPLE_32_BIT_CALLBACK} // win32 inplementation @@ -565,35 +629,138 @@ function GetCallBack( self: TObject; method: Pointer; end; {$ENDIF} -procedure DeleteCallBack( Proc: Pointer); +{$IFDEF CPUARM32} +function GetCallBack(Self: TObject; Method: Pointer; ArgNum: Integer; + CallType: TCallType): Pointer; +const + S1: array[0..123] of byte = ( +//big-endian +//offset : + {+ 0:} $80, $40, $2d, $e9, // push {r7, lr} + {+ 4:} $0d, $70, $a0, $e1, // mov r7, sp + {+ 8:} $1e, $04, $2d, $e9, // push {r1, r2, r3, r4, sl} + {+ c:} $5c, $40, $9f, $e5, // ldr r4, [pc, #92] ; 70 + {+ 10:} $00, $00, $54, $e3, // cmp r4, #0 + {+ 14:} $04, $d0, $4d, $c0, // subgt sp, sp, r4 + {+ 18:} $04, $50, $a0, $c1, // movgt r5, r4 + {+ 1c:} $04, $50, $85, $c2, // addgt r5, r5, #4 + {+ 20:} $04, $60, $a0, $c1, // movgt r6, r4 + {+ 24:} $04, $60, $46, $c2, // subgt r6, r6, #4 + {+ 28:} $09, $00, $00, $cb, // blgt 54 + {+ 2c:} $0f, $00, $2d, $e9, // push {r0, r1, r2, r3} + {+ 30:} $3c, $00, $9f, $e5, // ldr r0, [pc, #60] ; 74 + {+ 34:} $0e, $00, $bd, $e8, // pop {r1, r2, r3} + {+ 38:} $38, $a0, $9f, $e5, // ldr sl, [pc, #56] ; 78 + {+ 3c:} $3a, $ff, $2f, $e1, // blx sl + {+ 40:} $00, $00, $54, $e3, // cmp r4, #0 + {+ 44:} $04, $d0, $8d, $c0, // addgt sp, sp, r4 + {+ 48:} $04, $40, $9d, $e4, // pop {r4} ; (ldr r4, [sp], #4) + {+ 4c:} $1e, $04, $bd, $e8, // pop {r1, r2, r3, r4, sl} + {+ 50:} $80, $80, $bd, $e8, // pop {r7, pc} +//offset + 00000054 : + {+ 54:} $05, $a0, $97, $e7, // ldr sl, [r7, r5] + {+ 58:} $06, $a0, $8d, $e7, // str sl, [sp, r6] + {+ 5c:} $04, $50, $45, $e2, // sub r5, r5, #4 + {+ 60:} $04, $60, $46, $e2, // sub r6, r6, #4 + {+ 64:} $00, $00, $56, $e3, // cmp r6, #0 + {+ 68:} $f9, $ff, $ff, $aa, // bge 54 + {+ 6c:} $1e, $ff, $2f, $e1, // bx lr +//offset + 00000070 + {+ 70:} $00, $00, $00, $00, // stack space for stack parameters + {+ 74:} $00, $00, $00, $00, // Self + {+ 78:} $00, $00, $00, $00 // Method +); +const + ARM_INSTRUCTION_SIZE = 4; + ARM_ARGUMENT_COUNT_IN_REGISTERS = 4; +var + P, Q: PByte; + LLiteralPool: TArray; + I: Integer; begin - FreeCodeMem(Proc); + GetCodeMem(Q, SizeOf(S1)); + P := Q; + Move(S1, P^, SizeOf(S1)); + + LLiteralPool := TArray.Create( + Pointer((ArgNum - ARM_ARGUMENT_COUNT_IN_REGISTERS) * ARM_INSTRUCTION_SIZE), + Self, + Method); + + Inc(P, Length(S1) - (Length(LLiteralPool) * SizeOf(pointer))); + for I := Low(LLiteralPool) to High(LLiteralPool) do begin + Move(LLiteralPool[I], P^, SizeOf(pointer)); + Inc(P, SizeOf(pointer)); + end; + + Result := Pointer(Q); //set arm mode end; +{$ENDIF CPUARM32} -procedure FreeCallBacks; +{$IFDEF CPUARM64} +function GetCallBack(Self: TObject; Method: Pointer; ArgNum: Integer; + CallType: TCallType): Pointer; +const + S1: array[0..79] of byte = ( +//big-endian +//offset <_start>: + $fd, $7b, $bf, $a9, // stp x29, x30, [sp, #-16]! + $fd, $03, $00, $91, // mov x29, sp + $e0, $07, $bf, $a9, // stp x0, x1, [sp, #-16]! + $e2, $0f, $bf, $a9, // stp x2, x3, [sp, #-16]! + $e4, $17, $bf, $a9, // stp x4, x5, [sp, #-16]! + $e6, $1f, $bf, $a9, // stp x6, x7, [sp, #-16]! + $0a, $00, $00, $10, // adr x10, #0 <_start+0x18> + $40, $15, $40, $f9, // ldr x0, [x10, #40] + $49, $19, $40, $f9, // ldr x9, [x10, #48] + $e7, $2f, $c1, $a8, // ldp x7, x11, [sp], #16 + $e5, $1b, $c1, $a8, // ldp x5, x6, [sp], #16 + $e3, $13, $c1, $a8, // ldp x3, x4, [sp], #16 + $e1, $0b, $c1, $a8, // ldp x1, x2, [sp], #16 + $20, $01, $3f, $d6, // blr x9 + $fd, $7b, $c1, $a8, // ldp x29, x30, [sp], #16 + $c0, $03, $5f, $d6, // ret + $00, $00, $00, $00, // .word 0x00000000 //Self + $00, $00, $00, $00, // .word 0x00000000 + $00, $00, $00, $00, // .word 0x00000000 //Method + $00, $00, $00, $00 // .word 0x00000000 +); var - page, nextpage: PCodeMemPage; + P, Q: PByte; + LLiteralPool: TArray; + I: Integer; begin - // free each allocated page - page := CodeMemPages; - while page <> nil do - begin - nextpage := page^.Next; + GetCodeMem(Q, SizeOf(S1)); + P := Q; + Move(S1, P^, SizeOf(S1)); - // free the memory - {$IFDEF MSWINDOWS} - VirtualFree(page, 0, MEM_RELEASE); - {$ELSE} - //FreeMem(page); - munmap(page,PageSize); - {$ENDIF} + LLiteralPool := TArray.Create(Self, Method); - page := nextpage; + Inc(P, Length(S1) - (Length(LLiteralPool) * SizeOf(pointer))); + for I := Low(LLiteralPool) to High(LLiteralPool) do begin + Move(LLiteralPool[I], P^, SizeOf(pointer)); + Inc(P, SizeOf(pointer)); end; - CodeMemPages := nil; + + {$IF DEFINED(OSX) AND DEFINED(CPUARM64)} + { + macOS for M1 has a bug (Apple Feedback FB8994773) in which mprotect + rejects a permission change from NONE -> RWX. + Solution: give RW permission, make memory changes, then change RW to X + } + //X permission to the entire page for executions... + if mprotect(CodeMemPages, PageSize, PROT_EXEC) <> 0 then + raise EMProtectError.CreateFmt('MProtect error: %s', [ + SysErrorMessage({$IFDEF FPC}GetLastOSError{$ELSE}GetLastError{$ENDIF}())]); + {$IFEND} + + Result := Pointer(Q); //set arm mode end; +{$ENDIF CPUARM64} initialization + finalization FreeCallBacks; + end. diff --git a/python4lazarus/PythonEngine.pas b/python4lazarus/PythonEngine.pas index 5325230..7d7141e 100644 --- a/python4lazarus/PythonEngine.pas +++ b/python4lazarus/PythonEngine.pas @@ -64,10 +64,6 @@ {$define _so_files} {$ENDIF} -{$ifdef UNIX} -{$define POSIX} // to be compatible with Python4Delphi -{$endif} - interface uses @@ -111,42 +107,43 @@ interface const {$ifdef windows} - PYTHON_KNOWN_VERSIONS: array[1..8] of TPythonVersionProp = + PYTHON_KNOWN_VERSIONS: array[1..10] of TPythonVersionProp = ( - (DllName: 'python33.dll'; RegVersion: '3.3'; APIVersion: 1013), (DllName: 'python34.dll'; RegVersion: '3.4'; APIVersion: 1013), (DllName: 'python35.dll'; RegVersion: '3.5'; APIVersion: 1013), (DllName: 'python36.dll'; RegVersion: '3.6'; APIVersion: 1013), (DllName: 'python37.dll'; RegVersion: '3.7'; APIVersion: 1013), (DllName: 'python38.dll'; RegVersion: '3.8'; APIVersion: 1013), (DllName: 'python39.dll'; RegVersion: '3.9'; APIVersion: 1013), - (DllName: 'python310.dll'; RegVersion: '3.10'; APIVersion: 1013) + (DllName: 'python310.dll'; RegVersion: '3.10'; APIVersion: 1013), + (DllName: 'python311.dll'; RegVersion: '3.11'; APIVersion: 1013), + (DllName: 'python312.dll'; RegVersion: '3.12'; APIVersion: 1013), + (DllName: 'python313.dll'; RegVersion: '3.13'; APIVersion: 1013) ); {$endif} {$ifdef _so_files} - PYTHON_KNOWN_VERSIONS: array[1..8] of TPythonVersionProp = + PYTHON_KNOWN_VERSIONS: array[1..9] of TPythonVersionProp = ( - (DllName: 'libpython3.3m.so'; RegVersion: '3.3'; APIVersion: 1013), - (DllName: 'libpython3.4m.so'; RegVersion: '3.4'; APIVersion: 1013), (DllName: 'libpython3.5m.so'; RegVersion: '3.5'; APIVersion: 1013), (DllName: 'libpython3.6m.so'; RegVersion: '3.6'; APIVersion: 1013), (DllName: 'libpython3.7m.so'; RegVersion: '3.7'; APIVersion: 1013), (DllName: 'libpython3.8.so'; RegVersion: '3.8'; APIVersion: 1013), (DllName: 'libpython3.9.so'; RegVersion: '3.9'; APIVersion: 1013), - (DllName: 'libpython3.10.so'; RegVersion: '3.10'; APIVersion: 1013) + (DllName: 'libpython3.10.so'; RegVersion: '3.10'; APIVersion: 1013), + (DllName: 'libpython3.11.so'; RegVersion: '3.11'; APIVersion: 1013), + (DllName: 'libpython3.12.so'; RegVersion: '3.12'; APIVersion: 1013), + (DllName: 'libpython3.13.so'; RegVersion: '3.13'; APIVersion: 1013) ); {$endif} {$ifdef darwin} - PYTHON_KNOWN_VERSIONS: array[1..8] of TPythonVersionProp = + PYTHON_KNOWN_VERSIONS: array[1..6] of TPythonVersionProp = ( - (DllName: 'libpython3.3.dylib'; RegVersion: '3.3'; APIVersion: 1013), - (DllName: 'libpython3.4.dylib'; RegVersion: '3.4'; APIVersion: 1013), - (DllName: 'libpython3.5.dylib'; RegVersion: '3.5'; APIVersion: 1013), - (DllName: 'libpython3.6.dylib'; RegVersion: '3.6'; APIVersion: 1013), - (DllName: 'libpython3.7.dylib'; RegVersion: '3.7'; APIVersion: 1013), (DllName: 'libpython3.8.dylib'; RegVersion: '3.8'; APIVersion: 1013), (DllName: 'libpython3.9.dylib'; RegVersion: '3.9'; APIVersion: 1013), - (DllName: 'libpython3.10.dylib'; RegVersion: '3.10'; APIVersion: 1013) + (DllName: 'libpython3.10.dylib'; RegVersion: '3.10'; APIVersion: 1013), + (DllName: 'libpython3.11.dylib'; RegVersion: '3.11'; APIVersion: 1013), + (DllName: 'libpython3.12.dylib'; RegVersion: '3.12'; APIVersion: 1013), + (DllName: 'libpython3.13.dylib'; RegVersion: '3.13'; APIVersion: 1013) ); {$endif} @@ -158,6 +155,8 @@ interface METH_VARARGS = $0001; METH_KEYWORDS = $0002; + METH_CLASS = $0010; + METH_STATIC = $0020; // Masks for the co_flags field of PyCodeObject CO_OPTIMIZED = $0001; @@ -172,6 +171,13 @@ interface Py_NE = 3; Py_GT = 4; Py_GE = 5; + + {$IFDEF CPUARM} + DEFAULT_CALLBACK_TYPE: TCallType = TCallType.ctARMSTD; + {$ELSE} + DEFAULT_CALLBACK_TYPE: TCallType = TCallType.ctCDECL; + {$ENDIF CPUARM} + type // Delphi equivalent used by TPyObject TRichComparisonOpcode = (pyLT, pyLE, pyEQ, pyNE, pyGT, pyGE); @@ -749,6 +755,9 @@ interface cf_feature_version : integer; //added in Python 3.8 end; + const + PyCF_ONLY_AST = $0400; + // from datetime.h @@ -1048,6 +1057,8 @@ EPySyntaxError = class (EPyStandardError) ELineStr: UnicodeString; ELineNumber: Integer; EOffset: Integer; + EEndLineNumber: Integer; + EEndOffset: Integer; end; EPyIndentationError = class (EPySyntaxError); EPyTabError = class (EPyIndentationError); @@ -1248,7 +1259,6 @@ TPythonInterface=class(TDynamicDll) procedure AfterLoad; override; function GetQuitMessage : String; override; procedure CheckPython; - function GetUnicodeTypeSuffix : String; public // define Python flags. See file pyDebug.h @@ -1466,6 +1476,8 @@ TPythonInterface=class(TDynamicDll) PyMapping_HasKeyString:function (ob:PPyObject;key:PAnsiChar):integer; cdecl; PyMapping_Length:function (ob:PPyObject):NativeInt; cdecl; PyMapping_SetItemString:function (ob:PPyObject; key:PAnsiChar; value:PPyObject):integer; cdecl; + PyMapping_Keys:function(mp: PPyObject):PPyObject; cdecl; + PyMapping_Values:function(mp: PPyObject):PPyObject; cdecl; PyMethod_Function:function (ob:PPyObject):PPyObject; cdecl; PyMethod_New:function (ob1,ob2,ob3:PPyObject):PPyObject; cdecl; PyMethod_Self:function (ob:PPyObject):PPyObject; cdecl; @@ -1500,6 +1512,7 @@ TPythonInterface=class(TDynamicDll) PyObject_GetAttrString:function (ob:PPyObject;c:PAnsiChar):PPyObject; cdecl; PyObject_GetItem:function (ob,key:PPyObject):PPyObject; cdecl; PyObject_DelItem:function (ob,key:PPyObject):PPyObject; cdecl; + PyObject_HasAttr:function (ob, attr_name:PPyObject):integer; cdecl; PyObject_HasAttrString:function (ob:PPyObject;key:PAnsiChar):integer; cdecl; PyObject_Hash:function (ob:PPyObject):NativeInt; cdecl; PyObject_IsTrue:function (ob:PPyObject):integer; cdecl; @@ -1520,7 +1533,7 @@ TPythonInterface=class(TDynamicDll) PyObject_Call:function (ob, args, kw:PPyObject):PPyObject; cdecl; PyObject_GenericGetAttr:function (obj, name : PPyObject) : PPyObject; cdecl; PyObject_GenericSetAttr:function (obj, name, value : PPyObject) : Integer; cdecl; - PyObject_GC_Malloc:function (size:NativeUInt):PPyObject; cdecl; + PyObject_Malloc:function (size:NativeUInt):PPyObject; cdecl; PyObject_GC_New:function (t:PPyTypeObject):PPyObject; cdecl; PyObject_GC_NewVar:function (t:PPyTypeObject; size:NativeInt):PPyObject; cdecl; PyObject_GC_Resize:function (t:PPyObject; newsize:NativeInt):PPyObject; cdecl; @@ -1578,7 +1591,7 @@ TPythonInterface=class(TDynamicDll) PyUnicode_DecodeUTF16:function (const s:PAnsiChar; size: NativeInt; const errors: PAnsiChar; byteoder: PInteger):PPyObject; cdecl; PyUnicode_AsEncodedString:function (unicode:PPyObject; const encoding:PAnsiChar; const errors:PAnsiChar):PPyObject; cdecl; PyUnicode_FromOrdinal:function (ordinal:integer):PPyObject; cdecl; - PyUnicode_GetSize:function (unicode:PPyObject):NativeInt; cdecl; + PyUnicode_GetLength:function (unicode:PPyObject):NativeInt; cdecl; PyWeakref_GetObject: function ( ref : PPyObject) : PPyObject; cdecl; PyWeakref_NewProxy: function ( ob, callback : PPyObject) : PPyObject; cdecl; PyWeakref_NewRef: function ( ob, callback : PPyObject) : PPyObject; cdecl; @@ -1786,8 +1799,9 @@ TPythonEngine = class(TPythonInterface) FClients: TList; FExecModule: AnsiString; FAutoFinalize: Boolean; - FProgramName: UnicodeString; - FPythonHome: UnicodeString; + FProgramName: WCharTString; + FPythonHome: WCharTString; + FPythonPath: WCharTString; FInitThreads: Boolean; FOnPathInitialization: TPathInitializationEvent; FOnSysPathInit: TSysPathInitEvent; @@ -1807,6 +1821,10 @@ TPythonEngine = class(TPythonInterface) FPyDateTime_TZInfoType: PPyObject; FPyDateTime_TimeTZType: PPyObject; FPyDateTime_DateTimeTZType: PPyObject; + function GetPythonHome: UnicodeString; + function GetProgramName: UnicodeString; + function GetPythonPath: UnicodeString; + procedure SetPythonPath(const Value: UnicodeString); protected procedure Initialize; @@ -1839,19 +1857,26 @@ TPythonEngine = class(TPythonInterface) procedure SetPythonHome(const PythonHome: UnicodeString); procedure SetProgramName(const ProgramName: UnicodeString); function IsType(ob: PPyObject; obt: PPyTypeObject): Boolean; - function Run_CommandAsString(const command : AnsiString; mode : Integer) : String; - function Run_CommandAsObject(const command : AnsiString; mode : Integer) : PPyObject; inline; - function Run_CommandAsObjectWithDict(const command : AnsiString; mode : Integer; locals, globals : PPyObject) : PPyObject; - procedure ExecString(const command : AnsiString); overload; inline; - procedure ExecStrings( strings : TStrings ); overload; - function EvalString(const command : AnsiString) : PPyObject; overload; inline; - function EvalStringAsStr(const command : AnsiString) : String; inline; - function EvalStrings( strings : TStrings ) : PPyObject; overload; - procedure ExecString(const command : AnsiString; locals, globals : PPyObject ); overload; inline; - procedure ExecStrings( strings : TStrings; locals, globals : PPyObject ); overload; - function EvalString( const command : AnsiString; locals, globals : PPyObject ) : PPyObject; overload; inline; - function EvalStrings( strings : TStrings; locals, globals : PPyObject ) : PPyObject; overload; - function EvalStringsAsStr( strings : TStrings ) : String; + function Run_CommandAsString(const command: AnsiString; mode: Integer; const FileName: string = ''): string; + function Run_CommandAsObject(const command: AnsiString; mode: Integer; const FileName: string = ''): PPyObject; + function Run_CommandAsObjectWithDict(const command: AnsiString; mode: Integer; locals, globals: PPyObject; const FileName: string = ''): PPyObject; + function EncodeString (const str: UnicodeString): AnsiString; {$IFDEF FPC}overload;{$ENDIF} + {$IFDEF FPC} + overload; + function EncodeString (const str: AnsiString): AnsiString; overload; + {$ENDIF} + function EncodeWindowsFilePath(const str: string): AnsiString; + procedure ExecString(const command: AnsiString; const FileName: string = ''); overload; + procedure ExecStrings(strings: TStrings; const FileName: string = ''); overload; + procedure ExecString(const command: AnsiString; locals, globals: PPyObject; const FileName: string = ''); overload; + procedure ExecFile(const FileName: string; locals: PPyObject = nil; globals: PPyObject = nil); overload; + procedure ExecStrings(strings: TStrings; locals, globals: PPyObject; const FileName: string = ''); overload; + function EvalString(const command: AnsiString; const FileName: string = ''): PPyObject; overload; + function EvalStringAsStr(const command: AnsiString; const FileName: string = ''): string; + function EvalStrings(strings: TStrings; const FileName: string = ''): PPyObject; overload; + function EvalString(const command: AnsiString; locals, globals: PPyObject; const FileName: string = ''): PPyObject; overload; + function EvalStrings(strings: TStrings; locals, globals: PPyObject; const FileName: string = ''): PPyObject; overload; + function EvalStringsAsStr(strings: TStrings; const FileName: string = ''): string; function EvalPyFunction(pyfunc, pyargs:PPyObject): Variant; function EvalFunction(pyfunc:PPyObject; args: array of const): Variant; function EvalFunctionNoArgs(pyfunc:PPyObject): Variant; @@ -1878,7 +1903,7 @@ TPythonEngine = class(TPythonInterface) function ArrayToPyDict( items : array of const) : PPyObject; function StringsToPyList( strings : TStrings ) : PPyObject; function StringsToPyTuple( strings : TStrings ) : PPyObject; - procedure PyListToStrings( list : PPyObject; strings : TStrings ); + procedure PyListToStrings(list: PPyObject; Strings: TStrings; ClearStrings: Boolean = True); procedure PyTupleToStrings( tuple: PPyObject; strings : TStrings ); function ReturnNone : PPyObject; function ReturnTrue : PPyObject; @@ -1919,8 +1944,9 @@ TPythonEngine = class(TPythonInterface) property LocalVars : PPyObject read FLocalVars Write SetLocalVars; property GlobalVars : PPyObject read FGlobalVars Write SetGlobalVars; property IOPythonModule: TObject read FIOPythonModule; {TPythonModule} - property PythonHome: UnicodeString read FPythonHome write SetPythonHome; - property ProgramName: UnicodeString read FProgramName write SetProgramName; + property PythonHome: UnicodeString read GetPythonHome write SetPythonHome; + property ProgramName: UnicodeString read GetProgramName write SetProgramName; + property PythonPath: UnicodeString read GetPythonPath write SetPythonPath; published property AutoFinalize: Boolean read FAutoFinalize write FAutoFinalize default True; property VenvPythonExe: string read FVenvPythonExe write FVenvPythonExe; @@ -1954,8 +1980,6 @@ TEngineClient = class(TComponent) procedure SetEngine( val : TPythonEngine ); virtual; procedure Loaded; override; - procedure Notification( AComponent: TComponent; - Operation: TOperation); override; procedure ModuleReady(Sender : TObject); virtual; public // Constructors & destructors @@ -2068,6 +2092,12 @@ TMethodsContainer = class(TEngineClient) function AddMethodWithKeywords( AMethodName : PAnsiChar; AMethod : PyCFunctionWithKW; ADocString : PAnsiChar ) : PPyMethodDef; + function AddClassMethodWithKeywords( AMethodName : PAnsiChar; + AMethod : PyCFunctionWithKW; + ADocString : PAnsiChar ) : PPyMethodDef; + function AddStaticMethodWithKeywords( AMethodName : PAnsiChar; + AMethod : PyCFunctionWithKW; + ADocString : PAnsiChar ) : PPyMethodDef; function AddDelphiMethod( AMethodName : PAnsiChar; ADelphiMethod: TDelphiMethod; ADocString : PAnsiChar ) : PPyMethodDef; @@ -2269,7 +2299,8 @@ TPythonModule = class(TMethodsContainer) procedure DefineDocString; procedure Initialize; override; procedure InitializeForNewInterpreter; - procedure AddClient( client : TEngineClient ); + procedure AddClient(Client : TEngineClient); + procedure RemoveClient(Client : TEngineClient); function ErrorByName( const AName : AnsiString ) : TError; procedure RaiseError( const error, msg : AnsiString ); procedure RaiseErrorFmt( const error, format : AnsiString; Args : array of const ); @@ -2341,7 +2372,7 @@ TPyObject = class // Constructors & Destructors constructor Create( APythonType : TPythonType ); virtual; - constructor CreateWith( APythonType : TPythonType; args : PPyObject ); virtual; + constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); virtual; destructor Destroy; override; class function NewInstance: TObject; override; @@ -2529,7 +2560,8 @@ TPythonType = class(TGetSetContainer) procedure SetModule( val : TPythonModule ); procedure SetServices( val : TTypeServices ); procedure SetTypeName( const val : AnsiString ); - function CreateMethod( pSelf, args : PPyObject ) : PPyObject; cdecl; + procedure SetBaseType(AType: TPythonType); + function CreateMethod(pSelf, args, kwds: PPyObject): PPyObject; cdecl; procedure InitServices; procedure SetDocString( value : TStringList ); function TypeFlagsAsInt : C_ULong; @@ -2553,12 +2585,13 @@ TPythonType = class(TGetSetContainer) procedure Initialize; override; procedure Finalize; override; function CreateInstance : PPyObject; - function CreateInstanceWith( args : PPyObject ) : PPyObject; + function CreateInstanceWith(args, kwds: PPyObject): PPyObject; procedure AddTypeVar; property TheType : PyTypeObject read FType write FType; property TheTypePtr : PPyTypeObject read GetTypePtr; property PyObjectClass : TPyObjectClass read FPyObjectClass write SetPyObjectClass stored False; + property BaseType: TPythonType write SetBaseType; property InstanceCount : Integer read FInstanceCount; property CreateHits : Integer read FCreateHits; property DeleteHits : Integer read FDeleteHits; @@ -2641,7 +2674,7 @@ TPyVar = class(TPyObject) // Constructors & Destructors constructor Create( APythonType : TPythonType ); override; - constructor CreateWith( APythonType : TPythonType; args : PPyObject ); override; + constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override; destructor Destroy; override; // Type services @@ -2974,7 +3007,8 @@ procedure TDynamicDll.DoOpenDll(const aDllName : String); FDLLHandle := Windows.LoadLibrary(PChar(S)); {$else} //Linux: need here RTLD_GLOBAL, so Python can do "import ctypes" - FDLLHandle := PtrInt(dlopen(PAnsiChar(S), RTLD_LAZY+RTLD_GLOBAL)); + //Haiku: without RTLD_NOW it doesn't seem to detect the library or plugins without running with "LD_PRELOAD ..." + FDLLHandle := PtrInt(dlopen(PAnsiChar(S), {$ifdef haiku}RTLD_NOW{$else}RTLD_LAZY{$endif}+RTLD_GLOBAL)); {$endif} end; end; @@ -3201,30 +3235,8 @@ procedure TPythonInterface.CheckPython; raise Exception.Create('Python is not properly initialized' ); end; -// https://github.com/Alexey-T/Python-for-Lazarus/issues/16 -function TPythonInterface.GetUnicodeTypeSuffix : String; -begin - if (fMajorVersion > 3) or ((fMajorVersion = 3) and (fMinorVersion >= 3)) then - Result := '' - else - if APIVersion >= 1011 then - Result := - {$if defined(windows) or defined(darwin) or defined(solaris)} - 'UCS2' - {$else} - 'UCS4' - {$endif} - else - Result := ''; -end; - procedure TPythonInterface.MapDll; -Var - UnicodeSuffix : string; - begin - UnicodeSuffix := GetUnicodeTypeSuffix; - Py_DebugFlag := Import('Py_DebugFlag'); Py_VerboseFlag := Import('Py_VerboseFlag'); Py_InteractiveFlag := Import('Py_InteractiveFlag'); @@ -3428,6 +3440,8 @@ procedure TPythonInterface.MapDll; PyMapping_HasKeyString := Import('PyMapping_HasKeyString'); PyMapping_Length := Import('PyMapping_Length'); PyMapping_SetItemString := Import('PyMapping_SetItemString'); + PyMapping_Keys := Import('PyMapping_Keys'); + PyMapping_Values := Import('PyMapping_Values'); PyMethod_Function := Import('PyMethod_Function'); PyMethod_New := Import('PyMethod_New'); PyMethod_Self := Import('PyMethod_Self'); @@ -3462,6 +3476,7 @@ procedure TPythonInterface.MapDll; PyObject_GetAttrString := Import('PyObject_GetAttrString'); PyObject_GetItem := Import('PyObject_GetItem'); PyObject_DelItem := Import('PyObject_DelItem'); + PyObject_HasAttr := Import('PyObject_HasAttr'); PyObject_HasAttrString := Import('PyObject_HasAttrString'); PyObject_Hash := Import('PyObject_Hash'); PyObject_IsTrue := Import('PyObject_IsTrue'); @@ -3482,7 +3497,7 @@ procedure TPythonInterface.MapDll; PyObject_Call := Import('PyObject_Call'); PyObject_GenericGetAttr := Import('PyObject_GenericGetAttr'); PyObject_GenericSetAttr := Import('PyObject_GenericSetAttr'); - PyObject_GC_Malloc := Import('_PyObject_GC_Malloc'); + PyObject_Malloc := Import('PyObject_Malloc'); PyObject_GC_New := Import('_PyObject_GC_New'); PyObject_GC_NewVar := Import('_PyObject_GC_NewVar'); PyObject_GC_Resize := Import('_PyObject_GC_Resize'); @@ -3532,18 +3547,18 @@ procedure TPythonInterface.MapDll; PyType_GenericAlloc := Import('PyType_GenericAlloc'); PyType_GenericNew := Import('PyType_GenericNew'); PyType_Ready := Import('PyType_Ready'); - PyUnicode_FromWideChar := Import(AnsiString(Format('PyUnicode%s_FromWideChar',[UnicodeSuffix]))); - PyUnicode_FromString := Import(AnsiString(Format('PyUnicode%s_FromString',[UnicodeSuffix]))); - PyUnicode_FromStringAndSize := Import(AnsiString(Format('PyUnicode%s_FromStringAndSize',[UnicodeSuffix]))); - PyUnicode_FromKindAndData := Import(AnsiString(Format('PyUnicode%s_FromKindAndData',[UnicodeSuffix]))); - PyUnicode_AsWideChar := Import(AnsiString(Format('PyUnicode%s_AsWideChar',[UnicodeSuffix]))); - PyUnicode_AsUTF8 := Import(AnsiString(Format('PyUnicode%s_AsUTF8',[UnicodeSuffix]))); - PyUnicode_AsUTF8AndSize := Import(AnsiString(Format('PyUnicode%s_AsUTF8AndSize',[UnicodeSuffix]))); - PyUnicode_Decode := Import(AnsiString(Format('PyUnicode%s_Decode',[UnicodeSuffix]))); - PyUnicode_DecodeUTF16 := Import(AnsiString(Format('PyUnicode%s_DecodeUTF16',[UnicodeSuffix]))); - PyUnicode_AsEncodedString := Import(AnsiString(Format('PyUnicode%s_AsEncodedString',[UnicodeSuffix]))); - PyUnicode_FromOrdinal := Import(AnsiString(Format('PyUnicode%s_FromOrdinal',[UnicodeSuffix]))); - PyUnicode_GetSize := Import(AnsiString(Format('PyUnicode%s_GetSize',[UnicodeSuffix]))); + PyUnicode_FromWideChar := Import('PyUnicode_FromWideChar'); + PyUnicode_FromString := Import('PyUnicode_FromString'); + PyUnicode_FromStringAndSize := Import('PyUnicode_FromStringAndSize'); + PyUnicode_FromKindAndData := Import('PyUnicode_FromKindAndData'); + PyUnicode_AsWideChar := Import('PyUnicode_AsWideChar'); + PyUnicode_AsUTF8 := Import('PyUnicode_AsUTF8'); + PyUnicode_AsUTF8AndSize := Import('PyUnicode_AsUTF8AndSize'); + PyUnicode_Decode := Import('PyUnicode_Decode'); + PyUnicode_DecodeUTF16 := Import('PyUnicode_DecodeUTF16'); + PyUnicode_AsEncodedString := Import('PyUnicode_AsEncodedString'); + PyUnicode_FromOrdinal := Import('PyUnicode_FromOrdinal'); + PyUnicode_GetLength := Import('PyUnicode_GetLength'); PyWeakref_GetObject := Import('PyWeakref_GetObject'); PyWeakref_NewProxy := Import('PyWeakref_NewProxy'); PyWeakref_NewRef := Import('PyWeakref_NewRef'); @@ -4011,21 +4026,29 @@ constructor TPythonEngine.Create(AOwner: TComponent); end; destructor TPythonEngine.Destroy; +var + I: Integer; begin LocalVars := nil; GlobalVars := nil; Destroying; Finalize; + for I := 0 to ClientCount - 1 do + Clients[I].ClearEngine; +{$IFDEF FPC} // See https://github.com/Alexey-T/Python-for-Lazarus/issues/29 + inherited; +{$ENDIF} FClients.Free; FInitScript.Free; FTraceback.Free; +{$IFNDEF FPC} inherited; +{$ENDIF} end; procedure TPythonEngine.Finalize; var i: integer; - canDetachClients : Boolean; begin // switch off redirection when the component is destroying, // because the form or datamodule is beeing closed, and @@ -4060,21 +4083,6 @@ procedure TPythonEngine.Finalize; except end; end; - // Detach our clients, when engine is being destroyed or one of its clients. - canDetachClients := csDestroying in ComponentState; - if not canDetachClients then - for i := 0 to ClientCount - 1 do - if csDestroying in Clients[i].ComponentState then - begin - canDetachClients := True; - Break; - end; - if canDetachClients then - begin - for i := 0 to ClientCount - 1 do - Clients[i].ClearEngine; - FClients.Clear; - end; // Free our reference gPythonEngine := nil; FTimeStruct := nil; @@ -4102,7 +4110,6 @@ procedure TPythonEngine.BeforeLoad; procedure TPythonEngine.DoOpenDll(const aDllName : String); var - NMajor, NMinor: Integer; i: Integer; begin if UseLastKnownVersion then @@ -4118,8 +4125,10 @@ procedure TPythonEngine.DoOpenDll(const aDllName : String); end; end else + begin RegVersion := SysVersionFromDLLName(aDllName); - inherited; + inherited; + end; end; procedure TPythonEngine.AssignPyFlags; @@ -4285,24 +4294,10 @@ function TPythonEngine.GetClients( idx : Integer ) : TEngineClient; procedure TPythonEngine.Notification( AComponent: TComponent; Operation: TOperation); -var - i : Integer; begin inherited; - if Operation = opRemove then - begin - if AComponent = IO then - IO := nil - else - begin - for i := 0 to ClientCount - 1 do - if Clients[i] = AComponent then - begin - RemoveClient( Clients[i] ); - Break; - end; - end; - end; + if (Operation = opRemove) and (AComponent = IO) then + IO := nil end; procedure TPythonEngine.CheckRegistry; @@ -4445,14 +4440,66 @@ procedure TPythonEngine.SetPyFlags(const Value: TPythonFlags); end; // of if end; +function TPythonEngine.GetPythonHome: UnicodeString; +begin +{$IFDEF POSIX} + if Length(FPythonHome) = 0 then + Result := '' + else + Result := UCS4StringToUnicodeString(FPythonHome); +{$ELSE} + Result := FPythonHome; +{$ENDIF} +end; + +function TPythonEngine.GetPythonPath: UnicodeString; +begin +{$IFDEF POSIX} + if (Length(FPythonPath) > 0) then + Result := UCS4StringToUnicodeString(FPythonPath) + else + Result := ''; +{$ELSE} + Result := FPythonPath; +{$ENDIF} +end; + +function TPythonEngine.GetProgramName: UnicodeString; +begin +{$IFDEF POSIX} + if Length(FProgramName) = 0 then + Result := '' + else + Result := UCS4StringToUnicodeString(FProgramName); +{$ELSE} + Result := FProgramName; +{$ENDIF} +end; procedure TPythonEngine.SetPythonHome(const PythonHome: UnicodeString); begin - FPythonHome := PythonHome; +{$IFDEF POSIX} + FPythonHome := UnicodeStringToUCS4String(PythonHome); +{$ELSE} + FPythonHome := PythonHome; +{$ENDIF} +end; + +procedure TPythonEngine.SetPythonPath(const Value: UnicodeString); +begin +{$IFDEF POSIX} + FPythonPath := UnicodeStringToUCS4String(Value); +{$ELSE} + FPythonPath := Value; +{$ENDIF} end; procedure TPythonEngine.SetProgramName(const ProgramName: UnicodeString); begin +{$IFDEF POSIX} + FProgramName := UnicodeStringToUCS4String(ProgramName); +{$ELSE} FProgramName := ProgramName; +{$ENDIF} end; function TPythonEngine.IsType(ob: PPyObject; obt: PPyTypeObject): Boolean; @@ -4517,40 +4564,55 @@ function TPythonEngine.EvalFunctionNoArgs(pyfunc:PPyObject): Variant; end; end; -function TPythonEngine.EvalStringAsStr(const command : AnsiString) : String; +function TPythonEngine.EvalStringAsStr(const command: AnsiString; const + FileName: string = ''): string; begin - Result := Run_CommandAsString( command, eval_input ); + Result := Run_CommandAsString(command, eval_input, FileName); end; -function TPythonEngine.EvalString(const command : AnsiString) : PPyObject; +function TPythonEngine.EvalString(const command: AnsiString; const FileName: + string = ''): PPyObject; begin - Result := Run_CommandAsObject( command, eval_input ); + Result := Run_CommandAsObject(command, eval_input, FileName); end; -procedure TPythonEngine.ExecString(const command : AnsiString); +procedure TPythonEngine.ExecString(const command: AnsiString; const FileName: + string = ''); begin - Py_XDecRef( Run_CommandAsObject( command, file_input ) ); + Py_XDecRef(Run_CommandAsObject(command, file_input, FileName)); end; -function TPythonEngine.Run_CommandAsString(const command : AnsiString; mode : Integer) : String; +function TPythonEngine.Run_CommandAsString(const command: AnsiString; mode: + Integer; const FileName: string = ''): string; var - v : PPyObject; + PRes : PPyObject; begin Result := ''; - v := Run_CommandAsObject( command, mode ); - Result := PyObjectAsString( v ); - Py_XDECREF(v); + PRes := Run_CommandAsObject(command, mode, FileName); + Result := PyObjectAsString(PRes); + Py_XDECREF(PRes); end; -function TPythonEngine.Run_CommandAsObject(const command : AnsiString; mode : Integer) : PPyObject; +function TPythonEngine.Run_CommandAsObject(const command: AnsiString; mode: + Integer; const FileName: string = ''): PPyObject; begin - Result := Run_CommandAsObjectWithDict(command, mode, nil, nil); + Result := Run_CommandAsObjectWithDict(command, mode, nil, nil, FileName); end; -function TPythonEngine.Run_CommandAsObjectWithDict(const command : AnsiString; mode : Integer; locals, globals : PPyObject) : PPyObject; +function TPythonEngine.Run_CommandAsObjectWithDict(const command: AnsiString; + mode: Integer; locals, globals: PPyObject; const FileName: string = + ''): PPyObject; +{ + This is the core function for executing/evaluating python code + Parameters: + - command: utf-8 encoded AnsiString with the code that will be executed or evaluated + - mode: one of the constants file_input, single_input, eval_input + - locals, globals: python dictionaries with local/global namespaces. Can be nil. + - FileName; optional string used when debugging code with external debuggers +} var m : PPyObject; - _locals, _globals : PPyObject; + _locals, _globals, Code : PPyObject; begin CheckPython; Result := nil; @@ -4576,7 +4638,11 @@ function TPythonEngine.Run_CommandAsObjectWithDict(const command : AnsiString; m _globals := _locals; try - Result := PyRun_String(PAnsiChar(CleanString(command)), mode, _globals, _locals); + Code := Py_CompileString(PAnsiChar(CleanString(command)), + PAnsiChar(EncodeString(FileName)), mode); + if Code = nil then + CheckError(False); + Result := PyEval_EvalCode(Code, _globals, _locals ); if Result = nil then CheckError(False); except @@ -4587,40 +4653,62 @@ function TPythonEngine.Run_CommandAsObjectWithDict(const command : AnsiString; m end; end; +procedure TPythonEngine.ExecStrings(strings: TStrings; const FileName: string = + ''); +begin + Py_XDecRef(Run_CommandAsObject(EncodeString(strings.Text), file_input, FileName)); +end; -procedure TPythonEngine.ExecStrings( strings : TStrings ); +function TPythonEngine.EvalStrings(strings: TStrings; const FileName: string = + ''): PPyObject; begin - Py_XDecRef( Run_CommandAsObject( strings.Text, file_input ) ); + Result := Run_CommandAsObject(EncodeString(strings.Text) , eval_input, FileName); end; -function TPythonEngine.EvalStrings( strings : TStrings ) : PPyObject; +procedure TPythonEngine.ExecFile(const FileName: string; locals, + globals: PPyObject); +var + SL: TStringList; begin - Result := Run_CommandAsObject( strings.Text, eval_input ); + SL := TStringList.Create; + try + SL.LoadFromFile(FileName, TEncoding.UTF8); + ExecStrings(SL, locals, globals, FileName); + finally + SL.Free; + end; end; -procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals : PPyObject ); +procedure TPythonEngine.ExecString(const command: AnsiString; locals, globals: + PPyObject; const FileName: string = ''); begin - Py_XDecRef( Run_CommandAsObjectWithDict( command, file_input, locals, globals ) ); + Py_XDecRef(Run_CommandAsObjectWithDict(command, file_input, locals, globals, FileName)); end; -procedure TPythonEngine.ExecStrings( strings : TStrings; locals, globals : PPyObject ); +procedure TPythonEngine.ExecStrings(strings: TStrings; locals, globals: + PPyObject; const FileName: string = ''); begin - Py_XDecRef( Run_CommandAsObjectWithDict( strings.Text, file_input, locals, globals ) ); + Py_XDecRef( Run_CommandAsObjectWithDict(EncodeString(strings.Text), + file_input, locals, globals, FileName)); end; -function TPythonEngine.EvalString( const command : AnsiString; locals, globals : PPyObject ) : PPyObject; +function TPythonEngine.EvalString(const command: AnsiString; locals, globals: + PPyObject; const FileName: string = ''): PPyObject; begin - Result := Run_CommandAsObjectWithDict( command, eval_input, locals, globals ); + Result := Run_CommandAsObjectWithDict(command, eval_input, locals, globals, FileName); end; -function TPythonEngine.EvalStrings( strings : TStrings; locals, globals : PPyObject ) : PPyObject; +function TPythonEngine.EvalStrings(strings: TStrings; locals, globals: + PPyObject; const FileName: string = ''): PPyObject; begin - Result := Run_CommandAsObjectWithDict( strings.Text, eval_input, locals, globals ); + Result := Run_CommandAsObjectWithDict(EncodeString(strings.Text), + eval_input, locals, globals, FileName); end; -function TPythonEngine.EvalStringsAsStr( strings : TStrings ) : String; +function TPythonEngine.EvalStringsAsStr(strings: TStrings; const FileName: + string = ''): string; begin - Result := Run_CommandAsString( strings.Text, eval_input ); + Result := Run_CommandAsString(EncodeString(strings.Text), eval_input, FileName); end; function TPythonEngine.CheckEvalSyntax( const str : AnsiString ) : Boolean; @@ -4658,12 +4746,14 @@ procedure TPythonEngine.RaiseError; function DefineSyntaxError( E : EPySyntaxError; const sType, sValue : UnicodeString; err_type, err_value : PPyObject ) : EPySyntaxError; var - s_value : UnicodeString; - s_line : UnicodeString; - s_filename : UnicodeString; - i_line_number : Integer; - i_offset : Integer; - tmp : PPyObject; + s_value : UnicodeString; + s_line : UnicodeString; + s_filename : UnicodeString; + i_line_number : Integer; + i_offset : Integer; + i_end_line_number : Integer; + i_end_offset : Integer; + tmp : PPyObject; begin Result := E; Result.EName := sType; @@ -4673,8 +4763,10 @@ procedure TPythonEngine.RaiseError; s_filename := ''; i_line_number := 0; i_offset := 0; + i_end_line_number := 0; + i_end_offset := 0; // Sometimes there's a tuple instead of instance... - if PyTuple_Check( err_value ) and (PyTuple_Size( err_value) >= 2) then + if PyTuple_Check(err_value) and (PyTuple_Size( err_value) >= 2) then begin s_value := PyObjectAsString(PyTuple_GetItem( err_value, 0)); err_value := PyTuple_GetItem( err_value, 1); @@ -4719,19 +4811,34 @@ procedure TPythonEngine.RaiseError; if Assigned(tmp) and PyUnicode_Check(tmp) then s_value := PyUnicodeAsString(tmp); Py_XDECREF(tmp); + if (MajorVersion > 3) or (MinorVersion >= 10) then + begin + // Get the end offset of the error + tmp := PyObject_GetAttrString(err_value, 'end_offset' ); + if Assigned(tmp) and PyLong_Check(tmp) then + i_end_offset := PyLong_AsLong(tmp); + Py_XDECREF(tmp); + // Get the end line number of the error + tmp := PyObject_GetAttrString(err_value, 'end_lineno' ); + if Assigned(tmp) and PyLong_Check(tmp) then + i_end_line_number := PyLong_AsLong(tmp); + Py_XDECREF(tmp); + end; end; // If all is ok if s_value <> '' then begin with Result do begin - Message := Format('%s: %s (line %d, offset %d): ''%s''', [sType,s_value,i_line_number, i_offset,s_line]); - EName := sType; - EValue := s_value; - EFileName := s_filename; - ELineNumber := i_line_number; - EOffset := i_offset; - ELineStr := s_line; + Message := Format('%s: %s (line %d, offset %d): ''%s''', [sType,s_value,i_line_number, i_offset,s_line]); + EName := sType; + EValue := s_value; + EFileName := s_filename; + ELineNumber := i_line_number; + EOffset := i_offset; + EEndLineNumber := i_end_line_number; + EEndOffset := i_end_offset; + ELineStr := s_line; end; end else @@ -4892,7 +4999,7 @@ procedure TPythonEngine.DoRedirectIO; ' def flush(self):' + LF + ' pass' + LF + ' def isatty(self):' + LF + - ' return True' + LF + + ' return False' + LF + 'sys.old_stdin=sys.stdin'+LF+ 'sys.old_stdout=sys.stdout'+LF+ 'sys.old_stderr=sys.stderr'+LF+ @@ -4936,7 +5043,7 @@ procedure TPythonEngine.RemoveClient( client : TEngineClient ); // is not predictable and may cause some memory crashes ! if (csDesigning in ComponentState) then FClients.Remove( client ) - else if (Initialized) then begin + else if Initialized then begin FClients.Remove( client ); if (ClientCount = 0) then Finalize; @@ -4957,6 +5064,27 @@ function TPythonEngine.FindClient( const aName : AnsiString ) : TEngineClient; end; end; +function TPythonEngine.EncodeString(const str: UnicodeString): AnsiString; {$IFDEF FPC}overload;{$ENDIF} +begin + Result := UTF8Encode(str) +end; + +{$IFDEF FPC} +function TPythonEngine.EncodeString (const str: AnsiString): AnsiString; overload; +begin + Result := UTF8Encode(str); +end; +{$ENDIF} + +function TPythonEngine.EncodeWindowsFilePath(const str: string): AnsiString; +{PEP 529} +begin + if (MajorVersion > 3) or ((MajorVersion = 3) and (MinorVersion >=6) )then + Result := UTF8Encode(str) + else + Result := AnsiString(str); +end; + function TPythonEngine.TypeByName( const aTypeName : AnsiString ) : PPyTypeObject; var i : Integer; @@ -5547,15 +5675,17 @@ function TPythonEngine.StringsToPyTuple( strings : TStrings ) : PPyObject; PyUnicodeFromString( strings.Strings[i]) ); end; -procedure TPythonEngine.PyListToStrings( list : PPyObject; strings : TStrings ); +procedure TPythonEngine.PyListToStrings(list: PPyObject; Strings: TStrings; + ClearStrings: Boolean = True); var i : Integer; begin if not PyList_Check(list) then raise EPythonError.Create('the python object is not a list'); - strings.Clear; + if ClearStrings then + Strings.Clear; for i := 0 to PyList_Size( list ) - 1 do - strings.Add( PyObjectAsString( PyList_GetItem( list, i ) ) ); + Strings.Add( PyObjectAsString( PyList_GetItem( list, i ) ) ); end; procedure TPythonEngine.PyTupleToStrings( tuple: PPyObject; strings : TStrings ); @@ -5583,35 +5713,24 @@ function TPythonEngine.PyBytesAsAnsiString(obj: PPyObject): AnsiString; raise EPythonError.CreateFmt(SPyConvertionError, ['PyBytesAsAnsiString', 'Bytes']); end; -function TPythonEngine.PyUnicodeAsString( obj : PPyObject ) : UnicodeString; +function TPythonEngine.PyUnicodeAsString(obj : PPyObject) : UnicodeString; var - _size : Integer; -{$IFDEF POSIX} - _ucs4Str : UCS4String; -{$ENDIF} + Buffer: PAnsiChar; + Size: NativeInt; + NewSize: Cardinal; begin if PyUnicode_Check(obj) then begin - _size := PyUnicode_GetSize(obj); - if _size > 0 then - begin -{$IFDEF POSIX} - // Note that Linux uses UCS4 strings, whereas it declares using UCS2 strings!!! - SetLength(_ucs4Str, _size+1); - if PyUnicode_AsWideChar(obj, @_ucs4Str[0], _size) <> _size then - raise EPythonError.Create('Could not copy the whole Unicode string into its buffer'); - Result := UCS4StringToWideString(_ucs4Str); - // remove trailing zeros (needed by Kylix1) - while (Length(Result) > 0) and (Result[Length(Result)] = #0) do - Delete(Result, Length(Result), 1); -{$ELSE} - SetLength(Result, _size); - if PyUnicode_AsWideChar(obj, @Result[1], _size) <> _size then - raise EPythonError.Create('Could not copy the whole Unicode string into its buffer'); -{$ENDIF} - end - else - Result := ''; + // Size does not include the final #0 + Buffer := PyUnicode_AsUTF8AndSize(obj, @Size); + SetLength(Result, Size); + if (Size = 0) or (Buffer = nil) then + Exit; + + // The second argument is the size of the destination (Result) including #0 + NewSize := Utf8ToUnicode(PUnicodeChar(Result), Size + 1, Buffer, Size); + // NewSize includes #0 + SetLength(Result, NewSize - 1); end else raise EPythonError.CreateFmt(SPyConvertionError, ['PyUnicodeAsString', 'Unicode']); @@ -5772,15 +5891,19 @@ procedure TPythonEngine.ListToSet( List : PPyObject; data : Pointer; size : Inte end; procedure TPythonEngine.CheckError(ACatchStopEx : Boolean = False); + procedure ProcessSystemExit; var errtype, errvalue, errtraceback: PPyObject; SErrValue: string; begin + // PyErr_Fetch clears the error. The returned python objects are new references PyErr_Fetch(errtype, errvalue, errtraceback); Traceback.Refresh(errtraceback); SErrValue := PyObjectAsString(errvalue); - PyErr_Clear; + Py_XDECREF(errtype); + Py_XDECREF(errvalue); + Py_XDECREF(errtraceback); raise EPySystemExit.CreateResFmt(@SPyExcSystemError, [SErrValue]); end; @@ -5812,7 +5935,7 @@ function TPythonEngine.GetMainModule : PPyObject; Result := PyImport_AddModule(PAnsiChar(ExecModule)); end; -function TPythonEngine.PyTimeStruct_Check( obj : PPyObject ) : Boolean; +function TPythonEngine.PyTimeStruct_Check(obj : PPyObject) : Boolean; begin Result := Assigned(FTimeStruct) and (Pointer(obj^.ob_type) = FTimeStruct); end; @@ -5912,6 +6035,10 @@ constructor TEngineClient.Create( AOwner : TComponent ); destructor TEngineClient.Destroy; begin + // if the client is destroyed before the Python Engine then + // we need to finalize it. Otherwise it will already be finalized + if FInitialized then + Finalize; Engine := nil; // This detaches the client from the Engine. if Assigned( FOnDestroy ) then FOnDestroy( Self ); @@ -5925,14 +6052,6 @@ procedure TEngineClient.Loaded; FOnCreate( Self ); end; -procedure TEngineClient.Notification( AComponent: TComponent; Operation: TOperation); -begin - inherited; - if Operation = opRemove then - if AComponent = FEngine then - FEngine := nil; -end; - procedure TEngineClient.Initialize; begin if FInitialized then @@ -6170,12 +6289,26 @@ function TMethodsContainer.AddMethodWithKeywords( AMethodName : PAnsiChar; Result^.ml_flags := Result^.ml_flags or METH_KEYWORDS; end; +function TMethodsContainer.AddStaticMethodWithKeywords(AMethodName: PAnsiChar; + AMethod: PyCFunctionWithKW; ADocString: PAnsiChar): PPyMethodDef; +begin + Result := AddMethodWithKeywords(AMethodName, AMethod, ADocString); + Result^.ml_flags := Result^.ml_flags or METH_STATIC; +end; + +function TMethodsContainer.AddClassMethodWithKeywords(AMethodName: PAnsiChar; + AMethod: PyCFunctionWithKW; ADocString: PAnsiChar): PPyMethodDef; +begin + Result := AddMethodWithKeywords(AMethodName, AMethod, ADocString); + Result^.ml_flags := Result^.ml_flags or METH_CLASS; +end; + function TMethodsContainer.AddDelphiMethod( AMethodName : PAnsiChar; ADelphiMethod: TDelphiMethod; ADocString : PAnsiChar ) : PPyMethodDef; begin Result := AddMethod( AMethodName, - GetOfObjectCallBack( TCallBack(ADelphiMethod), 2, ctCDECL), + GetOfObjectCallBack( TCallBack(ADelphiMethod), 2, DEFAULT_CALLBACK_TYPE), ADocString ); end; @@ -6184,7 +6317,7 @@ function TMethodsContainer.AddDelphiMethodWithKeywords( AMethodName : PAnsiCh ADocString : PAnsiChar ) : PPyMethodDef; begin Result := AddMethod( AMethodName, - GetOfObjectCallBack( TCallBack(ADelphiMethod), 3, ctCDECL), + GetOfObjectCallBack( TCallBack(ADelphiMethod), 3, DEFAULT_CALLBACK_TYPE), ADocString ); Result^.ml_flags := Result^.ml_flags or METH_KEYWORDS; end; @@ -6519,6 +6652,7 @@ procedure TError.Assign(Source: TPersistent); begin Name := TError(Source).Name; Text := TError(Source).Text; + ErrorType := TError(Source).ErrorType; Exit; end; inherited Assign(Source); @@ -6583,7 +6717,7 @@ procedure TError.RaiseError( const msg : AnsiString ); begin Owner.Owner.CheckEngine; with Owner.Owner.Engine do - PyErr_SetString( Error, PAnsiChar(msg) ); + PyErr_SetString(Error, PAnsiChar(EncodeString(msg))); end; procedure TError.RaiseErrorObj( const msg : AnsiString; obj : PPyObject ); @@ -6634,7 +6768,8 @@ procedure TError.RaiseErrorObj( const msg : AnsiString; obj : PPyObject ); end else raise Exception.Create('TError.RaiseErrorObj: I didn''t get an instance' ); - PyErr_SetObject( Error, res ); + PyErr_SetObject(Error, res); + Py_XDECREF(res); end else PyErr_SetObject( Error, obj ); @@ -6817,9 +6952,10 @@ procedure TPythonModule.InitializeForNewInterpreter; end; end; -procedure TPythonModule.AddClient( client : TEngineClient ); +procedure TPythonModule.AddClient(Client : TEngineClient); begin - FClients.Add( client ); + if FClients.IndexOf(Client) < 0 then + FClients.Add(Client); end; function TPythonModule.ErrorByName( const AName : AnsiString ) : TError; @@ -6850,6 +6986,12 @@ procedure TPythonModule.RaiseErrorObj( const error, msg : AnsiString; obj : PPyO ErrorByName( error ).RaiseErrorObj( msg, obj ); end; +procedure TPythonModule.RemoveClient(Client: TEngineClient); +begin + // Remove does not raise an exception if not found + FClients.Remove(Client); +end; + procedure TPythonModule.BuildErrors; var i : Integer; @@ -6937,11 +7079,12 @@ function TPythonModule.GetVarAsVariant( const varName : AnsiString ) : Variant; with Engine do begin obj := GetVar( varName ); - try - Result := PyObjectAsVariant( obj ); - finally - Py_XDecRef(obj); - end; + if Assigned(obj) then + try + Result := PyObjectAsVariant( obj ); + finally + Py_XDecRef(obj); + end; end; end; @@ -6970,7 +7113,8 @@ constructor TPyObject.Create( APythonType : TPythonType ); end; end; -constructor TPyObject.CreateWith( APythonType : TPythonType; args : PPyObject ); +constructor TPyObject.CreateWith(APythonType: TPythonType; args, kwds: + PPyObject); begin Create( APythonType ); end; @@ -7079,7 +7223,7 @@ function TPyObject.SetAttr(key : PAnsiChar; value : PPyObject) : Integer; begin Result := -1; PyErr_SetString (PyExc_AttributeError^, - PAnsiChar(AnsiString(Format('Unknown attribute "%s"',[key])))); + PAnsiChar(EncodeString(Format('Unknown attribute "%s"',[key])))); end; end; @@ -7502,13 +7646,21 @@ procedure TPythonType.SetModule( val : TPythonModule ); begin if val <> FModule then begin + if Assigned(FModule) then + begin + FModule.RemoveFreeNotification(Self); + FModule.RemoveClient(Self); + end; FModule := val; if Assigned(val) then + begin + val.FreeNotification(Self); if Initialized and not (csLoading in ComponentState) then if val.Initialized then AddTypeVar else val.AddClient(Self); + end; end; end; @@ -7531,9 +7683,9 @@ procedure TPythonType.SetTypeName( const val : AnsiString ); end; end; -function TPythonType.CreateMethod( pSelf, args : PPyObject ) : PPyObject; +function TPythonType.CreateMethod(pSelf, args, kwds: PPyObject): PPyObject; begin - Result := CreateInstanceWith( args ); + Result := CreateInstanceWith(args, kwds); end; procedure TPythonType.ReallocGetSets; @@ -7558,6 +7710,14 @@ procedure TPythonType.ReallocMethods; FType.tp_methods := MethodsData; end; +procedure TPythonType.SetBaseType(AType: TPythonType); +begin + if AType = nil then + FType.tp_base := nil + else + FType.tp_base := @AType.FType; +end; + procedure TPythonType.SetDocString( value : TStringList ); begin FDocString.Assign( value ); @@ -7702,7 +7862,7 @@ function TPythonType.NewSubtypeInst( aType: PPyTypeObject; args, kwds : PPyObje obj.ob_type := aType; obj.IsSubtype := aType <> @FType; obj.PythonAlloc := True; - obj.CreateWith(Self, args); + obj.CreateWith(Self, args, kwds); if Engine.PyErr_Occurred <> nil then begin Engine.Py_DECREF(Result); @@ -8001,7 +8161,7 @@ procedure TPythonType.InitServices; begin tp_init := TPythonType_InitSubtype; tp_alloc := TPythonType_AllocSubtypeInst; - tp_new := GetCallBack( Self, @TPythonType.NewSubtypeInst, 3, ctCDECL); + tp_new := GetCallBack( Self, @TPythonType.NewSubtypeInst, 3, DEFAULT_CALLBACK_TYPE); tp_free := FreeSubtypeInst; tp_methods := MethodsData; tp_members := MembersData; @@ -8119,6 +8279,7 @@ destructor TPythonType.Destroy; begin if gVarType = Self then gVarType := nil; + Module := nil; FDocString.Free; FServices.Free; inherited; @@ -8152,7 +8313,8 @@ procedure TPythonType.Initialize; procedure TPythonType.Finalize; begin - Engine.Py_XDECREF(FCreateFunc); + if Assigned(Engine) then + Engine.Py_CLEAR(FCreateFunc); FCreateFunc := nil; inherited; end; @@ -8176,14 +8338,14 @@ function TPythonType.CreateInstance : PPyObject; end; end; -function TPythonType.CreateInstanceWith( args : PPyObject ) : PPyObject; +function TPythonType.CreateInstanceWith(args, kwds: PPyObject): PPyObject; var obj : TPyObject; begin CheckEngine; with Engine do begin - obj := PyObjectClass.CreateWith( Self, args ); + obj := PyObjectClass.CreateWith(Self, args, kwds); obj.ob_type := @FType; if PyErr_Occurred <> nil then begin @@ -8198,7 +8360,7 @@ function TPythonType.CreateInstanceWith( args : PPyObject ) : PPyObject; procedure TPythonType.AddTypeVar; var d : PPyObject; - meth : TDelphiMethod; + meth : TDelphiMethodWithKW; begin CheckEngine; Assert(Module <> nil); @@ -8211,10 +8373,11 @@ procedure TPythonType.AddTypeVar; begin meth := CreateMethod; FCreateFuncDef.ml_name := PAnsiChar(FCreateFuncName); - FCreateFuncDef.ml_meth := GetOfObjectCallBack( TCallBack(meth), 2, ctCDECL); - FCreateFuncDef.ml_flags := METH_VARARGS; + FCreateFuncDef.ml_meth := GetOfObjectCallBack(TCallBack(meth), 3, DEFAULT_CALLBACK_TYPE); + FCreateFuncDef.ml_flags := METH_KEYWORDS; FCreateFuncDef.ml_doc := PAnsiChar(FCreateFuncDoc); - FCreateFunc := Engine.PyCFunction_NewEx(@FCreateFuncDef, nil, nil) + FCreateFunc := Engine.PyCFunction_NewEx(@FCreateFuncDef, nil, nil); + Engine.Py_INCREF(FCreateFunc); end; Assert(Assigned(FCreateFunc)); end; @@ -8450,7 +8613,7 @@ constructor TPyVar.Create( APythonType : TPythonType ); // the Create constructor first, and because the constructors // are virtual, TPyVar.Create will be automatically be called. -constructor TPyVar.CreateWith( APythonType : TPythonType; args : PPyObject ); +constructor TPyVar.CreateWith(APythonType: TPythonType; args, kwds: PPyObject); begin inherited; with GetPythonEngine do diff --git a/python4lazarus/PythonVersions.pas b/python4lazarus/PythonVersions.pas index 21d8155..6b746de 100644 --- a/python4lazarus/PythonVersions.pas +++ b/python4lazarus/PythonVersions.pas @@ -1,7 +1,6 @@ {----------------------------------------------------------------------------- Unit Name: PythonVersions - Author: Kiriakos - Date: PyScripter + Author: PyScripter Purpose: Discover and get info about Python versions Part of the Python for Delphi library @@ -105,13 +104,7 @@ function TPythonVersion.GetDLLName: string; function TPythonVersion.ExpectedArchitecture: string; begin Result := ''; - {$IFDEF CPUX64} - Result := '64bit'; - {$ENDIF} - {$IFDEF CPU64} - Result := '64bit'; - {$ENDIF} - {$IFDEF CPU64bits} + {$IF Defined(CPUX64) or Defined(CPU64) or Defined(CPU64bits)} Result := '64bit'; {$ENDIF} if Result = '' then @@ -173,17 +166,24 @@ function TPythonVersion.GetDisplayName: string; function TPythonVersion.GetHelpFile: string; var PythonHelpFilePath: string; + HtmlIndex: string; Res: Integer; SR: TSearchRec; begin Result := FHelpFile; - // for unregistered Python - if (Result = '') and (InstallPath <> '') then + // for unregistered Python or python 11 + if ((Result = '') or (ExtractFileExt(Result) = '.html')) and (InstallPath <> '') then begin - PythonHelpFilePath := InstallPath + '\Doc\python*.chm'; + PythonHelpFilePath := IncludeTrailingPathDelimiter(InstallPath) + 'Doc\python*.chm'; Res := FindFirst(PythonHelpFilePath, faAnyFile, SR); if Res = 0 then - Result := InstallPath + '\Doc\' + SR.Name; + Result := IncludeTrailingPathDelimiter(InstallPath) + 'Doc\' + SR.Name + else if Result = '' then + begin + HtmlIndex := IncludeTrailingPathDelimiter(InstallPath) + 'Doc\html\index.html'; + if FileExists(HtmlIndex) then + Result := HtmlIndex; + end; FindClose(SR); end; end; diff --git a/python4lazarus/VarPyth.pas b/python4lazarus/VarPyth.pas index c933e01..29f2328 100644 --- a/python4lazarus/VarPyth.pas +++ b/python4lazarus/VarPyth.pas @@ -40,7 +40,7 @@ interface uses - Variants, PythonEngine; + Variants, PythonEngine, Classes; type TSequenceType = (stTuple, stList); @@ -108,6 +108,7 @@ function BuiltinModule: Variant; // return the builtin module function SysModule: Variant; // return the builtin module 'sys' function DatetimeModule: Variant; // return the builtin module 'datetime' function Import(const AModule: string): Variant; // import a Python module and return the module object. +function Reload(const AModule: Variant): Variant; //reload a Python imported module and return the module object. function len(const AValue : Variant ): NativeInt; // return the length of a Python collection. function _type(const AValue : Variant ): Variant; // return the type object of a Python object. function iter(const AValue : Variant ): Variant; // return an iterator for the container AValue. You can call the 'next' method of the iterator until you catch the EPyStopIteration exception. @@ -134,10 +135,13 @@ TVarPyEnumerateHelper = record function VarPyIterate(const AValue: Variant): TVarPyEnumerateHelper; +// Adds a python iterable items to a TStrings +procedure VarPyToStrings(const AValue : Variant; const AStrings: TStrings); + implementation uses - VarUtils, SysUtils, TypInfo, Classes; + VarUtils, SysUtils, TypInfo; type TNamedParamDesc = record @@ -146,14 +150,8 @@ TNamedParamDesc = record end; TNamedParamArray = array of TNamedParamDesc; -{$IFDEF DELPHIXE2_OR_HIGHER} - {$DEFINE USESYSTEMDISPINVOKE} //Delphi 2010 DispInvoke is buggy - {$IF defined(OSX64) or defined(LINUX) or not defined(DELPHI10_4_OR_HIGHER)} - {$DEFINE PATCHEDSYSTEMDISPINVOKE} //To correct memory leaks - {$IFEND} -{$ENDIF} -{$IF DEFINED(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20500)} - {$DEFINE USESYSTEMDISPINVOKE} +{$IF not defined(FPC) and (defined(OSX64) or defined(LINUX) or not defined(DELPHI10_4_OR_HIGHER))} + {$DEFINE PATCHEDSYSTEMDISPINVOKE} //To correct memory leaks {$IFEND} { Python variant type handler } @@ -169,20 +167,13 @@ TPythonVariantType = class(TInvokeableVariantType, IVarInstanceReference) const Arguments: TVarDataArray): PPyObject; function VarDataToPythonObject( AVarData : TVarData ) : PPyObject; procedure PyhonVarDataCreate( var Dest : TVarData; AObject : PPyObject ); - {$IFNDEF USESYSTEMDISPINVOKE} - procedure DoDispInvoke(Dest: PVarData; var Source: TVarData; - CallDesc: PCallDesc; Params: Pointer); virtual; - function GetPropertyWithArg(var Dest: TVarData; const V: TVarData; - const AName: AnsiString; AArg : TVarData): Boolean; virtual; - {$ENDIF USESYSTEMDISPINVOKE} - {$IFNDEF FPC} - function FixupIdent(const AText: string): string; override; - {$ENDIF FPC} {$IFDEF FPC} procedure VarDataClear(var Dest: TVarData); procedure VarDataCopyNoInd(var Dest: TVarData; const Source: TVarData); procedure VarDataCastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType); overload; + {$ELSE} + function FixupIdent(const AText: string): string; override; {$ENDIF FPC} public procedure Clear(var V: TVarData); override; @@ -275,9 +266,9 @@ TPythonData = class(TObject) Reserved1, Reserved2, Reserved3: Word; VPython: TPythonData; Reserved4: Integer; - {$IFDEF CPUX64} + {$IFDEF CPU64BITS} Reserved5: Integer; // size is 24 bytes in 64bit - {$ENDIF CPUX64} + {$ENDIF CPU64BITS} end; @@ -727,6 +718,22 @@ function Import(const AModule: string): Variant; end; // of with end; +function Reload(const AModule: Variant): Variant; +var + LModule: PPyObject; +begin + with GetPythonEngine() do begin + LModule := PyImport_ReloadModule(ExtractPythonObjectFrom(AModule)); + CheckError(); + Assert(Assigned(LModule)); + try + Result := VarPythonCreate(LModule); + finally + Py_XDecRef(LModule); + end; // of try + end; // of with +end; + function GetObjectLength(AObject: PPyObject): NativeInt; begin with GetPythonEngine do @@ -1138,7 +1145,6 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData; procedure TPythonVariantType.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); {$ENDIF} -{$IFDEF USESYSTEMDISPINVOKE} {$IFDEF PATCHEDSYSTEMDISPINVOKE} // Modified to correct memory leak QC102387 / RSP-23093 procedure PatchedFinalizeDispatchInvokeArgs(CallDesc: PCallDesc; const Args: TVarDataArray; OrderLTR : Boolean); @@ -1316,283 +1322,6 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData; end; end; -{$ELSE USESYSTEMDISPINVOKE} -begin - DoDispInvoke(Dest, Source, CallDesc, Params); -end; - -procedure TPythonVariantType.DoDispInvoke(Dest: PVarData; - var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); -type - PParamRec = ^TParamRec; - TParamRec = array[0..3] of Integer; - TStringDesc = record - BStr: WideString; - PStr: PAnsiString; - end; -var - LArguments: TVarDataArray; - LStrings: array of TStringDesc; - LStrCount: Integer; - LParamPtr: Pointer; - LNamedArgStart : Integer; //arg position of 1st named argument (if any) - LNamePtr: PAnsiChar; - - procedure ParseParam(I: Integer); - const - CArgTypeMask = $7F; - CArgByRef = $80; - var - LArgType: Integer; - LArgByRef: Boolean; - begin - LArgType := CallDesc^.ArgTypes[I] and CArgTypeMask; - LArgByRef := (CallDesc^.ArgTypes[I] and CArgByRef) <> 0; - - if I >= LNamedArgStart then - begin - LNamePtr := LNamePtr + Succ(StrLen(LNamePtr)); - fNamedParams[I-LNamedArgStart].Index := I; - fNamedParams[I-LNamedArgStart].Name := AnsiString(LNamePtr); - end; - - // error is an easy expansion - if LArgType = varError then - SetClearVarToEmptyParam(LArguments[I]) - - // literal string - else if LArgType = varStrArg then - begin - with LStrings[LStrCount] do - if LArgByRef then - begin - //BStr := StringToOleStr(PAnsiString(ParamPtr^)^); - BStr := WideString(System.Copy(PAnsiString(LParamPtr^)^, 1, MaxInt)); - PStr := PAnsiString(LParamPtr^); - LArguments[I].VType := varOleStr or varByRef; - LArguments[I].VOleStr := @BStr; - end - else - begin - //BStr := StringToOleStr(PAnsiString(LParamPtr)^); - BStr := WideString(System.Copy(PAnsiString(LParamPtr)^, 1, MaxInt)); - PStr := nil; - LArguments[I].VType := varOleStr; - if BStr = '' then - LArguments[I].VOleStr := nil - else - LArguments[I].VOleStr := PWideChar(BStr); - end; - Inc(LStrCount); - end - - // value is by ref - else if LArgByRef then - begin - if (LArgType = varVariant) and - (PVarData(LParamPtr^)^.VType = varString) - or (PVarData(LParamPtr)^.VType = varUString) - then - //VarCast(PVariant(ParamPtr^)^, PVariant(ParamPtr^)^, varOleStr); - VarDataCastTo(PVarData(LParamPtr^)^, PVarData(LParamPtr^)^, varOleStr); - LArguments[I].VType := LArgType or varByRef; - LArguments[I].VPointer := Pointer(LParamPtr^); - end - - // value is a variant - else if LArgType = varVariant then - if (PVarData(LParamPtr)^.VType = varString) - or (PVarData(LParamPtr)^.VType = varUString) - then - begin - with LStrings[LStrCount] do - begin - //BStr := StringToOleStr(AnsiString(PVarData(LParamPtr)^.VString)); - if (PVarData(LParamPtr)^.VType = varString) then - BStr := WideString(System.Copy(AnsiString(PVarData(LParamPtr)^.VString), 1, MaxInt)) - else - {$IFDEF FPC} - BStr := System.Copy(UnicodeString(PVarData(LParamPtr)^.VString), 1, MaxInt); - {$ELSE} - BStr := System.Copy(UnicodeString(PVarData(LParamPtr)^.VUString), 1, MaxInt); - {$ENDIF} - PStr := nil; - LArguments[I].VType := varOleStr; - LArguments[I].VOleStr := PWideChar(BStr); - end; - Inc(LStrCount); - Inc(NativeInt(LParamPtr), SizeOf(TVarData) - SizeOf(Pointer)); - end - else - begin - LArguments[I] := PVarData(LParamPtr)^; - Inc(NativeInt(LParamPtr), SizeOf(TVarData) - SizeOf(Pointer)); - end - else - begin - LArguments[I].VType := LArgType; - case CVarTypeToElementInfo[LArgType].Size of - 1, 2, 4: - begin - LArguments[I].VLongs[1] := PParamRec(LParamPtr)^[0]; - end; - 8: - begin - LArguments[I].VLongs[1] := PParamRec(LParamPtr)^[0]; - LArguments[I].VLongs[2] := PParamRec(LParamPtr)^[1]; - Inc(NativeInt(LParamPtr), 8 - SizeOf(Pointer)); - end; - else - RaiseDispError; - end; - end; - Inc(NativeInt(LParamPtr), SizeOf(Pointer)); - end; - -var - I, LArgCount: Integer; - LIdent: AnsiString; - LTemp: TVarData; -begin - //------------------------------------------------------------------------------------ - // Note that this method is mostly a copy&paste from TInvokeableVariantType.DispInvoke - // because Borland assumes that the names are not case sensitive, whereas Python has - // case sensitive symbols. - // We modified the property get to allow the use of indexed properties. - //------------------------------------------------------------------------------------ - - // Grab the identifier - LArgCount := CallDesc^.ArgCount; - //After arg types, method name and named arg names are stored - //Position pointer on method name - LNamePtr := PAnsiChar(@CallDesc^.ArgTypes[LArgCount]); - LIdent := AnsiString(LNamePtr); - //Named params must be after positional params - LNamedArgStart := CallDesc^.ArgCount - CallDesc^.NamedArgCount; - SetLength(fNamedParams, CallDesc^.NamedArgCount); - - // Parse the arguments - LParamPtr := Params; - SetLength(LArguments, LArgCount); - LStrCount := 0; - SetLength(LStrings, LArgCount); - for I := 0 to LArgCount - 1 do - ParseParam(I); - - // What type of invoke is this? - case CallDesc^.CallType of - CDoMethod: - // procedure with N arguments - if Dest = nil then - begin - if not DoProcedure(Source, string(LIdent), LArguments) then - begin - - // ok maybe its a function but first we must make room for a result - VarDataInit(LTemp); - try - - // notate that the destination shouldn't be bothered with - // functions can still return stuff, we just do this so they - // can tell that they don't need to if they don't want to - SetClearVarToEmptyParam(LTemp); - - // ok lets try for that function - if not DoFunction(LTemp, Source, string(LIdent), LArguments) then - RaiseDispError; - finally - VarDataClear(LTemp); - end; - end - end - - // property get or function with 0 argument - else if LArgCount = 0 then - begin - if not GetProperty(Dest^, Source, string(LIdent)) and - not DoFunction(Dest^, Source, string(LIdent), LArguments) then - RaiseDispError; - end - - // function with N arguments - else if not DoFunction(Dest^, Source, string(LIdent), LArguments) then - RaiseDispError; - - CPropertyGet: - begin - // here that code has been changed to allow the indexed properties. - - if Dest = nil then // there must be a dest - RaiseDispError; - if LArgCount = 0 then // no args - begin - if not GetProperty(Dest^, Source, string(LIdent)) then // get op be valid - RaiseDispError; - end - else if LArgCount = 1 then // only one arg - begin - if not GetPropertyWithArg(Dest^, Source, LIdent, LArguments[0]) then // get op be valid - RaiseDispError; - end - else - raise Exception.Create( SMultiDimensionalPropsNotSupported ); - end; - - CPropertySet: - if not ((Dest = nil) and // there can't be a dest - (LArgCount = 1) and // can only be one arg - SetProperty(Source, string(LIdent), LArguments[0])) then // set op be valid - RaiseDispError; - else - RaiseDispError; - end; - - // copy back the string info - I := LStrCount; - while I <> 0 do - begin - Dec(I); - with LStrings[I] do - if Assigned(PStr) then - PStr^ := AnsiString(System.Copy(BStr, 1, MaxInt)); - end; -end; - -function TPythonVariantType.GetPropertyWithArg(var Dest: TVarData; - const V: TVarData; const AName: AnsiString; AArg: TVarData): Boolean; -var - _prop, _result : PPyObject; -begin - with GetPythonEngine do - begin - _result := nil; - _prop := PyObject_GetAttrString(TPythonVarData(V).VPython.PyObject, PAnsiChar(AName)); - CheckError; - if Assigned(_prop) then - begin - // here we check only sequences, as Delphi does not allow a type different from Integer - // to be used within brackets. - // But you can still access a dictionary with parenthesis, like: myObj.MyDict('MyKey') - // Note that we can't use the brackets on a Python variant that contains a list, - // because Delphi thinks it's a variant array, whereas it is not, of course! - // So: myList[0] won't work, but myObj.MyList[0] will!!! - if PySequence_Check(_prop) <> 0 then - begin - _result := PySequence_GetItem(_prop, Variant(AArg)); - CheckError; - end; // of if - end; // of if - Result := Assigned(_result); - if Result then - try - PyhonVarDataCreate(Dest, _result); - finally - Py_XDecRef(_prop); - end; // of try - end; // of with -end; -{$ENDIF USESYSTEMDISPINVOKE} - function TPythonVariantType.DoFunction(var Dest: TVarData; const V: TVarData; const AName: string; const Arguments: TVarDataArray): Boolean; @@ -2419,7 +2148,7 @@ function TVarPyEnumerator.MoveNext: Boolean; function VarPyIterate(const AValue: Variant): TVarPyEnumerateHelper; begin - Result.Create(AValue); + Result := TVarPyEnumerateHelper.Create(AValue); end; { TVarPyEnumerateHelper } @@ -2431,11 +2160,21 @@ constructor TVarPyEnumerateHelper.Create(const AValue: Variant); function TVarPyEnumerateHelper.GetEnumerator: TVarPyEnumerator; begin - Result.Create(FIterable); + Result := TVarPyEnumerator.Create(FIterable); +end; + +procedure VarPyToStrings(const AValue : Variant; const AStrings: TStrings); +var + V: Variant; +begin + for V in VarPyIterate(AValue) do + AStrings.Add(V) end; initialization PythonVariantType := TPythonVariantType.Create; + finalization FreeAndNil(PythonVariantType); + end. diff --git a/python4lazarus/python4lazarus_package.lpk b/python4lazarus/python4lazarus_package.lpk index 0e54dec..8e0dd01 100644 --- a/python4lazarus/python4lazarus_package.lpk +++ b/python4lazarus/python4lazarus_package.lpk @@ -25,7 +25,7 @@ - +