VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "s_Python" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit ' TODO: ' Public Function RunPyStandalone(sPyCommand$, Optional sWorkDir$ = "") As Long ' Public Function RunPyFrozen(iPython$, Optional sArgs$ = "") As Long ' Public Function API_Python.Execute(sPyCommand$) As Boolean ' Public Function API_Python.Evaluate(sPyStatement$) As Variant #If Win64 Then Private Declare PtrSafe Function GetServer Lib "vbatopy-connector64.dll" (ByRef vResult As Variant) As Long Private Declare PtrSafe Function KillPythonServer Lib "vbatopy-connector64.dll" Alias "KillServer" () As Long #Else Private Declare PtrSafe Function GetServer Lib "vbatopy-connector32.dll" (ByRef vResult As Variant) As Long Private Declare PtrSafe Function KillPythonServer Lib "vbatopy-connector32.dll" Alias "KillServer" () As Long #End If Dim python_ As API_Python Private Const TEST_FUNCS_FILE = "testFuncs.py" Private Const TEST_WRAP_SOURCE = "testWrap.py" Private Const TEST_WRAP_RESULT = "testWrap.bas" Public Function Setup() ' Mandatory setup function Set python_ = New API_Python Call python_.Init(iPython:=PY_DEFVALUE_INTERPRETER, sModules:="", bDoDebug:=False) Call python_.LoadDLL End Function Public Function Teardown() ' Mandatory teardown function Call python_.KillServer Set python_ = Nothing End Function Public Function t_StartServer() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Invalid python") Dim iTest As New API_Python Call iTest.Init("invalid_python", "") On Error Resume Next Call iTest.StartServer Call Dev_ExpectAnyError On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Missing server module") Call iTest.Init("python", "", bDoDebug:=False) On Error Resume Next Call iTest.StartServer Call Dev_ExpectAnyError On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Too long command") Call iTest.Init("python", String$(10000, "A")) On Error Resume Next Call iTest.StartServer Call Dev_ExpectAnyError On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Start valid") Dim iServer As Variant: Call GetServer(iServer) Call Dev_ExpectTrue(iServer Is Nothing, "Not started") Call Dev_ExpectFalse(python_.Validate, "Not started") Call python_.StartServer Call GetServer(iServer) Call Dev_ExpectTrue(python_.Validate, "After start") Call Dev_ExpectFalse(iServer Is Nothing, "After start") On Error Resume Next Call python_.StartServer Call Dev_ExpectNoError("Double start") On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Double python object") Call iTest.Init("python", "") On Error Resume Next Call iTest.StartServer Call Dev_ExpectNoError On Error GoTo PROPAGATE_ERROR Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_KillServer() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Not started") On Error Resume Next Call python_.KillServer Call Dev_ExpectNoError On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Valid kill") Call python_.StartServer Call python_.KillServer Dim iServer As Variant: Call GetServer(iServer) Call Dev_ExpectTrue(iServer Is Nothing) Call Dev_ExpectFalse(python_.Validate) On Error Resume Next Call python_.KillServer Call Dev_ExpectNoError("Dobule kill") On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Hijack and kill first") Call python_.StartServer Call KillPythonServer On Error Resume Next Call python_.KillServer Call Dev_ExpectNoError On Error GoTo PROPAGATE_ERROR Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_RunPython() On Error GoTo PROPAGATE_ERROR Call Dev_NewCase("Not started") Call Dev_ExpectFalse(python_.Validate) Call Dev_ExpectTrue(python_.Execute("print(1)")) Call Dev_ExpectTrue(python_.Validate) Call Dev_NewCase("Already started") Call Dev_ExpectTrue(python_.Execute("print(2)")) Call Dev_NewCase("Invalid code") Call Dev_ExpectFalse(python_.Execute("invalid_func_call(42, '42')")) Call Dev_ExpectFalse(python_.Execute("do_something_illegal42")) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_LoadModule() On Error GoTo PROPAGATE_ERROR Dim sModule$: sModule = Dev_GetTestFolder & "\" & TEST_FUNCS_FILE Call python_.StartServer Call Dev_ExpectFalse(python_.LoadModule(""), "Empty input") Call Dev_NewCase("Missing file") Call Dev_ExpectFalse(python_.LoadModule(Dev_GetTestFolder & "\missingFile.py")) Call Dev_NewCase("Valid load") Call Dev_ExpectTrue(python_.LoadModule(sModule)) Call Dev_ExpectEQ("Hello world!", python_.CallFunction("testFuncs", "hello", Array("world"))) Call Dev_NewCase("Double load") Call Dev_ExpectTrue(python_.LoadModule(sModule)) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_CallFunctionInvalid() On Error GoTo PROPAGATE_ERROR Call python_.StartServer Call Dev_ExpectTrue(python_.LoadModule(Dev_GetTestFolder & "\" & TEST_FUNCS_FILE)) Call Dev_NewCase("Invalid module") Call Dev_ExpectLike(python_.CallFunction("invalid_module", "get_42"), "Unexpected Python Error*") Call Dev_ExpectLike(python_.CallFunction("", "get_42"), "Unexpected Python Error*") Call Dev_NewCase("Invalid function") Call Dev_ExpectLike(python_.CallFunction("testFuncs", "invalid_function_name42"), "Unexpected Python Error*") Call Dev_ExpectLike(python_.CallFunction("testFuncs", ""), "Unexpected Python Error*") Call Dev_NewCase("Invalid arguments") Call Dev_ExpectEQ("Hello world!", python_.CallFunction("testFuncs", "hello", Array("world")), "Unexpected Python Error*") Call Dev_ExpectLike(python_.CallFunction("testFuncs", "hello"), "Unexpected Python Error*", "Missing argument") Call Dev_ExpectLike(python_.CallFunction("testFuncs", "hello", "world"), "Unexpected Python Error*", "Invalid argument type - string") Call Dev_ExpectLike(python_.CallFunction("testFuncs", "hello", ThisWorkbook), "Unexpected Python Error*", "Invalid argument type - object") Call Dev_ExpectLike(python_.CallFunction("testFuncs", "hello", Array("world", "big")), "Unexpected Python Error*", "Invalid argument count") Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_CallFunctionBasic() On Error GoTo PROPAGATE_ERROR Call python_.StartServer Call Dev_ExpectTrue(python_.LoadModule(Dev_GetTestFolder & "\" & TEST_FUNCS_FILE)) Call Dev_NewCase("No return") Call Dev_ExpectTrue(IsNull(python_.CallFunction("testFuncs", "no_return"))) Call Dev_NewCase("No arguments") Call Dev_ExpectEQ(42, python_.CallFunction("testFuncs", "get_42")) Call Dev_NewCase("Strings") Call Dev_ExpectEQ("Hello world!", python_.CallFunction("testFuncs", "hello", Array("world"))) Call Dev_ExpectEQ("Hello 42!", python_.CallFunction("testFuncs", "hello", Array(42))) Call Dev_NewCase("Multiple args") Call Dev_ExpectEQ((13 + 5) * 2, python_.CallFunction("testFuncs", "double_sum", Array(13, 5))) Call Dev_NewCase("Array arg") Call Dev_ExpectEQ(42 + 1337 + 1, python_.CallFunction("testFuncs", "sum_array", Array(Array(42, 1337, 1)))) Call Dev_NewCase("Dictionary argument") Call Dev_ExpectEQ(3, python_.CallFunction("testFuncs", "process_dict", Array(CSet(1, 2, 43)))) Call Dev_NewCase("Optional arg") Call Dev_ExpectEQ(42, python_.CallFunction("testFuncs", "optional_arg")) Call Dev_ExpectEQ(1337, python_.CallFunction("testFuncs", "optional_arg", Array(1337))) Call Dev_NewCase("Multiple return") Call Dev_ExpectEQ(Array(42, "test"), python_.CallFunction("testFuncs", "return_tuple")) Call Dev_NewCase("Return list") Call Dev_ExpectEQ(Array(42, "test", 11), python_.CallFunction("testFuncs", "return_list")) Call Dev_NewCase("Return 2dlist") Call Dev_ExpectEQ(Array(Array(1, 2, 42), Array("test", 13), Array(11)), python_.CallFunction("testFuncs", "return_2dlist")) Call Dev_NewCase("Return dict") Dim iTest As New Scripting.Dictionary iTest("a") = 42 iTest("b") = "test" iTest("c") = 11 Call Dev_ExpectEQ(iTest, python_.CallFunctionReturnObject("testFuncs", "return_dict")) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_CallFunctionObjects() On Error GoTo PROPAGATE_ERROR Call python_.StartServer Call Dev_ExpectTrue(python_.LoadModule(Dev_GetTestFolder & "\" & TEST_FUNCS_FILE)) Call Dev_NewCase("Access VBA COM from Python") Dim iCell As Excel.Range: Set iCell = ThisWorkbook.Sheets(1).Cells(1, 1) iCell = "test" Call Dev_ExpectEQ("test", python_.CallFunction("testFuncs", "extract_range_text", Array(ThisWorkbook.Sheets(1)))) iCell = "" Call Dev_NewCase("Return VBA object from Python") Dim iResult As Object Set iResult = python_.CallFunctionReturnObject("testFuncs", "return_range_object", Array(ThisWorkbook.Sheets(1))) iResult = "test" Call Dev_ExpectEQ("test", iCell.Text) iCell = "" Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function Public Function t_WrapPython() On Error GoTo PROPAGATE_ERROR Dim fso As New Scripting.FileSystemObject Dim sSource$: sSource = Dev_GetTestFolder & "\" & TEST_WRAP_SOURCE Dim sDestination$: sDestination = ThisWorkbook.Path & "\" & TEST_WRAP_RESULT Dim sTest$: sTest = Dev_GetTestFolder & "\" & TEST_WRAP_RESULT Call python_.StartServer Call Dev_AssertEQ(sDestination, python_.WrapPython(sSource, sDestination)) Call Dev_ExpectEQ(ReadFile(sTest), ReadFile(sDestination)) Call fso.DeleteFile(sDestination) Exit Function PROPAGATE_ERROR: Call Dev_LogError(Err.Number, Err.Description) End Function ' ===== Private Function ReadFile(sFile$) As String Dim adoStream As New ADODB.Stream adoStream.Charset = "utf-8" Call adoStream.Open On Error GoTo ERROR_FILE Call adoStream.LoadFromFile(sFile) On Error GoTo 0 ReadFile = adoStream.ReadText ERROR_FILE: Call adoStream.Close On Error GoTo 0 End Function