1. utku karatas
  2. delPython

Commits

utku  committed 1185c9b

more tests pass

  • Participants
  • Parent commits 0be47a1
  • Branches default

Comments (0)

Files changed (8)

File LitePython.pas

-{ DelPythonizer: A library for interfacing existing Delphi functionality to Python.
-
-  Requirements:
-    - Delphi 2010 or later. Older versions are not supported (LitePython uses the latest RTTI
-      tricks from Delphi 2010).
-    - Python 2.6 - 2.7. Older versions and 3.x are not supported.
-
-  Contributors:
-    - M.Utku Karatas - 2009.
-
-  * Some portions of code from PythonForDelphi package (xxx).
-}
-
-unit LitePython;
-
-interface
-
-uses
-  Classes, SysUtils, Generics.Collections, Rtti;
-
-{ -------------------------------------------------------------------------------------------------------------------- }
-{ C API wrappers }
-
-const
-  single_input = 256;
-  file_input = 257;
-  eval_input = 258;
-  PYTHON_API_VERSION = 1013;
-
-  METH_VARARGS = $1;
-
-  { for tp_flags }
-  Py_TPFLAGS_HAVE_GETCHARBUFFER = (1 shl 0);
-  Py_TPFLAGS_HAVE_SEQUENCE_IN = (1 shl 1);
-  Py_TPFLAGS_GC = (1 shl 2);
-  Py_TPFLAGS_HAVE_INPLACEOPS = (1 shl 3);
-  Py_TPFLAGS_CHECKTYPES = (1 shl 4);
-  Py_TPFLAGS_HAVE_RICHCOMPARE = (1 shl 5);
-  Py_TPFLAGS_HAVE_WEAKREFS = (1 shl 6);
-  Py_TPFLAGS_HAVE_ITER = (1 shl 7);
-  Py_TPFLAGS_HAVE_CLASS = (1 shl 8);
-  Py_TPFLAGS_HEAPTYPE = (1 shl 9);
-  Py_TPFLAGS_BASETYPE = (1 shl 10);
-  Py_TPFLAGS_READY = (1 shl 12);
-  Py_TPFLAGS_READYING = (1 shl 13);
-  Py_TPFLAGS_HAVE_GC = (1 shl 14);
-  Py_TPFLAGS_DEFAULT = Py_TPFLAGS_HAVE_GETCHARBUFFER or
-                       Py_TPFLAGS_HAVE_SEQUENCE_IN or
-                       Py_TPFLAGS_HAVE_INPLACEOPS or
-                       Py_TPFLAGS_HAVE_RICHCOMPARE or
-                       Py_TPFLAGS_HAVE_WEAKREFS or
-                       Py_TPFLAGS_HAVE_ITER or
-                       Py_TPFLAGS_HAVE_CLASS;
-
-type
-  unused_python_pointer_type = pointer; // some types are just not needed to be even declared.
-  PPyObject = ^PyObject;
-  PPyTypeObject = ^PyTypeObject;
-  pydestructor = procedure(ob: PPyObject); cdecl;
-  printfunc = function(ob: PPyObject; var f: file; i: integer): integer; cdecl;
-  getattrfunc = function(ob1: PPyObject; name: PAnsiChar): PPyObject; cdecl;
-  setattrfunc = function(ob1: PPyObject; name: PAnsiChar; ob2: PPyObject): integer; cdecl;
-  cmpfunc = function(ob1, ob2: PPyObject): integer; cdecl;
-  reprfunc = function(ob: PPyObject): PPyObject; cdecl;
-  PyCFunction = function(self, args: PPyObject): PPyObject; cdecl;
-  newfunc = function(subtype: PPyTypeObject; args, kwds: PPyObject): PPyObject; cdecl;
-  allocfunc = function(self: PPyTypeObject; nitems: integer): PPyObject; cdecl;
-  ternaryfunc = function(self, args, kwds : PPyObject): PPyObject; cdecl;
-
-  PPyMethodDef = ^PyMethodDef;
-  PyMethodDef = packed record
-    ml_name: PAnsiChar;
-    ml_meth: PyCFunction;
-    ml_flags: integer;
-    ml_doc: PAnsiChar;
-  end;
-  
-  PyTypeObject = packed record
-    ob_refcnt: integer;
-    ob_type: PPyTypeObject;
-    ob_size: integer; // Number of items in variable part
-    tp_name: PAnsiChar; // For printing
-    tp_basicsize, tp_itemsize: integer; // For allocation
-
-    // Methods to implement standard operations
-    tp_dealloc: pydestructor;
-    tp_print: printfunc;
-    tp_getattr: getattrfunc;
-    tp_setattr: setattrfunc;
-    tp_compare: cmpfunc;
-    tp_repr: reprfunc;
-
-    // Method suites for standard classes
-    tp_as_number: unused_python_pointer_type; // PPyNumberMethods;
-    tp_as_sequence: unused_python_pointer_type; // PPySequenceMethods;
-    tp_as_mapping: unused_python_pointer_type; // PPyMappingMethods;
-
-    // More standard operations (here for binary compatibility)
-    tp_hash: unused_python_pointer_type; // hashfunc;
-    tp_call: ternaryfunc;
-    tp_str: unused_python_pointer_type; // reprfunc;
-    tp_getattro: unused_python_pointer_type; // getattrofunc;
-    tp_setattro: unused_python_pointer_type; // setattrofunc;
-
-    // Functions to access object as input/output buffer
-    tp_as_buffer: unused_python_pointer_type; // PPyBufferProcs;
-
-    // Flags to define presence of optional/expanded features
-    tp_flags: LongInt;
-
-    tp_doc: PAnsiChar; // Documentation AnsiString
-    tp_traverse: unused_python_pointer_type; // traverseproc;
-    tp_clear: unused_python_pointer_type; // inquiry;
-    tp_richcompare: unused_python_pointer_type; // richcmpfunc;
-    tp_weaklistoffset: Longint;
-    tp_iter: unused_python_pointer_type; // getiterfunc;
-    tp_iternext: unused_python_pointer_type; // iternextfunc;
-
-    // Attribute descriptor and subclassing stuff
-    tp_methods          : unused_python_pointer_type; //PPyMethodDef;
-    tp_members          : unused_python_pointer_type; // PPyMemberDef;
-    tp_getset           : unused_python_pointer_type; // PPyGetSetDef;
-    
-    tp_base             : unused_python_pointer_type; // PPyTypeObject;
-    tp_dict             : unused_python_pointer_type; // PPyObject;
-    tp_descr_get        : unused_python_pointer_type; // descrgetfunc;
-    tp_descr_set        : unused_python_pointer_type; // descrsetfunc;
-    tp_dictoffset       : longint;
-    tp_init             : unused_python_pointer_type; // initproc;
-    tp_alloc            : allocfunc;
-    tp_new              : newfunc;
-    tp_free             : pydestructor; // Low-level free-memory routine
-    tp_is_gc            : unused_python_pointer_type; // inquiry; // For PyObject_IS_GC
-    tp_bases            : unused_python_pointer_type; // PPyObject;
-    tp_mro              : unused_python_pointer_type; // PPyObject; // method resolution order
-    tp_cache            : unused_python_pointer_type; // PPyObject;
-    tp_subclasses       : unused_python_pointer_type; // PPyObject;
-    tp_weaklist         : unused_python_pointer_type; // PPyObject;
-    tp_del              : unused_python_pointer_type; // pydestructor;
-
-    // xxx rest ripped... object.h
-  end;
-
-  PyObject = packed record
-    ob_refcnt: integer;
-    ob_type: PPyTypeObject;
-  end;
-
-{ -------------------------------------------------------------------------------------------------------------------- }
-
-type
-
-  EPythonError = class(Exception);
-  EDllImportError = class(Exception);
-
-  TPythonDLL = class
-  public
-    { Wrapping actual Python API functions }
-    Py_Initialize: procedure; cdecl;
-    PyEval_InitThreads: procedure; cdecl;
-    Py_InitModule4: function(name: PAnsiChar; methods: PPyMethodDef; doc: PAnsiChar;
-      self_: PPyObject; apiver: integer): PPyObject; cdecl;
-    PyRun_String: function(str: PAnsiChar; start: integer; globals: PPyObject; locals: PPyObject): PPyObject; cdecl;
-    PyErr_Print: procedure; cdecl;
-    PySys_GetObject: function(s: PAnsiChar): PPyObject; cdecl;
-    PyObject_Str: function(v: PPyObject): PPyObject; cdecl;
-    PyObject_Repr: function(ob: PPyObject): PPyObject; cdecl;
-    PyString_AsString: function(ob: PPyObject): PAnsiChar; cdecl;
-    PyType_IsSubtype: function(a, b: PPyTypeObject): integer; cdecl;
-    PyImport_AddModule: function(name: PAnsiChar): PPyObject; cdecl;
-    PyModule_GetDict: function(module: PPyObject): PPyObject; cdecl;
-    PyType_GenericNew: function(atype: PPyTypeObject; args, kwds: PPyObject): PPyObject; cdecl;
-    PyType_Ready: function(atype: PPyTypeObject): integer; cdecl;
-    PyModule_AddObject: function(amodule: PPyObject; aname: PAnsiChar; value: PPyObject): PPyObject; cdecl;
-    _PyObject_New: function(typ: PPyTypeObject): PPyObject; cdecl;
-    PyString_FromString: function(str: PAnsiChar): PPyObject; cdecl;
-    PyInt_AsLong: function(ob: PPyObject): LONGINT; cdecl;
-    PyString_Type: PPyTypeObject;
-    PyUnicode_Type: PPyTypeObject;
-    PyInt_Type: PPyTypeObject;
-    Py_None: PPyObject;
-  private
-    { Helper methods }
-    fDLLHandle: THandle;
-    procedure Py_INCREF(op: PPyObject);
-    procedure Py_XDECREF(op: PPyObject);
-    procedure Py_DECREF(op: PPyObject);
-    function Py_InitModule(const name: PAnsiChar; methods: PPyMethodDef): PPyObject;
-    function PyString_Check(obj: PPyObject): Boolean;
-    function PyUnicode_Check(obj: PPyObject): Boolean;
-    function PyInt_Check(obj: PPyObject): Boolean;
-    function PyObject_TypeCheck(obj: PPyObject; t: PPyTypeObject): Boolean;
-    function ReturnNone: PPyObject;
-    function GetMainModule: PPyObject;
-    function PyObjectAsString(obj: PPyObject): AnsiString;
-    procedure RaiseError;
-    procedure CheckError;
-  public
-    function Import(const funcname: AnsiString; canFail: Boolean = True): Pointer;
-    procedure LoadDll(const DllPath: string); // raise exc. on errors
-  end;
-
-  TLitePython = class(TPythonDLL)
-  private
-    class function ConvertToPAnsiChar(const S: string): PAnsiChar;
-    procedure xxx(Sender: TObject);
-    procedure generic_event;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    { high level execution }
-    procedure Exec(const Code: string);
-    function Eval(const Code: string): PPyObject;
-    function EvalStr(const Code: string): string;
-  public
-    { interfacing Delphi to Python }
-    fPythonType_DelphiType_Map: TDictionary<PPyTypeObject, TClass>;
-    fModule: PPyObject;
-    procedure CreateModule(aModuleName: AnsiString);
-    
-    procedure Wrap(aClass: TClass);
-    function WrapMethodCall(AnActualObj: TObject; LMethod: string): PPyObject;
-    function WrapProperty(AnActualObj: TObject; LProp: string): PPyObject;
-    function WrapValue(AValue: TValue): PPyObject;
-
-    procedure DeclareGlobal(const NameInPython: string; DelphiEntity: TObject);
-  end;
-
-var
-  python: TLitePython;
-
-implementation
-
-uses
-  Windows, Dialogs, TypInfo, ObjAuto;
-
-{ -------------------------------------------------------------------------------------------------------------------- }
-{ TPythonDLL }
-
-function TPythonDLL.Import(const funcname: AnsiString; canFail: Boolean): Pointer;
-begin
-  Result := GetProcAddress(fDLLHandle, PAnsiChar(funcname));
-  if (Result = nil) and canFail then
-    raise EDllImportError.CreateFmt('Error %d: could not map symbol "%s"', [GetLastError, funcname]);
-end;
-
-procedure TPythonDLL.LoadDll(const DllPath: string);
-begin
-  fDLLHandle := SafeLoadLibrary(DllPath);
-  if fDLLHandle = 0 then
-    raise EDllImportError.Create('Couldn''t load DLL ' + DllPath);
-
-  @PyRun_String := Import('PyRun_String');
-  @Py_Initialize := Import('Py_Initialize');
-  @PyEval_InitThreads := Import('PyEval_InitThreads');
-  @Py_InitModule4 := Import('Py_InitModule4');
-  @PyErr_Print := Import('PyErr_Print');
-  @PySys_GetObject := Import('PySys_GetObject');
-  @PyObject_Str := Import('PyObject_Str');
-  @PyObject_Repr := Import('PyObject_Repr');
-  @PyString_AsString := Import('PyString_AsString');
-  @PyType_IsSubtype := Import('PyType_IsSubtype');
-  @PyImport_AddModule := Import('PyImport_AddModule');
-  @PyModule_GetDict := Import('PyModule_GetDict');
-  @PyType_GenericNew :=Import('PyType_GenericNew');
-  @PyType_Ready :=Import('PyType_Ready');
-  @PyModule_AddObject := Import('PyModule_AddObject');
-  @_PyObject_New := Import('_PyObject_New');
-  @PyString_FromString := Import('PyString_FromString');
-  @PyInt_AsLong := Import('PyInt_AsLong');
-
-  Py_None := Import('_Py_NoneStruct');
-  PyString_Type := Import('PyString_Type');
-  PyUnicode_Type := Import('PyUnicode_Type');
-  PyInt_Type := Import('PyInt_Type');
-
-  Py_Initialize;
-  PyEval_InitThreads;
-end;
-
-function TPythonDLL.PyObject_TypeCheck(obj: PPyObject; t: PPyTypeObject): Boolean;
-begin
-  Result := Assigned(obj) and (obj^.ob_type = t);
-  if not Result and Assigned(obj) and Assigned(t) then
-    Result := PyType_IsSubtype(obj^.ob_type, t) = 1;
-end;
-
-function TPythonDLL.PyString_Check(obj: PPyObject): Boolean;
-begin
-  Result := PyObject_TypeCheck(obj, PyString_Type);
-  if not Result then
-    Result := PyObject_TypeCheck(obj, PyUnicode_Type);
-end;
-
-function TPythonDLL.PyUnicode_Check(obj: PPyObject): Boolean;
-begin
-  Result := PyObject_TypeCheck(obj, PyUnicode_Type);
-end;
-
-procedure TPythonDLL.Py_DECREF(op: PPyObject);
-begin
-  with op^ do
-  begin
-    Dec(ob_refcnt);
-    if ob_refcnt = 0 then
-    begin
-      ob_type^.tp_dealloc(op);
-    end;
-  end;
-end;
-
-procedure TPythonDLL.Py_INCREF(op: PPyObject);
-begin
-  Inc(op^.ob_refcnt);
-end;
-
-function TPythonDLL.Py_InitModule(const name: PAnsiChar; methods: PPyMethodDef): PPyObject;
-begin
-  Result := Py_InitModule4(name, methods, nil, nil, PYTHON_API_VERSION);
-end;
-
-procedure TPythonDLL.Py_XDECREF(op: PPyObject);
-begin
-  if op <> nil then
-    Py_DECREF(op);
-end;
-
-procedure TPythonDLL.RaiseError;
-var
-  err_type, err_value: PPyObject;
-  s_type, s_value: AnsiString;
-begin
-  err_type := PySys_GetObject('last_type');
-  err_value := PySys_GetObject('last_value');
-  if Assigned(err_type) then
-  begin
-    // s_type := GetTypeAsString(err_type);
-    // s_type := PyObjectAsString(err_type);
-    s_type := PyObjectAsString(err_type);
-    s_value := PyObjectAsString(err_value);
-    raise EPythonError.CreateFmt('Python raised error %s with %s', [s_type, s_value]);
-  end;
-end;
-
-procedure TPythonDLL.CheckError;
-begin
-  PyErr_Print;
-  RaiseError;
-end;
-
-function TPythonDLL.ReturnNone: PPyObject;
-begin
-  Result := Py_None;
-  Py_INCREF(Result);
-end;
-
-function TPythonDLL.PyInt_Check(obj: PPyObject): Boolean;
-begin
-  Result := PyObject_TypeCheck(obj, PyInt_Type);
-end;
-
-function TPythonDLL.PyObjectAsString(obj: PPyObject): AnsiString;
-var
-  s: PPyObject;
-  w: WideString;
-begin
-  Result := '';
-  if not Assigned(obj) then
-    Exit;
-
-  if PyUnicode_Check(obj) then
-  begin
-    w := 'xxx'; // PyUnicode_AsWideString(obj);
-    raise Exception.Create('anasinin unoicodeu');
-    Result := w;
-    Exit;
-  end;
-
-  s := PyObject_Str(obj);
-  if Assigned(s) and PyString_Check(s) then
-  begin
-    // Result := PyString_AsDelphiString(s);
-    Result := PyString_AsString(s);
-  end;
-  Py_XDECREF(s);
-end;
-
-function TPythonDLL.GetMainModule: PPyObject;
-begin
-  Result := PyImport_AddModule(PAnsiChar('__main__'));
-end;
-
-{ -------------------------------------------------------------------------------------------------------------------- }
-{ TLitePython }
-
-constructor TLitePython.Create;
-begin
-  inherited;
-  fPythonType_DelphiType_Map := TDictionary<PPyTypeObject, TClass>.Create;
-end;
-
-destructor TLitePython.Destroy;
-begin
-  FreeAndNil(fPythonType_DelphiType_Map);
-  inherited;
-end;
-
-var 
-  gKeepStrings: array of AnsiString; // will leak
-
-{ Convert the given Unicode value S to ANSI and increase the ref. count so that returned pointer stays valid }
-class function TLitePython.ConvertToPAnsiChar(const S: string): PAnsiChar;
-var temp: AnsiString;
-begin
-  SetLength(gKeepStrings, Length(gKeepStrings) + 1);
-  temp := Utf8ToAnsi(UTF8Encode(S));
-  gKeepStrings[High(gKeepStrings)] := temp; // keeps the resulting pointer valid by incresing the ref. count of temp.
-  Result := PAnsiChar(temp);
-end;
-
-  //xxx
-  function CleanString(const s : AnsiString) : AnsiString;
-  var
-    i : Integer;
-  begin
-    result := s;
-    if s = '' then
-      Exit;
-    i := Pos(#13,s);
-    while i > 0 do
-      begin
-        Delete( result, i, 1 );
-        i := Pos(#13,result);
-      end;
-    if result[length(result)] <> #10 then
-      Insert(#10, result, length(result)+1 );
-  end;
-
-procedure TLitePython.Exec(const Code: string);
-var
-  ansiCode: AnsiString;
-  pyobj: PPyObject;
-  m, _locals, _globals: PPyObject;
-begin
-  m := GetMainModule;
-  if m = nil then
-    raise EPythonError.Create('Exec: can''t create __main__');
-  _locals := PyModule_GetDict(m);
-  _globals := PyModule_GetDict(m);
-
-  ansiCode := Utf8ToAnsi(UTF8Encode(Code));
-  ansiCode := CleanString(ansiCode);
-
-  pyobj := PyRun_String(PAnsiChar(ansiCode), file_input, _globals, _locals);
-  if pyobj = nil then
-    CheckError;
-  Py_XDECREF(pyobj);
-end;
-
-function TLitePython.Eval(const Code: string): PPyObject;
-var
-  ansiCode: AnsiString;
-  m, _locals, _globals: PPyObject;
-begin
-  m := GetMainModule;
-  if m = nil then
-    raise EPythonError.Create('Exec: can''t create __main__');
-  _locals := PyModule_GetDict(m);
-  _globals := PyModule_GetDict(m);
-
-  ansiCode := Utf8ToAnsi(UTF8Encode(Code));
-  ansiCode := CleanString(ansiCode);
-
-  Result := PyRun_String(PAnsiChar(ansiCode), eval_input, _globals, _locals);
-  if Result = nil then
-    CheckError;
-  //Py_XDECREF(Result);
-end;
-
-function TLitePython.EvalStr(const Code: string): string;
-begin
-  Result := PyObjectAsString(Eval(Code));
-end;
-
-{ -------------------------------------------------------------------------------------------------------------------- }
-{ Introducing a new type from native code.
-  See http://docs.python.org/extending/newtypes.html }
-
-type
-  { Don't use Delphi managed types like string in this struct. Because the allocation is done by Python.}
-  PPyObjectPuppet = ^TPyObjectPuppet;
-  TPyObjectPuppet = packed record // this is the actual structure that gets created by python
-    ob_refcnt: integer;
-    ob_type: PPyTypeObject;
-
-    actual_obj: TObject; // and this is a link to the Delphi object under covers.
-    method_name: PAnsiChar; // for callable types, link to the Delphi method to call..
-    //LMethodName: string;
-  end;
-
-  procedure puppet_dealloc(self: PPyObject); cdecl;
-  begin
-    self.ob_type.tp_free(self);
-  end;
-
-  function puppet_new(subtype: PPyTypeObject; args, kwds: PPyObject): PPyObject; cdecl;
-  var
-    LContext: TRttiContext;
-    LCons: TRTTIMethod;
-    aClass: TClass;
-  begin
-    Result := subtype.tp_alloc(subtype, 0);
-    if Result <> nil then
-    begin
-      // right place to call the delphi constructor
-      LContext := TRttiContext.Create;
-      aClass := python.fPythonType_DelphiType_Map[subtype];
-      LCons := LContext.GetType(aClass).AsInstance.GetMethod('Create'); // todo: only Create method supported for now
-      PPyObjectPuppet(Result).actual_obj := LCons.Invoke(aClass, []).AsObject;
-    end;
-  end;
-
-  function puppet_get(ob1: PPyObject; name: PAnsiChar): PPyObject; cdecl;
-  var 
-    LMethod: TRttiMethod;
-    LProp: TRttiProperty;
-    LField: TRttiField;
-    actual_obj: TObject;
-  begin
-    actual_obj := PPyObjectPuppet(ob1).actual_obj;
-
-    { first, lookup the methods }
-    LMethod := TRttiContext.Create.GetType(actual_obj.ClassInfo).GetMethod(name);
-    if LMethod <> nil then
-      EXIT(python.WrapMethodCall(actual_obj, LMethod.Name));
-
-    { lookup the properties }
-    LProp := TRttiContext.Create.GetType(actual_obj.ClassInfo).AsInstance.GetProperty(name);
-    if LProp <> nil then
-      EXIT(python.WrapProperty(actual_obj, LProp.Name));
-
-    { Lookup fields }
-    LField := TRttiContext.Create.GetType(actual_obj.ClassInfo).AsInstance.GetField(name);
-    if LField <> nil then
-      EXIT(python.WrapValue(LField.GetValue(actual_obj)));
-
-    { xxx lookup the fiels }
-    raise Exception.Create('xxx');
-
-    Result := nil;
-  end;
-
-  function ValueFromPyobject(pyobj: PPyObject): TValue; forward;
-
-  procedure TLitePython.xxx(Sender: TObject);
-  begin
-    showmessage('TLitePython.xxx');
-  end;
-
-  procedure TLitePython.generic_event;
-  begin
-    showmessage('TLitePython.generic_event');
-  end;
-
-  type
-
-    tgenericevent = procedure()of object;
-
-    TMethodHandler = class(TInterfacedObject, IMethodHandler)
-    public
-      function Execute(const Args: array of Variant): Variant;
-      function InstanceToVariant(Instance: TObject): Variant;
-    end;
-
-    function TMethodHandler.Execute(const Args: array of Variant): Variant;
-    begin
-      showmessage('TMethodHandler.Execute');
-    end;
-
-    function TMethodHandler.InstanceToVariant(Instance: TObject): Variant;
-    begin
-      showmessage('TMethodHandler.InstanceToVariant');
-    end;
-
-  var methodhandler: TMethodHandler;
-
-  procedure SetEventFromPython(actual_obj: TObject; LProp: TRttiProperty; pyfunc: PPyObject);
-  var
-    v: TValue;
-    typdata: PTypeData;
-    pp: PPropInfo;
-
-    m: TMethod;
-  begin
-    showmessage('aha event ' + LProp.Name + ' aha python fonk ' + python.PyObjectAsString(python.PyObject_Repr(pyfunc)));
-    //v := TValue.From<tgenericevent>(python.generic_event);
-    //LProp.SetValue(actual_obj, v);
-
-    New(typdata);
-    pp := GetPropInfo(actual_obj, LProp.Name, [tkMethod]);
-    typdata := GetTypeData(pp.PropType^); //GetTypeData(LProp.Handle);
-    ShowMEssage(inttostr(typdata.ParamCount));
-    //typdata.MethodKind := mkProcedure;
-    //typdata.ParamCount := 0;
-    methodhandler := TMethodHandler.Create;
-    m := objauto.CreateMethodPointer(methodhandler, typdata); // xxx refcount problem
-
-    //v := TValue.From<TMethod>(m);
-    //LProp.SetValue(actual_obj, v);
-
-    SetMethodProp(actual_obj, LProp.Name, m);
-  end;
-
-{
-  from http://blogs.embarcadero.com/abauer?s=fclickmethod
-
-  PropInfo := GetPropInfo(CheckBox1, �OnClick�, [tkMethod]);
-  FClickMethod := CreateMethodPointer(Disp, Id, PropInfo.PropType^);
-  SetMethodProp(CheckBox1, �OnClick�, FClickMethod);
-}
-
-  function puppet_set(ob1: PPyObject; name: PAnsiChar; ob2: PPyObject): integer; cdecl;
-  var
-    actual_obj: TObject;
-    LProp: TRttiProperty;
-  begin
-    actual_obj := PPyObjectPuppet(ob1).actual_obj;
-
-    { lookup the properties }
-    LProp := TRttiContext.Create.GetType(actual_obj.ClassInfo).AsInstance.GetProperty(name);
-    if LProp <> nil then
-    begin
-
-      { SPECIAL CASE - settings an event handler from Python }
-      if LProp.PropertyType is TRttiMethodType then
-      begin
-        SetEventFromPython(actual_obj, LProp, ob2);
-        EXIT(0);
-      end;
-
-      LProp.SetValue(actual_obj, ValueFromPyobject(ob2));
-    end;
-
-    result := 0; // or return -1 on failure
-  end;
-
-  function puppet_call(self, args, kwds : PPyObject): PPyObject; cdecl;
-  var
-    LMethod: TRttiMethod;
-    LReturn: TValue;
-    dargs: array of TValue;
-  begin
-    with PPyObjectPuppet(self)^ do
-    begin
-      LMethod := TRttiContext.Create.GetType(actual_obj.ClassInfo).GetMethod(method_name);
-
-      { contruct a method call.. }
-      LReturn := LMethod.Invoke(actual_obj, dargs);
-      Result := python.WrapValue(LReturn);
-    end;
-  end;
-
-  function CreatePythonType(aClass: TClass): PPyTypeObject;
-  var
-    typ: PPyTypeObject;
-    typName: ansistring;
-  begin
-    // todo: need a registry
-      typName := python.ConvertToPAnsiChar(aClass.ClassName); // xxx olmuyo lan!
-      New(typ);
-      FillChar(typ^, sizeof(PyTypeObject), 0);
-      with typ^ do
-      begin
-        tp_name := PAnsiChar(typName); // For printing
-        tp_basicsize := sizeof(TPyObjectPuppet);
-        tp_flags := Py_TPFLAGS_DEFAULT;
-        tp_doc := '';
-        tp_dealloc := @puppet_dealloc;
-        tp_new := @puppet_new;
-        tp_getattr := @puppet_get;
-        tp_setattr := @puppet_set;
-        if python.PyType_Ready(typ) < 0 then
-          raise EPythonError.Create('Type cannot be PyType_Ready''d properly!');
-        python.Py_INCREF(PPyObject(typ));
-        python.PyModule_AddObject(python.fModule, PAnsiChar(typName), PPyObject(typ));
-      end;
-      Result := typ;
-
-      { Obtain the RTTI context }
-      python.fPythonType_DelphiType_Map.Add(typ, aClass);
-  end;
-
-  function CreatePythonObject(anActualObject: TObject): PPyObject;
-  var
-    typ: PPyTypeObject;
-  begin
-    // xxx
-    // first create a type object for the class of DelphiEntity. xxx todo: cache types!
-    typ := CreatePythonType(anActualObject.ClassType); // her tip icin ayri python tipi yaratmak gereksiz
-
-    // now create a python object from that type
-    Result := python._PyObject_New(typ);
-    PPyObjectPuppet(Result).actual_obj := anActualObject;
-    python.Py_INCREF(Result);
-  end;
-
-  function CreateCallablePythonType: PPyTypeObject;
-  var
-    typ: PPyTypeObject;
-    typName: ansistring;
-  begin
-    // todo: need a registry
-      typName := 'lhjasdhkjf'; //xxx python.ConvertToPAnsiChar(LMethod.Name); // xxx olmuyo lan!
-      New(typ);
-      FillChar(typ^, sizeof(PyTypeObject), 0);
-      with typ^ do
-      begin
-        tp_name := PAnsiChar('Delphi method call ' + typName); // For printing
-        tp_basicsize := sizeof(TPyObjectPuppet);
-        tp_flags := Py_TPFLAGS_DEFAULT;
-        tp_doc := '';
-        //tp_dealloc := @puppet_dealloc;
-        tp_new := @python.PyType_GenericNew;
-        //tp_getattr := @puppet_get;
-        //tp_setattr := @puppet_set;
-        tp_call := @puppet_call;
-        if python.PyType_Ready(typ) < 0 then
-          raise EPythonError.Create('Type cannot be PyType_Ready''d properly!');
-        python.Py_INCREF(PPyObject(typ));
-      end;
-      Result := typ;
-  end;
-
-// xxx function ValueToPyobject(Value: TValue): PPyObject;
-//  begin
-//  end;
-
-  function ValueFromPyobject(pyobj: PPyObject): TValue;
-  begin
-    if python.PyString_Check(pyobj) then
-      Result := python.PyString_AsString(pyobj)
-    else
-    if python.PyInt_Check(pyobj) then
-      Result := python.PyInt_AsLong(pyobj)
-    else
-    begin
-      raise Exception.Create('ValueFromPyobject doesn''t know how to handle ' +
-        python.PyObjectAsString(python.PyObject_Repr(pyobj)));
-    end;
-  end;
-
-procedure TLitePython.Wrap(aClass: TClass);
-begin
-  CreatePythonType(aClass);
-end;
-
-function TLitePython.WrapMethodCall(AnActualObj: TObject; LMethod: string): PPyObject;
-begin
-  // todo: need a registry
-  // create a facade call object
-  Result := _PyObject_New(CreateCallablePythonType);
-  PPyObjectPuppet(Result).actual_obj := AnActualObj;
-  PPyObjectPuppet(Result).method_name := ConvertToPAnsiChar(LMethod);
-  Py_INCREF(Result);
-end;
-
-function TLitePython.WrapProperty(AnActualObj: TObject; LProp: string): PPyObject;
-var
-  LLProp: TRttiProperty;
-  v: TValue;
-begin
-  LLProp := TRttiContext.Create.GetType(AnActualObj.ClassInfo).GetProperty(LProp);
-  v := LLProp.GetValue(AnActualObj);
-  if v.IsEmpty then
-    Result := Py_None
-  else
-    Result := PyString_FromString(ConvertToPAnsiChar(v.ToString));
-  Py_INCREF(Result);
-end;
-
-function TLitePython.WrapValue(AValue: TValue): PPyObject;
-begin
-  Result := nil;
-  case AValue.Kind of
-    tkUnknown: ;
-    tkInteger: ;
-    tkChar: ;
-    tkEnumeration: ;
-    tkFloat: ;
-    tkString: Result := PyString_FromString(ConvertToPAnsiChar(AValue.AsString));
-    tkSet: ;
-    tkClass: Result := CreatePythonObject(AValue.AsObject);
-    tkMethod: ;
-    tkWChar: ;
-    tkLString: ;
-    tkWString: ;
-    tkVariant: ;
-    tkArray: ;
-    tkRecord: ;
-    tkInterface: ;
-    tkInt64: ;
-    tkDynArray: ;
-    tkUString: ;
-    tkClassRef: ;
-    tkPointer: ;
-    tkProcedure: ;
-  end;
-
-  if Result <> nil then
-    Py_INCREF(Result)
-  else
-    raise Exception.Create('xxx');
-end;
-
-procedure TLitePython.CreateModule(aModuleName: ansistring);
-
-  function MethodDefs(Count: integer): PPyMethodDef; //xxx
-    begin
-      GetMem(Result, Count * sizeof(PyMethodDef));
-      FillChar(Result^, Count * sizeof(PyMethodDef), 0);
-    end;
-
-begin
-  fModule := Py_InitModule(PAnsiChar(aModuleName), MethodDefs(999));
-  if fModule = nil then
-    Raise EPythonError.Create('Error initing module ' + aModuleName);
-end;
-
-procedure TLitePython.DeclareGlobal(const NameInPython: string; DelphiEntity: TObject);
-var
-  Result: PPyObjectPuppet;
-  typ: PPyTypeObject;
-begin
-  // xxx
-  // first create a type object for the class of DelphiEntity. xxx todo: cache types!
-  typ := CreatePythonType(DelphiEntity.ClassType);
-
-  // now create a python object from that type
-  Result := PPyObjectPuppet( _PyObject_New(typ) );
-  PPyObjectPuppet(Result).actual_obj := DelphiEntity;
-  PyModule_AddObject(GetMainModule {xxx python.fModule}, ConvertToPAnsiChar(NameInPython), PPyObject(Result));
-  Py_INCREF(PPyObject(Result));
-end;
-
-initialization
-  python := TLitePython.Create;
-finalization
-  python.Free;
-end.

File delPython.pas

View file
+{ delPython: A library for interfacing existing Delphi functionality to Python.
+
+  Requirements:
+    - Delphi 2010 or later. Older versions are not supported (LitePython uses the latest RTTI
+      tricks from Delphi 2010).
+    - Python 2.6 - 2.7. Older versions and 3.x are not supported.
+
+  Contributors:
+    - M.Utku Karatas - 2009.
+
+  * Some portions of code from PythonForDelphi package (xxx).
+}
+
+unit delPython;
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Collections, Rtti;
+
+{ -------------------------------------------------------------------------------------------------------------------- }
+{ C API wrappers }
+
+const
+  single_input = 256;
+  file_input = 257;
+  eval_input = 258;
+  PYTHON_API_VERSION = 1013;
+
+  METH_VARARGS = $1;
+
+  { for tp_flags }
+  Py_TPFLAGS_HAVE_GETCHARBUFFER = (1 shl 0);
+  Py_TPFLAGS_HAVE_SEQUENCE_IN = (1 shl 1);
+  Py_TPFLAGS_GC = (1 shl 2);
+  Py_TPFLAGS_HAVE_INPLACEOPS = (1 shl 3);
+  Py_TPFLAGS_CHECKTYPES = (1 shl 4);
+  Py_TPFLAGS_HAVE_RICHCOMPARE = (1 shl 5);
+  Py_TPFLAGS_HAVE_WEAKREFS = (1 shl 6);
+  Py_TPFLAGS_HAVE_ITER = (1 shl 7);
+  Py_TPFLAGS_HAVE_CLASS = (1 shl 8);
+  Py_TPFLAGS_HEAPTYPE = (1 shl 9);
+  Py_TPFLAGS_BASETYPE = (1 shl 10);
+  Py_TPFLAGS_READY = (1 shl 12);
+  Py_TPFLAGS_READYING = (1 shl 13);
+  Py_TPFLAGS_HAVE_GC = (1 shl 14);
+  Py_TPFLAGS_DEFAULT = Py_TPFLAGS_HAVE_GETCHARBUFFER or
+                       Py_TPFLAGS_HAVE_SEQUENCE_IN or
+                       Py_TPFLAGS_HAVE_INPLACEOPS or
+                       Py_TPFLAGS_HAVE_RICHCOMPARE or
+                       Py_TPFLAGS_HAVE_WEAKREFS or
+                       Py_TPFLAGS_HAVE_ITER or
+                       Py_TPFLAGS_HAVE_CLASS;
+
+type
+  unused_python_pointer_type = pointer; // some types are just not needed to be even declared.
+  PPyObject = ^PyObject;
+  PPyTypeObject = ^PyTypeObject;
+  pydestructor = procedure(ob: PPyObject); cdecl;
+  printfunc = function(ob: PPyObject; var f: file; i: integer): integer; cdecl;
+  getattrfunc = function(ob1: PPyObject; name: PAnsiChar): PPyObject; cdecl;
+  setattrfunc = function(ob1: PPyObject; name: PAnsiChar; ob2: PPyObject): integer; cdecl;
+  cmpfunc = function(ob1, ob2: PPyObject): integer; cdecl;
+  reprfunc = function(ob: PPyObject): PPyObject; cdecl;
+  PyCFunction = function(self, args: PPyObject): PPyObject; cdecl;
+  newfunc = function(subtype: PPyTypeObject; args, kwds: PPyObject): PPyObject; cdecl;
+  allocfunc = function(self: PPyTypeObject; nitems: integer): PPyObject; cdecl;
+  ternaryfunc = function(self, args, kwds : PPyObject): PPyObject; cdecl;
+
+  PPyMethodDef = ^PyMethodDef;
+  PyMethodDef = packed record
+    ml_name: PAnsiChar;
+    ml_meth: PyCFunction;
+    ml_flags: integer;
+    ml_doc: PAnsiChar;
+  end;
+  
+  PyTypeObject = packed record
+    ob_refcnt: integer;
+    ob_type: PPyTypeObject;
+    ob_size: integer; // Number of items in variable part
+    tp_name: PAnsiChar; // For printing
+    tp_basicsize, tp_itemsize: integer; // For allocation
+
+    // Methods to implement standard operations
+    tp_dealloc: pydestructor;
+    tp_print: printfunc;
+    tp_getattr: getattrfunc;
+    tp_setattr: setattrfunc;
+    tp_compare: cmpfunc;
+    tp_repr: reprfunc;
+
+    // Method suites for standard classes
+    tp_as_number: unused_python_pointer_type; // PPyNumberMethods;
+    tp_as_sequence: unused_python_pointer_type; // PPySequenceMethods;
+    tp_as_mapping: unused_python_pointer_type; // PPyMappingMethods;
+
+    // More standard operations (here for binary compatibility)
+    tp_hash: unused_python_pointer_type; // hashfunc;
+    tp_call: ternaryfunc;
+    tp_str: unused_python_pointer_type; // reprfunc;
+    tp_getattro: unused_python_pointer_type; // getattrofunc;
+    tp_setattro: unused_python_pointer_type; // setattrofunc;
+
+    // Functions to access object as input/output buffer
+    tp_as_buffer: unused_python_pointer_type; // PPyBufferProcs;
+
+    // Flags to define presence of optional/expanded features
+    tp_flags: LongInt;
+
+    tp_doc: PAnsiChar; // Documentation AnsiString
+    tp_traverse: unused_python_pointer_type; // traverseproc;
+    tp_clear: unused_python_pointer_type; // inquiry;
+    tp_richcompare: unused_python_pointer_type; // richcmpfunc;
+    tp_weaklistoffset: Longint;
+    tp_iter: unused_python_pointer_type; // getiterfunc;
+    tp_iternext: unused_python_pointer_type; // iternextfunc;
+
+    // Attribute descriptor and subclassing stuff
+    tp_methods          : unused_python_pointer_type; //PPyMethodDef;
+    tp_members          : unused_python_pointer_type; // PPyMemberDef;
+    tp_getset           : unused_python_pointer_type; // PPyGetSetDef;
+    
+    tp_base             : unused_python_pointer_type; // PPyTypeObject;
+    tp_dict             : unused_python_pointer_type; // PPyObject;
+    tp_descr_get        : unused_python_pointer_type; // descrgetfunc;
+    tp_descr_set        : unused_python_pointer_type; // descrsetfunc;
+    tp_dictoffset       : longint;
+    tp_init             : unused_python_pointer_type; // initproc;
+    tp_alloc            : allocfunc;
+    tp_new              : newfunc;
+    tp_free             : pydestructor; // Low-level free-memory routine
+    tp_is_gc            : unused_python_pointer_type; // inquiry; // For PyObject_IS_GC
+    tp_bases            : unused_python_pointer_type; // PPyObject;
+    tp_mro              : unused_python_pointer_type; // PPyObject; // method resolution order
+    tp_cache            : unused_python_pointer_type; // PPyObject;
+    tp_subclasses       : unused_python_pointer_type; // PPyObject;
+    tp_weaklist         : unused_python_pointer_type; // PPyObject;
+    tp_del              : unused_python_pointer_type; // pydestructor;
+
+    // xxx rest ripped... object.h
+  end;
+
+  PyObject = packed record
+    ob_refcnt: integer;
+    ob_type: PPyTypeObject;
+  end;
+
+{ -------------------------------------------------------------------------------------------------------------------- }
+
+type
+  EPythonError = class(Exception);
+  EDllImportError = class(Exception);
+
+  TValueArray = TArray<TValue>;
+
+  TPythonDLL = class
+  public
+    { Wrapping actual Python API functions }
+    Py_Initialize: procedure; cdecl;
+    PyEval_InitThreads: procedure; cdecl;
+    Py_InitModule4: function(name: PAnsiChar; methods: PPyMethodDef; doc: PAnsiChar;
+      self_: PPyObject; apiver: integer): PPyObject; cdecl;
+    PyRun_String: function(str: PAnsiChar; start: integer; globals: PPyObject; locals: PPyObject): PPyObject; cdecl;
+    PyErr_Print: procedure; cdecl;
+    PySys_GetObject: function(s: PAnsiChar): PPyObject; cdecl;
+    PyObject_Str: function(v: PPyObject): PPyObject; cdecl;
+    PyObject_Repr: function(ob: PPyObject): PPyObject; cdecl;
+    PyString_AsString: function(ob: PPyObject): PAnsiChar; cdecl;
+    PyType_IsSubtype: function(a, b: PPyTypeObject): integer; cdecl;
+    PyImport_AddModule: function(name: PAnsiChar): PPyObject; cdecl;
+    PyModule_GetDict: function(module: PPyObject): PPyObject; cdecl;
+    PyType_GenericNew: function(atype: PPyTypeObject; args, kwds: PPyObject): PPyObject; cdecl;
+    PyType_Ready: function(atype: PPyTypeObject): integer; cdecl;
+    PyModule_AddObject: function(amodule: PPyObject; aname: PAnsiChar; value: PPyObject): PPyObject; cdecl;
+    _PyObject_New: function(typ: PPyTypeObject): PPyObject; cdecl;
+    PyString_FromString: function(str: PAnsiChar): PPyObject; cdecl;
+    PyInt_AsLong: function(ob: PPyObject): LONGINT; cdecl;
+    PyTuple_Size: function(ob: PPyObject): integer; cdecl;
+    PyTuple_GetItem: function(ob: PPyObject; i: integer): PPyObject; cdecl;
+    PyUnicode_AsWideChar: function(unicode: PPyObject; w: PWideChar; size: integer): integer; cdecl;
+    PySequence_Length: function(ob: PPyObject): integer; cdecl;
+    PyInt_FromLong: function(x: LongInt): PPyObject; cdecl;
+    PyString_Type: PPyTypeObject;
+    PyUnicode_Type: PPyTypeObject;
+    PyInt_Type: PPyTypeObject;
+    PyTuple_Type: PPyTypeObject;
+    Py_None: PPyObject;
+  private
+    { Helper methods }
+    fDLLHandle: THandle;
+    procedure Py_INCREF(op: PPyObject);
+    procedure Py_XDECREF(op: PPyObject);
+    procedure Py_DECREF(op: PPyObject);
+    function Py_InitModule(const name: PAnsiChar; methods: PPyMethodDef): PPyObject;
+    function PyString_Check(obj: PPyObject): Boolean;
+    function PyUnicode_Check(obj: PPyObject): Boolean;
+    function PyObject_TypeCheck(obj: PPyObject; t: PPyTypeObject): Boolean;
+    function PyInt_Check(obj: PPyObject): Boolean;
+    function PyTuple_Check(obj: PPyObject): boolean;
+    function ReturnNone: PPyObject;
+    function GetMainModule: PPyObject;
+    function PyObjectAsString(obj: PPyObject): AnsiString;
+    function PyTupleToTValueArray(tuple: PPyObject): TValueArray;
+    function PyObjectToTValue(obj: PPyObject): TValue;
+    procedure RaiseError;
+    procedure CheckError;
+  public
+    function Import(const funcname: AnsiString; canFail: Boolean = True): Pointer;
+    procedure LoadDll(const DllPath: string); // raise exc. on errors
+  end;
+
+  TLitePython = class(TPythonDLL)
+  private
+    class function ConvertToPAnsiChar(const S: string): PAnsiChar;
+    procedure generic_event;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    { high level execution }
+    procedure Exec(const Code: string);
+    function Eval(const Code: string): PPyObject;
+    function EvalStr(const Code: string): string;
+  public
+    { interfacing Delphi to Python }
+    fPythonType_DelphiType_Map: TDictionary<PPyTypeObject, TClass>;
+    fModule: PPyObject;
+    procedure CreateModule(aModuleName: AnsiString);
+
+    procedure Wrap(aClass: TClass);
+    function WrapMethodCall(anActualObj: TObject; LMethod: string): PPyObject;
+    function WrapProperty(anActualObj: TObject; LProp: string): PPyObject;
+    function WrapValue(aValue: TValue): PPyObject;
+
+    procedure DeclareGlobal(const NameInPython: string; DelphiEntity: TObject);
+  end;
+
+var
+  python: TLitePython;
+
+implementation
+
+uses
+  Windows, Dialogs, TypInfo, ObjAuto;
+
+{ -------------------------------------------------------------------------------------------------------------------- }
+{ TPythonDLL }
+
+function TPythonDLL.Import(const funcname: AnsiString; canFail: Boolean): Pointer;
+begin
+  Result := GetProcAddress(fDLLHandle, PAnsiChar(funcname));
+  if (Result = nil) and canFail then
+    raise EDllImportError.CreateFmt('Error %d: could not map symbol "%s"', [GetLastError, funcname]);
+end;
+
+procedure TPythonDLL.LoadDll(const DllPath: string);
+begin
+  fDLLHandle := SafeLoadLibrary(DllPath);
+  if fDLLHandle = 0 then
+    raise EDllImportError.Create('Couldn''t load DLL ' + DllPath);
+
+  @PyRun_String := Import('PyRun_String');
+  @Py_Initialize := Import('Py_Initialize');
+  @PyEval_InitThreads := Import('PyEval_InitThreads');
+  @Py_InitModule4 := Import('Py_InitModule4');
+  @PyErr_Print := Import('PyErr_Print');
+  @PySys_GetObject := Import('PySys_GetObject');
+  @PyObject_Str := Import('PyObject_Str');
+  @PyObject_Repr := Import('PyObject_Repr');
+  @PyString_AsString := Import('PyString_AsString');
+  @PyType_IsSubtype := Import('PyType_IsSubtype');
+  @PyImport_AddModule := Import('PyImport_AddModule');
+  @PyModule_GetDict := Import('PyModule_GetDict');
+  @PyType_GenericNew :=Import('PyType_GenericNew');
+  @PyType_Ready :=Import('PyType_Ready');
+  @PyModule_AddObject := Import('PyModule_AddObject');
+  @_PyObject_New := Import('_PyObject_New');
+  @PyString_FromString := Import('PyString_FromString');
+  @PyInt_AsLong := Import('PyInt_AsLong');
+  @PyTuple_Size := Import('PyTuple_Size');
+  @PyTuple_GetItem := Import('PyTuple_GetItem');
+  @PySequence_Length := Import('PySequence_Length');
+  @PyUnicode_AsWideChar := Import('PyUnicodeUCS2_AsWideChar');
+  @PyInt_FromLong := Import('PyInt_FromLong');
+
+  Py_None := Import('_Py_NoneStruct');
+  PyString_Type := Import('PyString_Type');
+  PyUnicode_Type := Import('PyUnicode_Type');
+  PyInt_Type := Import('PyInt_Type');
+  PyTuple_Type := Import('PyTuple_Type');
+
+  Py_Initialize;
+  PyEval_InitThreads;
+end;
+
+function TPythonDLL.PyObject_TypeCheck(obj: PPyObject; t: PPyTypeObject): Boolean;
+begin
+  Result := Assigned(obj) and (obj^.ob_type = t);
+  if not Result and Assigned(obj) and Assigned(t) then
+    Result := PyType_IsSubtype(obj^.ob_type, t) = 1;
+end;
+
+function TPythonDLL.PyString_Check(obj: PPyObject): Boolean;
+begin
+  Result := PyObject_TypeCheck(obj, PyString_Type);
+  if not Result then
+    Result := PyObject_TypeCheck(obj, PyUnicode_Type);
+end;
+
+function TPythonDLL.PyTupleToTValueArray(tuple: PPyObject): TValueArray;
+var
+  i: integer;
+begin
+  if not PyTuple_Check(tuple) then
+    raise EPythonError.Create('The python object is not a tuple');
+  SetLength(Result, PyTuple_Size(tuple));
+  for i := 0 to Length(Result) - 1 do
+    Result[i] := PyObjectToTValue(PyTuple_GetItem(tuple, i));
+end;
+
+function TPythonDLL.PyObjectToTValue(obj: PPyObject): TValue;
+begin
+  if PyInt_Check(obj) then
+    Result := PyInt_AsLong(obj)
+//  else if PyUnicode_Check(obj) then
+//    Result := PyUnicode_AsWideString(obj)
+  else if PyString_Check(obj) then
+    Result := PyObjectAsString(obj)
+  else
+    raise Exception.Create('xxx unsupported type');
+end;
+
+function TPythonDLL.PyTuple_Check(obj: PPyObject): boolean;
+begin
+  Result := PyObject_TypeCheck(obj, PyTuple_Type);
+end;
+
+function TPythonDLL.PyUnicode_Check(obj: PPyObject): Boolean;
+begin
+  Result := PyObject_TypeCheck(obj, PyUnicode_Type);
+end;
+
+procedure TPythonDLL.Py_DECREF(op: PPyObject);
+begin
+  with op^ do
+  begin
+    Dec(ob_refcnt);
+    if ob_refcnt = 0 then
+    begin
+      ob_type^.tp_dealloc(op);
+    end;
+  end;
+end;
+
+procedure TPythonDLL.Py_INCREF(op: PPyObject);
+begin
+  Inc(op^.ob_refcnt);
+end;
+
+function TPythonDLL.Py_InitModule(const name: PAnsiChar; methods: PPyMethodDef): PPyObject;
+begin
+  Result := Py_InitModule4(name, methods, nil, nil, PYTHON_API_VERSION);
+end;
+
+procedure TPythonDLL.Py_XDECREF(op: PPyObject);
+begin
+  if op <> nil then
+    Py_DECREF(op);
+end;
+
+procedure TPythonDLL.RaiseError;
+var
+  err_type, err_value: PPyObject;
+  s_type, s_value: AnsiString;
+begin
+  err_type := PySys_GetObject('last_type');
+  err_value := PySys_GetObject('last_value');
+  if Assigned(err_type) then
+  begin
+    // s_type := GetTypeAsString(err_type);
+    // s_type := PyObjectAsString(err_type);
+    s_type := PyObjectAsString(err_type);
+    s_value := PyObjectAsString(err_value);
+    raise EPythonError.CreateFmt('Python raised error %s with %s', [s_type, s_value]);
+  end;
+end;
+
+procedure TPythonDLL.CheckError;
+begin
+  PyErr_Print;
+  RaiseError;
+end;
+
+function TPythonDLL.ReturnNone: PPyObject;
+begin
+  Result := Py_None;
+  Py_INCREF(Result);
+end;
+
+function TPythonDLL.PyInt_Check(obj: PPyObject): Boolean;
+begin
+  Result := PyObject_TypeCheck(obj, PyInt_Type);
+end;
+
+// todo: horrible implementation
+function TPythonDLL.PyObjectAsString(obj: PPyObject): AnsiString;
+var
+  s: PPyObject;
+  u: string;
+  _size: integer;
+begin
+  Result := '';
+  if not Assigned(obj) then
+    Exit;
+
+  if PyUnicode_Check(obj) then
+  begin
+    _size := PySequence_Length(obj);
+    SetLength(Result, _size);
+    if PyUnicode_AsWideChar(obj, @Result[1], _size) <> _size then
+      raise EPythonError.Create('Could not copy the whole Unicode AnsiString into its buffer');
+    u := Result;
+    Exit(u);
+  end;
+
+  //xxx gereksiz asagisi?
+  s := PyObject_Str(obj);
+  if Assigned(s) and PyString_Check(s) then
+  begin
+    Result := PyString_AsString(s);
+  end;
+  Py_XDECREF(s);
+end;
+
+function TPythonDLL.GetMainModule: PPyObject;
+begin
+  Result := PyImport_AddModule(PAnsiChar('__main__'));
+end;
+
+{ -------------------------------------------------------------------------------------------------------------------- }
+{ TLitePython }
+
+constructor TLitePython.Create;
+begin
+  inherited;
+  fPythonType_DelphiType_Map := TDictionary<PPyTypeObject, TClass>.Create;
+end;
+
+destructor TLitePython.Destroy;
+begin
+  FreeAndNil(fPythonType_DelphiType_Map);
+  inherited;
+end;
+
+var 
+  gKeepStrings: array of AnsiString; // will leak
+
+{ Convert the given Unicode value S to ANSI and increase the ref. count so that returned pointer stays valid }
+class function TLitePython.ConvertToPAnsiChar(const S: string): PAnsiChar;
+var temp: AnsiString;
+begin
+  SetLength(gKeepStrings, Length(gKeepStrings) + 1);
+  temp := Utf8ToAnsi(UTF8Encode(S));
+  gKeepStrings[High(gKeepStrings)] := temp; // keeps the resulting pointer valid by incresing the ref. count of temp.
+  Result := PAnsiChar(temp);
+end;
+
+  //xxx
+  function CleanString(const s : AnsiString) : AnsiString;
+  var
+    i : Integer;
+  begin
+    result := s;
+    if s = '' then
+      Exit;
+    i := Pos(#13,s);
+    while i > 0 do
+      begin
+        Delete( result, i, 1 );
+        i := Pos(#13,result);
+      end;
+    if result[length(result)] <> #10 then
+      Insert(#10, result, length(result)+1 );
+  end;
+
+procedure TLitePython.Exec(const Code: string);
+var
+  ansiCode: AnsiString;
+  pyobj: PPyObject;
+  m, _locals, _globals: PPyObject;
+begin
+  m := GetMainModule;
+  if m = nil then
+    raise EPythonError.Create('Exec: can''t create __main__');
+  _locals := PyModule_GetDict(m);
+  _globals := PyModule_GetDict(m);
+
+  ansiCode := Utf8ToAnsi(UTF8Encode(Code));
+  ansiCode := CleanString(ansiCode);
+
+  pyobj := PyRun_String(PAnsiChar(ansiCode), file_input, _globals, _locals);
+  if pyobj = nil then
+    CheckError;
+  Py_XDECREF(pyobj);
+end;
+
+function TLitePython.Eval(const Code: string): PPyObject;
+var
+  ansiCode: AnsiString;
+  m, _locals, _globals: PPyObject;
+begin
+  m := GetMainModule;
+  if m = nil then
+    raise EPythonError.Create('Exec: can''t create __main__');
+  _locals := PyModule_GetDict(m);
+  _globals := PyModule_GetDict(m);
+
+  ansiCode := Utf8ToAnsi(UTF8Encode(Code));
+  ansiCode := CleanString(ansiCode);
+
+  Result := PyRun_String(PAnsiChar(ansiCode), eval_input, _globals, _locals);
+  if Result = nil then
+    CheckError;
+  //Py_XDECREF(Result);
+end;
+
+function TLitePython.EvalStr(const Code: string): string;
+begin
+  Result := PyObjectAsString(Eval(Code));
+end;
+
+{ -------------------------------------------------------------------------------------------------------------------- }
+{ Introducing a new type from native code.
+  See http://docs.python.org/extending/newtypes.html }
+
+type
+  { Don't use Delphi managed types like string in this struct. Because the allocation is done by Python.}
+  PPyObjectPuppet = ^TPyObjectPuppet;
+  TPyObjectPuppet = packed record // this is the actual structure that gets created by python
+    ob_refcnt: integer;
+    ob_type: PPyTypeObject;
+
+    actual_obj: TObject; // and this is a link to the Delphi object under covers.
+    method_name: PAnsiChar; // for callable types, link to the Delphi method to call..
+    //LMethodName: string;
+  end;
+
+  procedure puppet_dealloc(self: PPyObject); cdecl;
+  begin
+    self.ob_type.tp_free(self);
+  end;
+
+  function puppet_new(subtype: PPyTypeObject; args, kwds: PPyObject): PPyObject; cdecl;
+  var
+    LContext: TRttiContext;
+    LCons: TRTTIMethod;
+    aClass: TClass;
+  begin
+    Result := subtype.tp_alloc(subtype, 0);
+    if Result <> nil then
+    begin
+      // right place to call the delphi constructor
+      LContext := TRttiContext.Create;
+      aClass := python.fPythonType_DelphiType_Map[subtype];
+      LCons := LContext.GetType(aClass).AsInstance.GetMethod('Create'); // todo: only Create method supported for now
+      PPyObjectPuppet(Result).actual_obj := LCons.Invoke(aClass, []).AsObject;
+    end;
+  end;
+
+  function puppet_get(ob1: PPyObject; name: PAnsiChar): PPyObject; cdecl;
+  var 
+    LMethod: TRttiMethod;
+    LProp: TRttiProperty;
+    LField: TRttiField;
+    actual_obj: TObject;
+  begin
+    actual_obj := PPyObjectPuppet(ob1).actual_obj;
+
+    { first, lookup the methods }
+    LMethod := TRttiContext.Create.GetType(actual_obj.ClassInfo).GetMethod(name);
+    if LMethod <> nil then
+      EXIT(python.WrapMethodCall(actual_obj, LMethod.Name));
+
+    { lookup the properties }
+    LProp := TRttiContext.Create.GetType(actual_obj.ClassInfo).AsInstance.GetProperty(name);
+    if LProp <> nil then
+      EXIT(python.WrapProperty(actual_obj, LProp.Name));
+
+    { Lookup fields }
+    LField := TRttiContext.Create.GetType(actual_obj.ClassInfo).AsInstance.GetField(name);
+    if LField <> nil then
+      EXIT(python.WrapValue(LField.GetValue(actual_obj)));
+
+    { xxx lookup the fiels }
+    raise Exception.Create('xxx field lookup failed ' + name);
+
+    Result := nil;
+  end;
+
+  function ValueFromPyobject(pyobj: PPyObject): TValue; forward;
+
+  procedure TLitePython.generic_event;
+  begin
+    showmessage('TLitePython.generic_event');
+  end;
+
+  type
+
+    tgenericevent = procedure()of object;
+
+    TMethodHandler = class(TInterfacedObject, IMethodHandler)
+    public
+      function Execute(const Args: array of Variant): Variant;
+      function InstanceToVariant(Instance: TObject): Variant;
+    end;
+
+    function TMethodHandler.Execute(const Args: array of Variant): Variant;
+    begin
+      showmessage('TMethodHandler.Execute');
+    end;
+
+    function TMethodHandler.InstanceToVariant(Instance: TObject): Variant;
+    begin
+      showmessage('TMethodHandler.InstanceToVariant');
+    end;
+
+  var methodhandler: TMethodHandler;
+
+  procedure SetEventFromPython(actual_obj: TObject; LProp: TRttiProperty; pyfunc: PPyObject);
+  var
+    v: TValue;
+    typdata: PTypeData;
+    pp: PPropInfo;
+
+    m: TMethod;
+  begin
+    showmessage('aha event ' + LProp.Name + ' aha python fonk ' + python.PyObjectAsString(python.PyObject_Repr(pyfunc)));
+    //v := TValue.From<tgenericevent>(python.generic_event);
+    //LProp.SetValue(actual_obj, v);
+
+    New(typdata);
+    pp := GetPropInfo(actual_obj, LProp.Name, [tkMethod]);
+    typdata := GetTypeData(pp.PropType^); //GetTypeData(LProp.Handle);
+    ShowMEssage(inttostr(typdata.ParamCount));
+    //typdata.MethodKind := mkProcedure;
+    //typdata.ParamCount := 0;
+    methodhandler := TMethodHandler.Create;
+    m := objauto.CreateMethodPointer(methodhandler, typdata); // xxx refcount problem
+
+    //v := TValue.From<TMethod>(m);
+    //LProp.SetValue(actual_obj, v);
+
+    SetMethodProp(actual_obj, LProp.Name, m);
+  end;
+
+{
+  from http://blogs.embarcadero.com/abauer?s=fclickmethod
+
+  PropInfo := GetPropInfo(CheckBox1, �OnClick�, [tkMethod]);
+  FClickMethod := CreateMethodPointer(Disp, Id, PropInfo.PropType^);
+  SetMethodProp(CheckBox1, �OnClick�, FClickMethod);
+}
+
+  function puppet_set(ob1: PPyObject; name: PAnsiChar; ob2: PPyObject): integer; cdecl;
+  var
+    actual_obj: TObject;
+    LProp: TRttiProperty;
+  begin
+    actual_obj := PPyObjectPuppet(ob1).actual_obj;
+
+    { lookup the properties }
+    LProp := TRttiContext.Create.GetType(actual_obj.ClassInfo).AsInstance.GetProperty(name);
+    if LProp <> nil then
+    begin
+
+      { SPECIAL CASE - settings an event handler from Python }
+      if LProp.PropertyType is TRttiMethodType then
+      begin
+        SetEventFromPython(actual_obj, LProp, ob2);
+        EXIT(0);
+      end;
+
+      LProp.SetValue(actual_obj, ValueFromPyobject(ob2));
+    end;
+
+    result := 0; // or return -1 on failure
+  end;
+
+  function puppet_call(self, args, kwds : PPyObject): PPyObject; cdecl;
+  var
+    LMethod: TRttiMethod;
+    LReturn: TValue;
+    LArgs: TValueArray;
+  begin
+    with PPyObjectPuppet(self)^ do
+    begin
+      LMethod := TRttiContext.Create.GetType(actual_obj.ClassInfo).GetMethod(method_name);
+
+      { contruct a method call.. }
+      LArgs := python.PyTupleToTValueArray(args);
+      LReturn := LMethod.Invoke(actual_obj, LArgs);
+      Result := python.WrapValue(LReturn);
+    end;
+  end;
+
+  function CreatePythonType(aClass: TClass): PPyTypeObject;
+  var
+    typ: PPyTypeObject;
+    typName: ansistring;
+  begin
+    // todo: need a registry
+      typName := python.ConvertToPAnsiChar(aClass.ClassName); // xxx olmuyo lan!
+      New(typ);
+      FillChar(typ^, sizeof(PyTypeObject), 0);
+      with typ^ do
+      begin
+        tp_name := PAnsiChar(typName); // For printing
+        tp_basicsize := sizeof(TPyObjectPuppet);
+        tp_flags := Py_TPFLAGS_DEFAULT;
+        tp_doc := '';
+        tp_dealloc := @puppet_dealloc;
+        tp_new := @puppet_new;
+        tp_getattr := @puppet_get;
+        tp_setattr := @puppet_set;
+        if python.PyType_Ready(typ) < 0 then
+          raise EPythonError.Create('Type cannot be PyType_Ready''d properly!');
+        python.Py_INCREF(PPyObject(typ));
+        python.PyModule_AddObject(python.fModule, PAnsiChar(typName), PPyObject(typ));
+      end;
+      Result := typ;
+
+      { Obtain the RTTI context }
+      python.fPythonType_DelphiType_Map.Add(typ, aClass);
+  end;
+
+  function CreatePythonObject(anActualObject: TObject): PPyObject;
+  var
+    typ: PPyTypeObject;
+  begin
+    // xxx
+    // first create a type object for the class of DelphiEntity. xxx todo: cache types!
+    typ := CreatePythonType(anActualObject.ClassType); // her tip icin ayri python tipi yaratmak gereksiz
+
+    // now create a python object from that type
+    Result := python._PyObject_New(typ);
+    PPyObjectPuppet(Result).actual_obj := anActualObject;
+    python.Py_INCREF(Result);
+  end;
+
+  function CreateCallablePythonType: PPyTypeObject;
+  var
+    typ: PPyTypeObject;
+    typName: ansistring;
+  begin
+    // todo: need a registry
+      typName := 'lhjasdhkjf'; //xxx python.ConvertToPAnsiChar(LMethod.Name); // xxx olmuyo lan!
+      New(typ);
+      FillChar(typ^, sizeof(PyTypeObject), 0);
+      with typ^ do
+      begin
+        tp_name := PAnsiChar('Delphi method call ' + typName); // For printing
+        tp_basicsize := sizeof(TPyObjectPuppet);
+        tp_flags := Py_TPFLAGS_DEFAULT;
+        tp_doc := '';
+        //tp_dealloc := @puppet_dealloc;
+        tp_new := @python.PyType_GenericNew;
+        //tp_getattr := @puppet_get;
+        //tp_setattr := @puppet_set;
+        tp_call := @puppet_call;
+        if python.PyType_Ready(typ) < 0 then
+          raise EPythonError.Create('Type cannot be PyType_Ready''d properly!');
+        python.Py_INCREF(PPyObject(typ));
+      end;
+      Result := typ;
+  end;
+
+// xxx function ValueToPyobject(Value: TValue): PPyObject;
+//  begin
+//  end;
+
+  function ValueFromPyobject(pyobj: PPyObject): TValue;
+  begin
+    if python.PyString_Check(pyobj) then
+      Result := python.PyString_AsString(pyobj)
+    else
+    if python.PyInt_Check(pyobj) then
+      Result := python.PyInt_AsLong(pyobj)
+    else
+    begin
+      raise Exception.Create('ValueFromPyobject doesn''t know how to handle ' +
+        python.PyObjectAsString(python.PyObject_Repr(pyobj)));
+    end;
+  end;
+
+procedure TLitePython.Wrap(aClass: TClass);
+begin
+  CreatePythonType(aClass);
+end;
+
+function TLitePython.WrapMethodCall(anActualObj: TObject; LMethod: string): PPyObject;
+begin
+  // todo: need a registry
+  // create a facade call object
+  Result := _PyObject_New(CreateCallablePythonType);
+  PPyObjectPuppet(Result).actual_obj := AnActualObj;
+  PPyObjectPuppet(Result).method_name := ConvertToPAnsiChar(LMethod);
+  Py_INCREF(Result);
+end;
+
+function TLitePython.WrapProperty(anActualObj: TObject; LProp: string): PPyObject;
+var
+  LLProp: TRttiProperty;
+  v: TValue;
+begin
+  LLProp := TRttiContext.Create.GetType(AnActualObj.ClassInfo).GetProperty(LProp);
+  v := LLProp.GetValue(AnActualObj);
+  if v.IsEmpty then
+    Result := Py_None
+  else
+    Result := PyString_FromString(ConvertToPAnsiChar(v.ToString));
+  Py_INCREF(Result);
+end;
+
+function TLitePython.WrapValue(aValue: TValue): PPyObject;
+begin
+  Result := nil;
+  case AValue.Kind of
+    tkUnknown: ;
+    tkInteger: Result := PyInt_FromLong(AValue.AsInteger);
+    tkChar: ;
+    tkEnumeration: ;
+    tkFloat: ;
+    tkString: Result := PyString_FromString(ConvertToPAnsiChar(AValue.AsString));
+    tkSet: ;
+    tkClass: Result := CreatePythonObject(AValue.AsObject);
+    tkMethod: ;
+    tkWChar: ;
+    tkLString: ;
+    tkWString: ;
+    tkVariant: ;
+    tkArray: ;
+    tkRecord: ;
+    tkInterface: ;
+    tkInt64: ;
+    tkDynArray: ;
+    tkUString: ;
+    tkClassRef: ;
+    tkPointer: ;
+    tkProcedure: ;
+  end;
+
+  if Result <> nil then
+    Py_INCREF(Result)
+  else
+    raise Exception.Create('xxx WrapValue fail');
+end;
+
+procedure TLitePython.CreateModule(aModuleName: ansistring);
+
+  function MethodDefs(Count: integer): PPyMethodDef; //xxx
+    begin
+      GetMem(Result, Count * sizeof(PyMethodDef));
+      FillChar(Result^, Count * sizeof(PyMethodDef), 0);
+    end;
+
+begin
+  fModule := Py_InitModule(PAnsiChar(aModuleName), MethodDefs(999));
+  if fModule = nil then
+    Raise EPythonError.Create('Error initing module ' + aModuleName);
+end;
+
+procedure TLitePython.DeclareGlobal(const NameInPython: string; DelphiEntity: TObject);
+var
+  Result: PPyObjectPuppet;
+  typ: PPyTypeObject;
+begin
+  // xxx
+  // first create a type object for the class of DelphiEntity. xxx todo: cache types!
+  typ := CreatePythonType(DelphiEntity.ClassType);
+
+  // now create a python object from that type
+  Result := PPyObjectPuppet( _PyObject_New(typ) );
+  PPyObjectPuppet(Result).actual_obj := DelphiEntity;
+  PyModule_AddObject(GetMainModule {xxx python.fModule}, ConvertToPAnsiChar(NameInPython), PPyObject(Result));
+  Py_INCREF(PPyObject(Result));
+end;
+
+initialization
+  python := TLitePython.Create;
+finalization
+  python.Free;
+end.

File demo/delpython_tests.pas

View file
+unit delpython_tests;
+
+interface
+
+uses
+  LitePython, Classes;
+
+procedure TestAll;
+
+var TestLog: TStrings;
+
+implementation
+
+uses
+  SysUtils;
+
+procedure AssertExpr(const Expected, PythonExpression: string);
+var actual: string;
+begin
+  try
+    actual := python.EvalStr(PythonExpression);
+    if Expected <> actual then
+      if TestLog <> nil then TestLog.Append(Format('Expected "%s" but found "%s" for %s', [Expected, actual, PythonExpression]));
+  except
+    if TestLog <> nil then
+      TestLog.Append(Format('Exception while evaluating "%s" Details: "%s"', [PythonExpression, Exception(ExceptObject).Message]));
+  end;
+end;
+
+procedure AssertRaises(const PythonExpression: string);
+begin
+  try
+    python.EvalStr(PythonExpression);
+    if TestLog <> nil then TestLog.Append(Format('FAIL: %s should have raised an exception', [PythonExpression]));
+  except
+    ;
+  end;
+end;
+
+procedure TestTStringList;
+begin
+  python.LoadDll('d:\projects\pfaide\v1.0\ide\internal_python\python26.dll');
+  python.CreateModule('vcl');
+  python.Wrap(TStringList);
+
+  { create a TStringList }
+  python.Exec('import vcl; o=vcl.TStringList()');
+  //todo: python.Exec('import vcl; o=vcl.TStringList.Create()');
+
+  { check initial property values }
+  AssertExpr('dupIgnore', 'o.Duplicates');
+  AssertExpr('False', 'o.Sorted');
+  AssertExpr('False', 'o.CaseSensitive');
+  AssertExpr('None', 'o.OnChange');
+  AssertExpr('None', 'o.OnChanging');
+  AssertExpr('False', 'o.OwnsObjects');
+  AssertExpr('0', 'o.Capacity');
+  AssertExpr('', 'o.CommaText');
+  AssertExpr('0', 'o.Count');
+  AssertExpr(',', 'o.Delimiter');
+  AssertExpr('', 'o.DelimitedText');
+  AssertExpr(#13#10, 'o.LineBreak');
+  AssertExpr('"', 'o.QuoteChar');
+  AssertExpr('=', 'o.NameValueSeparator');
+  AssertExpr('False', 'o.StrictDelimiter');
+  AssertExpr('', 'o.Text');
+  AssertExpr('None', 'o.StringsAdapter');
+
+  { test methods }
+
+  // Add
+  AssertExpr('0', 'o.Add("1")');
+  AssertExpr('1', 'o.Add("2")');
+  AssertExpr('2', 'o.Add("3")');
+  AssertExpr('3', 'o.Count');
+  AssertExpr('1', 'o.Strings[0]');
+  AssertExpr('2', 'o.Strings[1]');
+  AssertExpr('3', 'o.Strings[2]');
+  AssertExpr('1', 'o[0]');
+  AssertExpr('2', 'o[1]');
+  AssertExpr('3', 'o[2]');
+  AssertExpr('None', 'o.Objects[0]');
+  AssertExpr('None', 'o.Objects[1]');
+  AssertExpr('None', 'o.Objects[2]');
+
+  // Clear
+  AssertExpr('', 'o.Clear()');
+  AssertExpr('0', 'o.Count');
+  AssertRaises('o[0]');
+  AssertRaises('o.Strings[0]');
+  AssertRaises('o.Objects[0]');
+
+  //Delete
+  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
+  AssertExpr('', 'o.Delete(1)');
+  AssertExpr('2', 'o.Count');
+  AssertExpr('1', 'o[0]');
+  AssertExpr('3', 'o[1]');
+  AssertExpr('1', 'o.Strings[0]');
+  AssertExpr('3', 'o.Strings[1]');
+  AssertExpr('None', 'o.Objects[0]');
+  AssertExpr('None', 'o.Objects[1]');
+  AssertRaises('o.Delete(2)');
+
+  // Exchange
+  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
+  AssertExpr('', 'o.Exchange(0, 1)');
+  AssertExpr('1', 'o[0]');
+  AssertExpr('0', 'o[1]');
+
+  // Find
+  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
+  python.Exec('i=0');
+  AssertExpr('True', 'o.Find("1",i)');
+  AssertExpr('0', 'i');
+  python.Exec('i=0');
+  AssertExpr('True', 'o.Find("2",i)');
+  AssertExpr('1', 'i');
+  python.Exec('i=0');
+  AssertExpr('True', 'o.Find("2",i)');
+  AssertExpr('2', 'i');
+
+  // IndexOf
+  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
+  AssertExpr('0', 'o.IndexOf("1")');
+  AssertExpr('1', 'o.IndexOf("2")');
+  AssertExpr('2', 'o.IndexOf("3")');
+  AssertExpr('-1', 'o.IndexOf("")');
+
+  // Insert
+  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
+  python.Exec('o.Insert(0, "0")');
+  AssertExpr('0', 'o.IndexOf("0")');
+  AssertExpr('1', 'o.IndexOf("1")');
+  AssertExpr('2', 'o.IndexOf("2")');
+  AssertExpr('3', 'o.IndexOf("3")');
+
+  // Sort
+  python.Exec('o.Clear(); o.Add("ccc"); o.Add("bbb"); o.Add("aaa");');
+  python.Exec('o.Sort()');
+  AssertExpr('aaa', 'o[0]');
+  AssertExpr('bbb', 'o[1]');
+  AssertExpr('ccc', 'o[2]');
+
+  { from TStrings }
+
+  // Append
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  AssertExpr('0', 'o.IndexOf("1")');
+  AssertExpr('1', 'o.IndexOf("2")');
+  AssertExpr('2', 'o.IndexOf("3")');
+
+  // AddStrings
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  python.Exec('o2=TStringList(); o2.Add("4"); o2.Add("5"); o.AddStrings(o2)');
+  AssertExpr('5', 'o.Count');
+  AssertExpr('0', 'o.IndexOf("1")');
+  AssertExpr('1', 'o.IndexOf("2")');
+  AssertExpr('2', 'o.IndexOf("3")');
+  AssertExpr('3', 'o.IndexOf("4")');
+  AssertExpr('4', 'o.IndexOf("5")');
+
+  // Assign
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  python.Exec('o2=TStringList(); o2.Add("4"); o2.Add("5"); o.Assign(o2)');
+  AssertExpr('2', 'o.Count');
+  AssertExpr('0', 'o[0]');
+  AssertExpr('1', 'o[1]');
+
+  { test properties }
+
+  // Duplicates
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  python.Exec('o.Duplicates = dupIgnore');
+  python.Exec('o.Add("1")');
+  AssertExpr('3', 'o.Count');
+  python.Exec('o.Duplicates = dupAccept');
+  python.Exec('o.Add("1")');
+  AssertExpr('4', 'o.Count');
+
+  // Sorted
+  python.Exec('o.Clear(); o.Append("2"); o.Append("1"); o.Append("3");');
+  python.Exec('o.Sorted = True');
+  AssertExpr('True', 'o.Sorted');
+  AssertExpr('1', 'o[0]');
+  AssertExpr('2', 'o[1]');
+  AssertExpr('3', 'o[2]');
+
+  // Capacity
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  python.Exec('o.Capacity = 50');
+  AssertExpr('50', 'o.Capacity');
+
+  // CommaText
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  AssertExpr('1;2;3', 'o.CommaText');
+  python.Exec('o.CommaText = "3,2,1"');
+  AssertExpr('3', 'o[0]');
+  AssertExpr('2', 'o[1]');
+  AssertExpr('1', 'o[2]');
+
+  // Count
+  python.Exec('o.Clear()');
+  AssertExpr('0', 'o.Count');
+  python.Exec('o.Append("1")');
+  AssertExpr('1', 'o.Count');
+  python.Exec('for i in range(99): o.Add("99")');
+  AssertExpr('100', 'o.Count');
+
+  // Delimiter & DelimitedText
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  python.Exec('o.Delimiter = ";"');
+  AssertExpr('1;2;3', 'o.DelimitedText');
+  python.Exec('o.DelimitedText = "3;2;1"');
+  AssertExpr('3', 'o[0]');
+  AssertExpr('2', 'o[1]');
+  AssertExpr('1', 'o[2]');
+
+  // Names
+  python.Exec('o.Clear(); o.Append("a=1"); o.Append("b=2"); o.Append("c=3");');
+  AssertExpr('a', 'o.Names[0]');
+  AssertExpr('b', 'o.Names[1]');
+  AssertExpr('c', 'o.Names[2]');
+
+  // Objects
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  AssertExpr('None', 'o.Objects[0]');
+  AssertExpr('None', 'o.Objects[1]');
+  AssertExpr('None', 'o.Objects[2]');
+  AssertExpr('', 'o.Objects[2] = 42');
+  AssertExpr('42', 'o.Objects[2]');
+
+  // Values
+  python.Exec('o.Clear(); o.Append("a=1"); o.Append("b=2"); o.Append("c=3");');
+  AssertExpr('1', 'o.Values["a"]');
+  AssertExpr('2', 'o.Values["b"]');
+  AssertExpr('3', 'o.Values["c"]');
+
+  // ValueFromIndex
+  python.Exec('o.Clear(); o.Append("a=1"); o.Append("b=2"); o.Append("c=3");');
+  AssertExpr('1', 'o.ValueFromIndex[0]');
+  AssertExpr('2', 'o.ValueFromIndex[1]');
+  AssertExpr('3', 'o.ValueFromIndex[2]');
+
+  // Strings
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  AssertExpr('1', 'o.Strings[0]');
+  AssertExpr('2', 'o.Strings[1]');
+  AssertExpr('3', 'o.Strings[2]');
+  AssertExpr('3', 'o.Count');
+
+  // Text
+  python.Exec('o.Clear(); o.Append("1"); o.Append("2"); o.Append("3");');
+  python.Exec('o.Text = "utku\r\nkarataş"');
+  AssertExpr('2', 'o.Count');
+  AssertExpr('utku', 'o[0]');
+  AssertExpr('karataş', 'o[1]');
+
+  { Advanced cases }
+
+  // StringsAdaptor
+  AssertExpr('None', 'o.StringsAdaptor');
+
+  // OnChange
+  python.Exec('event_test = 0');
+  python.Exec('def _onchange(self, sender): global event_test; event_test = 1');
+  python.Exec('o.Clear(); o.OnChange = _onchange');
+  python.Exec('o.Append("1");');
+  AssertExpr('1', 'event_test');
+
+  // OnChanging
+  python.Exec('def _onchanging(self, sender): global event_test; event_test = 2');
+  python.Exec('o.Clear(); o.OnChange = _onchange');
+  python.Exec('o.Append("1");');
+  AssertExpr('2', 'event_test');
+
+  // CustomSort
+  python.Exec('o.Clear(); o.Append("b"); o.Append("c"); o.Append("a"); o.Append("d");');
+  python.Exec(
+'def StringListCompareStrings(l, Index1, Index2):' + #13#10 +
+'    if l[Index1] > l[Index2]: return 1          ' + #13#10 +
+'    elif l[Index1] < l[Index2]: return -1       ' + #13#10 +
+'    else: return 0                              '
+);
+  python.Exec('o.CustomSort(StringListCompareStrings)');
+  AssertExpr('a', 'o[0]');
+  AssertExpr('b', 'o[1]');
+  AssertExpr('c', 'o[2]');
+  AssertExpr('d', 'o[3]');
+  AssertExpr('4', 'o.Count');
+
+  // todo: what to do with TObject references in Python Code?
+  // OwnsObjects
+  // InsertObject
+  // AddObject
+  // Equals
+  // todo: GetEnumerator
+  // todo: GetText
+  // todo: LoadFromFile overloaded
+  // todo: LoadFromStream overloaded
+  // todo: Move
+  // todo: SaveToFile overloaded
+  // todo: SaveToStream overloaded
+  // todo: SetText
+
+  // Not tested as they dont convey anything testable:
+  // BeginUpdate, EndUpdate, LineBreak, NameValueSeparator, StrictDelimiter, QuoteChar, CaseSensitive
+end;
+
+
+procedure TestAll;
+begin
+  TestTStringList;
+  if TestLog <> nil then
+    TestLog.Append(Format('DONE tests.', []));
+end;
+
+end.

File demo/delpythonizer_test.dpr

View file
 uses
   Forms,
   main in 'main.pas' {Form1},
-  LitePython in 'D:\projects\pfaide\v1.0\IDE\src\Services\Scripting\LitePython.pas',
-  delpythonizer_tests in 'delpythonizer_tests.pas';
+  delpython_tests in 'delpython_tests.pas',
+  delPython in '..\delPython.pas';
 
 {$R *.res}
 

File demo/delpythonizer_test.dproj

View file
 			<DCCReference Include="main.pas">
 				<Form>Form1</Form>
 			</DCCReference>
-			<DCCReference Include="D:\projects\pfaide\v1.0\IDE\src\Services\Scripting\LitePython.pas"/>
-			<DCCReference Include="delpythonizer_tests.pas"/>
+			<DCCReference Include="delpython_tests.pas"/>
+			<DCCReference Include="..\delPython.pas"/>
 			<BuildConfiguration Include="Base">
 				<Key>Base</Key>
 			</BuildConfiguration>

File demo/delpythonizer_tests.pas

-unit delpythonizer_tests;
-
-interface
-
-uses
-  LitePython, Classes;
-
-procedure TestAll;
-
-var TestLog: TStrings;
-
-implementation
-
-uses
-  SysUtils;
-
-procedure AssertExpr(const Expected, PythonExpression: string);
-var actual: string;
-begin
-  try
-    actual := python.EvalStr(PythonExpression);
-    if Expected <> actual then
-      if TestLog <> nil then TestLog.Append(Format('Expected "%s" but found "%s" for %s', [Expected, actual, PythonExpression]));
-  except
-    if TestLog <> nil then
-      TestLog.Append(Format('Exception while evaluating "%s" Details: "%s"', [PythonExpression, Exception(ExceptObject).Message]));
-  end;
-end;
-
-procedure AssertRaises(const PythonExpression: string);
-begin
-  try
-    python.EvalStr(PythonExpression);
-    if TestLog <> nil then TestLog.Append(Format('FAIL: %s should have raised an exception', [PythonExpression]));
-  except
-    ;
-  end;
-end;
-
-procedure TestTStringList;
-begin
-  python.LoadDll('d:\projects\pfaide\v1.0\ide\internal_python\python26.dll');
-  python.CreateModule('vcl');
-  python.Wrap(TStringList);
-
-  { create a TStringList }
-  python.Exec('import vcl; o=vcl.TStringList()');
-  //todo: python.Exec('import vcl; o=vcl.TStringList.Create()');
-
-  { check initial property values }
-  AssertExpr('dupIgnore', 'o.Duplicates');
-  AssertExpr('False', 'o.Sorted');
-  AssertExpr('False', 'o.CaseSensitive');
-  AssertExpr('None', 'o.OnChange');
-  AssertExpr('None', 'o.OnChanging');
-  AssertExpr('False', 'o.OwnsObjects');
-  AssertExpr('0', 'o.Capacity');
-  AssertExpr('', 'o.CommaText');
-  AssertExpr('0', 'o.Count');
-  AssertExpr(',', 'o.Delimiter');
-  AssertExpr('', 'o.DelimitedText');
-  AssertExpr(#13#10, 'o.LineBreak');
-  AssertExpr('"', 'o.QuoteChar');
-  AssertExpr('=', 'o.NameValueSeparator');
-  AssertExpr('False', 'o.StrictDelimiter');
-  AssertExpr('', 'o.Text');
-  AssertExpr('None', 'o.StringsAdapter');
-
-  { test methods }
-
-  // Add
-  AssertExpr('0', 'o.Add("1")');
-  AssertExpr('1', 'o.Add("2")');
-  AssertExpr('2', 'o.Add("3")');
-  AssertExpr('3', 'o.Count');
-  AssertExpr('1', 'o.Strings[0]');
-  AssertExpr('2', 'o.Strings[1]');
-  AssertExpr('3', 'o.Strings[2]');
-  AssertExpr('1', 'o[0]');
-  AssertExpr('2', 'o[1]');
-  AssertExpr('3', 'o[2]');
-  AssertExpr('None', 'o.Objects[0]');
-  AssertExpr('None', 'o.Objects[1]');
-  AssertExpr('None', 'o.Objects[2]');
-
-  // Clear
-  AssertExpr('', 'o.Clear()');
-  AssertExpr('0', 'o.Count');
-  AssertRaises('o[0]');
-  AssertRaises('o.Strings[0]');
-  AssertRaises('o.Objects[0]');
-
-  //Delete
-  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
-  AssertExpr('', 'o.Delete(1)');
-  AssertExpr('2', 'o.Count');
-  AssertExpr('1', 'o[0]');
-  AssertExpr('3', 'o[1]');
-  AssertExpr('1', 'o.Strings[0]');
-  AssertExpr('3', 'o.Strings[1]');
-  AssertExpr('None', 'o.Objects[0]');
-  AssertExpr('None', 'o.Objects[1]');
-  AssertRaises('o.Delete(2)');
-
-  // Exchange
-  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
-  AssertExpr('', 'o.Exchange(0, 1)');
-  AssertExpr('1', 'o[0]');
-  AssertExpr('0', 'o[1]');
-
-  // Find
-  python.Exec('o.Clear(); o.Add("1"); o.Add("2"); o.Add("3");');
-  python.Exec('i=0');
-  AssertExpr('True', 'o.Find("1",i)');
-  AssertExpr('0', 'i');
-  python.Exec('i=0');
-  AssertExpr('True', 'o.Find("2",i)');
-  AssertExpr('1', 'i');
-  python.Exec('i=0');
-  AssertExpr('True', 'o.Find("2",i)');
-  AssertExpr('2', 'i');