PyRunner/test/s_Python.cls

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