1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
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>
|
