| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202 |
- <?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>
|
