diff options
Diffstat (limited to 'wizards/source/sfunittests/SF_Register.xba')
| -rw-r--r-- | wizards/source/sfunittests/SF_Register.xba | 202 |
1 files changed, 202 insertions, 0 deletions
diff --git a/wizards/source/sfunittests/SF_Register.xba b/wizards/source/sfunittests/SF_Register.xba new file mode 100644 index 000000000..360abba50 --- /dev/null +++ b/wizards/source/sfunittests/SF_Register.xba @@ -0,0 +1,202 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFUnitTests library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Register +''' =========== +''' The ScriptForge framework includes +''' the master ScriptForge library +''' a number of "associated" libraries SF* +''' any user/contributor extension wanting to fit into the framework +''' +''' The main methods in this module allow the current library to cling to ScriptForge +''' - RegisterScriptServices +''' Register the list of services implemented by the current library +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const UNITTESTLIBRARYERROR = "UNITTESTLIBRARYERROR" + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Sub RegisterScriptServices() As Variant +''' Register into ScriptForge the list of the services implemented by the current library +''' Each library pertaining to the framework must implement its own version of this method +''' +''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods +''' with 2 arguments: +''' ServiceName: the name of the service as a case-insensitive string +''' ServiceReference: the reference as an object +''' If the reference refers to a module, then return the module as an object: +''' GlobalScope.Library.Module +''' If the reference is a class instance, then return a string referring to the method +''' containing the New statement creating the instance +''' "libraryname.modulename.function" + + With GlobalScope.ScriptForge.SF_Services + .RegisterService("UnitTest", "SFUnitTests.SF_Register._NewUnitTest") ' Reference to the function initializing the service + End With + +End Sub ' SFUnitTests.SF_Register.RegisterScriptServices + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Function _NewUnitTest(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_UnitTest class +' Args: +''' Location: if empty, the location of the library is presumed to be in GlobalScope.BasicLibraries +''' Alternatives are: +''' - the name of a document: see SF_UI.WindowName +''' - an explicit SFDocuments.Document instance +''' - the component containing the library, typically ThisComponent +''' LibraryName: the name of the library containing the test code +''' Returns: +''' The instance or Nothing +''' Exceptions: +''' UNITTESTLIBRARYNOTFOUND The library could not be found + +Dim oUnitTest As Object ' Return value +Dim vLocation As Variant ' Alias of pvArgs(0) +Dim vLibraryName As Variant ' alias of pvArgs(1) +Dim vLocations As Variant ' "user", "share" or document +Dim sLocation As String ' A single location +Dim sTargetLocation As String ' "user" or the document name +Dim vLanguages As Variant ' "Basic", "Python", ... programming languages +Dim sLanguage As String ' A single programming language +Dim vLibraries As Variant ' Library names +Dim sLibrary As String ' A single library +Dim vModules As Variant ' Module names +Dim sModule As String ' A single module +Dim vModuleNames As Variant ' Module names +Dim oRoot As Object ' com.sun.star.script.browse.BrowseNodeFactory +Dim iLibrary As Integer ' The index of the target location in vLibraries + +Dim FSO As Object ' SF_FileSystem +Dim i As Integer, j As Integer, k As Integer, l As Integer + +Const cstService = "SFUnitTests.UnitTest" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If UBound(pvArgs) >= 0 Then vLocation = pvArgs(0) Else vLocation = "" + If IsEmpty(vLocation) Then vLocation = "" + If UBound(pvArgs) >= 1 Then vLibraryName = pvArgs(1) Else vLibraryName = "" + If IsEmpty(vLibraryName) Then vLibraryName = "" + If Not ScriptForge.SF_Utils._Validate(vLocation, "Location", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(vLibraryName, "LibraryName", V_STRING) Then GoTo Finally + + Set oUnitTest = Nothing + Set FSO = CreateScriptService("ScriptForge.FileSystem") + + ' Determine the library container hosting the test code + + ' Browsing starts from root element + Set oRoot = SF_Utils._GetUNOService("BrowseNodeFactory").createView(com.sun.star.script.browse.BrowseNodeFactoryViewTypes.MACROORGANIZER) + + If Len(vLibraryName) > 0 Then + + ' Determine the target location, as a string. The location is either: + ' - the last component of a document's file name + ' - "user" = My Macros & Dialogs + If VarType(vLocation) = ScriptForge.V_OBJECT Then + sTargetLocation = FSO.GetName(vLocation.URL) + ElseIf Len(vLocation) = 0 Then + sTargetLocation = "user" ' Testing code is presumed NOT in "share" + Else + sTargetLocation = FSO.GetName(vLocation) + End If + + ' Exploration is done via tree nodes + iLibrary = -1 + If Not IsNull(oRoot) Then + If oRoot.hasChildNodes() Then + vLocations = oRoot.getChildNodes() + For i = 0 To UBound(vLocations) + sLocation = vLocations(i).getName() + If sLocation = sTargetLocation Then + If vLocations(i).hasChildNodes() Then + vLanguages = vLocations(i).getChildNodes() + For j = 0 To UBound(vLanguages) + sLanguage = vLanguages(j).getName() + ' Consider Basic libraries only + If sLanguage = "Basic" Then + If vLanguages(j).hasChildNodes() Then + vLibraries = vLanguages(j).getChildNodes() + For k = 0 To UBound(vLibraries) + sLibrary = vLibraries(k).getName() + ' Consider the targeted library only + If sLibrary = vLibraryName Then + iLibrary = k + If vLibraries(k).hasChildNodes() Then + vModules = vLibraries(k).getChildNodes() + vModuleNames = Array() + For l = 0 To UBound(vModules) + sModule = vModules(l).getName() + vModuleNames = ScriptForge.SF_Array.Append(vModuleNames, sModule) + Next l + End If + Exit For + End If + Next k + End If + End If + If iLibrary >= 0 Then Exit For + Next j + End If + End If + If iLibrary >= 0 Then Exit For + Next i + End If + End If + If iLibrary < 0 Then GoTo CatchLibrary + + End If + +Try: + ' Create the unittest Basic object and initialize its attributes + Set oUnitTest = New SF_UnitTest + With oUnitTest + Set .[Me] = oUnitTest + If Len(vLibraryName) > 0 Then + .LibrariesContainer = sTargetLocation + .Scope = Iif(sTargetLocation = "user", "application", "document") + .Libraries = vLibraries + .LibraryName = sLibrary + .LibraryIndex = iLibrary + .Modules = vModules + .ModuleNames = vModuleNames + ._ExecutionMode = .FULLMODE + ._WhenAssertionFails = .FAILSTOPSUITE + ' Launch the test timer + .TestTimer = CreateScriptService("ScriptForge.Timer", True) + Else + ._ExecutionMode = .SIMPLEMODE + ._WhenAssertionFails = .FAILIMMEDIATESTOP + End If + End With + +Finally: + Set _NewUnitTest = oUnitTest + Exit Function +Catch: + GoTo Finally +CatchLibrary: + ScriptForge.SF_Exception.RaiseFatal(UNITTESTLIBRARYERROR, vLibraryName) + GoTo Finally +End Function ' SFUnitTests.SF_Register._NewUnitTest + +REM ============================================== END OF SFUNITTESTS.SF_REGISTER +</script:module>
\ No newline at end of file |