<?xmlversion="1.0"encoding="UTF-8"?> <!-- * This file is part of the LibreOffice project. * * This Source Code Form is subject to the terms of the Mozilla Public * License, v. 2.0. If a copy of the MPL was not distributed with this * file, You can obtain one at http://mozilla.org/MPL/2.0/. * * This file incorporates work covered by the following license notice: * * Licensed to the Apache Software Foundation (ASF) under one or more * contributor license agreements. See the NOTICE file distributed * with this work for additional information regarding copyright * ownership. The ASF licenses this file to you under the Apache * License, Version 2.0 (the "License"); you may not use this file * except in compliance with the License. You may obtain a copy of * the License at http://www.apache.org/licenses/LICENSE-2.0 .
-->
<!DOCTYPEscript:module PUBLIC"-//OpenOffice.org//DTD OfficeDocument 1.0//EN""module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script"script:name="Global"script:language="StarBasic">REM ***** BASIC *****
global gErrorState (cMaxErrorStates, 5) as integer
Global gTestCaseAnnotations( cMaxErrorStates, 5 ) As String
global gOutputDoc as Object
global gOutputDocNotUno as Object
global gOptionsDialog as Object
Global bMakeWriterTest as boolean, bMakeCalcTest as boolean, bMakeImpressTest as boolean
Global bMakeDrawTest as Boolean, bMakeMathTest as boolean, bMakeChartTest as boolean
Global bMakeHTMLTest as boolean, bMakeJavaTest as boolean, bMakeDBTest as boolean
Global bMakeExtensionTest as boolean
Global bMakeTerminateAfterTest as boolean, bShowTable as boolean
Global bMakeSaveOpen8Test as boolean, bMakeMacrosTest as boolean
global sExtensionURL as string
Dim gDlgState as Integer
Sub SetGlobalDoc
gOutputDoc = ThisComponent
end Sub
Sub ClearStatus
for j% = 0 to cMaxErrorStates
for i% = 0 to 5
gErrorState (j%, i%) = cLogUnknown
gTestCaseAnnotations( J%, i% ) = ""
next i%
next j%
end Sub
Sub ClearAllText
call SetGlobalDoc
call ClearDoc (gOutputDoc)
call ClearStatus
end Sub
Dim nPreserveFileHandle%
nPreserveFileHandle% = LocalTestLog%
Call Test_10er.Main
LocalTestLog% = nPreserveFileHandle%
gCurrentDocTest = frmTestClosure
gCurrentTestCase = cTestClosureWriteStatus
if bShowTable then
call CreateStatusTable2
call CreateStatusTable
call CreateDocState
LogTestResult( GetTestGlueDescription( gCurrentTestCase ), TRUE )
' do this LogTestResult call before CreateSecondState, since the latter accesses (and displays) the result
call CreateSecondState
gOutputDoc.CurrentController.ViewCursor.JumpToFirstPage
Else
LogTestResult( GetTestGlueDescription( gCurrentTestCase ), TRUE )
End If
MainError:
If ( gCurrentTestCase = cLogfileFailed ) then
LogTestResult( "", False )
Exit Sub
else
LogTestResult( "testclosure " + GetTestGlueDescription( gCurrentTestCase ), FALSE )
Close #LocalTestLog%
LocalTestLog = 0
End If
End Sub
Function GetTestGlueDescription( nTestCase as Integer )
Select Case ( nTestCase )
case cTestClosureSetupDoc
GetTestGlueDescription = "setup"
case cTestClosureWriteStatus
GetTestGlueDescription = "write_status"
case Else
GetTestGlueDescription = ""
End Select
End Function
If gErrorState (j%, i%) = cLogTrue Then
xCell.BackColor = cCoGreen
else
If gErrorState (j%, i%) = cLogFalse Then
xCell.BackColor = cCoRed
If ( gTestCaseAnnotations( j%, i% ) <> "" ) Then
Dim annotation as Object
annotation = aDoc.createInstance( "com.sun.star.text.TextField.Annotation" )
annotation.Author = "smoketest"
annotation.Content = gTestCaseAnnotations( j%, i% )
xCell.insertTextContent( xCell, annotation, false )
End If
else
xCell.BackColor = cCoGrey
end If
end If
next i%
next j%
end Sub
Sub CreateSecondState
aDoc = gOutputDoc
table = aDoc.TextTables.GetByIndex (0)
Dim stateIndex(2) as Integer
stateIndex(0) = cStDataBase
stateIndex(1) = cStExtension
stateIndex(2) = cStTestGlue
Dim j as Integer
For j = LBound( stateIndex ) To UBound( stateIndex )
for i% = 1 to 6
tableCell = table.getCellByPosition( 2 * j + 1, i% )
tableCell.BackTransparent = False
if gErrorState( stateIndex(j), i% - 1 ) = cLogTrue then
tableCell.BackColor = cCoGreen
else
if gErrorState ( stateIndex(j), i% - 1 ) = cLogFalse then
tableCell.BackColor = cCoRed
If ( gTestCaseAnnotations( stateIndex(j), i% - 1 ) <> "" ) Then
Dim annotation as Object
annotation = aDoc.createInstance( "com.sun.star.text.TextField.Annotation" )
annotation.Author = "smoketest"
annotation.Content = gTestCaseAnnotations( stateIndex(j), i% - 1 )
tableCell.insertTextContent( tableCell, annotation, false )
End If
else
tableCell.BackColor = cCoGrey
end If
end If
next i%
next j%
end Sub
Function GetRangeName (nColumn as integer, nRow as integer) as string
GetRangeName = chr (nColumn+66) + Trim(Str(nRow+1))
end Function
Sub LogTestResult( sTestCaseDescription as String, bSuccess as Boolean )
If ( gCurrentTestCase = cLogfileFailed ) Then
Dim sAnnotation as String
sAnnotation = "creating logfile '" + GetLogFileName( gCurrentDocTest ) + "' failed"
LogState( FALSE, sAnnotation, GlobalTestLog )
RecordTestCaseStatus( 0, FALSE, sAnnotation )
Else
bSuccess = RecordTestCaseStatus( gCurrentTestCase, bSuccess, sTestCaseDescription )
If ( LocalTestLog <> 0 ) Then
LogState( bSuccess, sTestCaseDescription, LocalTestLog )
EndIf
if ( GlobalTestLog <> 0 ) Then
LogState( bSuccess, sTestCaseDescription, GlobalTestLog )
EndIf
End If
End Sub
Function RecordTestCaseStatus( nAction as Integer, bState as Boolean, sFailureAnnotation as String ) as Boolean
Dim nStatusType as Integer
Dim nState as integer
nStatusType = GetStatusType( gCurrentDocTest )
If nStatusType = cStNone then Exit Function
If ( gErrorState( nStatusType, nAction ) = cLogFalse ) Then
' don't overwrite a previous "failed" state for this test
bState = FALSE
End If
if bState then
nState = cLogTrue
else
nState = cLogFalse
end If
gErrorState (nStatusType, nAction) = nState
If ( nState = cLogFalse ) And ( sFailureAnnotation <> "" ) Then
if gTestCaseAnnotations(nStatusType, nAction) <> "" then
gTestCaseAnnotations(nStatusType, nAction) = _
gTestCaseAnnotations(nStatusType, nAction) & "; "
end if
gTestCaseAnnotations( nStatusType, nAction ) = gTestCaseAnnotations( nStatusType, nAction ) + sFailureAnnotation
End If
RecordTestCaseStatus = bState
End Function
Function GetStatusType (nDocType as Integer) as Integer
Select Case ( nDocType )
case frmWriter
GetStatusType = cStWriter ' text document
case frmCalc
GetStatusType = cStCalc ' spreadsheet document
case frmImpress
GetStatusType = cStPraesentation ' presentation
case frmDraw
GetStatusType = cStZeichnen ' drawing
case frmMath
GetStatusType = cStMath ' formula
case frmHyperText
GetStatusType = cStHTML ' HTML document
case frmChart
GetStatusType = cStChart ' chart
case frmJava
GetStatusType = cStJava 'Java
case frmTestClosure
GetStatusType = cStTestGlue ' test framework
case frmDataBase
GetStatusType = cStDataBase 'DataBase
case frmExtension
GetStatusType = cStExtension 'Extension
case else
GetStatusType = cStNone
end Select
end Function
Sub SetParagraphBreak (aCursor as Object)
aCursor.Text.InsertControlCharacter (aCursor, cParagraphBreak, True)
end Sub
Sub ClearDoc (aDoc as Object)
Dim aText as Object
Dim i%
for i%=1 to aDoc.TextTables.count
aDoc.TextTables.GetByIndex(0).dispose
next
aText = aDoc.Text.CreateTextCursor
aText.GotoStart (False)
aText.GoRight (3, False)
SetParagraphBreak (aText)
aText.GotoEnd (True)
aText.String=""
end Sub
Sub ClearDocFull (aDoc as Object)
Dim aText as Object
Dim i%
for i%=1 to aDoc.TextTables.count
aDoc.TextTables.GetByIndex(0).dispose
next
aText = aDoc.Text.CreateTextCursor
aText.GotoStart (False)
aText.GotoEnd (True)
aText.String=""
end Sub
Sub SetGlobalOptionsDialog ()
Dim oLibContainer As Object, oLib As Object
Dim oInputStreamProvider As Object
Dim oDialog As Object
Sub SetDefaultOptions
bMakeWriterTest = true
bMakeCalcTest = true
bMakeImpressTest = true
bMakeDrawTest = true
bMakeHTMLTest = true
bMakeMathTest = true
bMakeChartTest = true
if Environ("ENABLE_JAVA") = "" then
bMakeJavaTest = false
bMakeDBTest = false
bMakeExtensionTest = false
else
bMakeJavaTest = true
bMakeDBTest = true
bMakeExtensionTest = true
End If
bMakeSaveOpen8Test = true
bMakeMacrosTest = true
bMakeTerminateAfterTest = false
end Sub
Sub StartTestByOptions
bShowTable = true
call ReadOptions
call Main
if bMakeTerminateAfterTest then
ClearDocFull (gOutputDoc)
gOutputDoc.dispose
'StarDesktop.Terminate
'EnableReschedule( false )
'DispatchSlot( 5300 )
stop
End If
end Sub
Function StartTestWithDefaultOptions
bShowTable = false
call SetDefaultOptions
call Main
dim component(cMaxErrorStates) as string
component(cStWriter) = "Writer"
component(cStCalc) = "Calc"
component(cStPraesentation) = "Impress"
component(cStZeichnen) = "Draw"
component(cStChart) = "Chart"
component(cStMath) = "Math"
component(cStHTML) = "HTML"
component(cStJava) = "Java"
component(cStDataBase) = "Base"
component(cStExtension) = "Extensions"
dim action(4) as string
action(cDocNew) = "new"
action(cDocSaveOpen8) = "V8.0"
action(cDocClose) = "close"
action(cDocMacros) = "macros"
dim baseAction(5) as string
baseAction(cDBService) = "services"
baseAction(cDBOpen) = "open"
baseAction(cDBInsert) = "insert"
baseAction(cDBDelete) = "delete"
baseAction(cDBSeek) = "seek"
baseAction(cDBClose) = "close"
dim extAction(2) as string
extAction(cEXTService) = "services"
extAction(cEXTInstall) = "install"
extAction(cEXTUninstall) = "uninstall"
dim result as string
for i = 0 to cMaxErrorStates
for j = 0 to 5
if gErrorState(i, j) = cLogFalse then
result = result & " " & component(i) & ":"
if i = cStDataBase then
result = result & baseAction(j)
else if i = cStExtension then
result = result & extAction(j)
else
result = result & action(j)
end if
end if
if gTestCaseAnnotations(i, j) <> "" then
result = result & "(" & _
gTestCaseAnnotations(i, j) & ")"
end if
end if
next j
next i
StartTestWithDefaultOptions = result
end Function
Sub DispatchSlot(SlotID as Integer)
Dim oArg() as new com.sun.star.beans.PropertyValue
Dim oUrl as new com.sun.star.util.URL
Dim oTrans as Object
Dim oDisp as Object
oDisp = StarDesktop.queryDispatch(oUrl, "_self", 0)
oDisp.dispatch(oUrl, oArg())
End Sub
Sub LoadLibrary( LibName As String )
dim args(1)
dim arg as new com.sun.star.beans.PropertyValue
arg.Name = "LibraryName"
arg.Value = LibName
args(0) = arg
dim url as new com.sun.star.util.URL
dim trans as object
trans = createUnoService("com.sun.star.util.URLTransformer" ) url.Complete = "slot:6517"
trans.parsestrict( url )
dim disp as object
disp = StarDesktop.currentFrame.queryDispatch( url, "", 0 )
disp.dispatch( url, args() )
End Sub
Sub ExecuteSlot( SlotNr As String, oDoc as Object )
dim args()
dim url as new com.sun.star.util.URL
dim trans as object
dim disp as object
Sub DelAllUserFields (aDoc as Object)
Dim aFieldType as Object
Dim aElements as Variant
Dim i%
Dim aFieldMasters, aFieldMaster as Object
Dim sElement$
aFieldMasters = aDoc.TextFieldMasters
aElements = aFieldMasters.ElementNames
for i = 0 to UBound(aElements)
sElement$ = aElements(i)
if 0 <> instr(sElement$, cUnoUserField ) then
aFieldMaster = aFieldMasters.GetByName(sElement$)
aFieldMaster.Dispose
endif
next
end Sub
Function GetUserFieldState (sName as String, aDoc as Object) as boolean
Dim sFieldText as String
Dim bState as boolean
sFieldText = ReadUserField (sName, aDoc)
if LCase(sFieldText) = cYes then
bState = true
else
bState = false
end IF
GetUserFieldState = bState
end Function
Sub SetUserFieldState (sName as String, nState as boolean, aDoc as Object)
Dim sFieldText as String
sFieldText = cNo 'default
Select case nState
case true
sFieldText = cYes
case false
sFieldText = cNo
end Select
WriteUserField (sFieldText, sName, aDoc)
end Sub
Function ReadUserField(sFieldName as String, aDoc as Object) as String
Dim aMasters as Object
aMasters = aDoc.TextFieldMasters
if aMasters.HasByName (cUnoUserField+cUnoSeparator+sFieldName) then
ReadUserField = aMasters.GetByName (cUnoUserField+cUnoSeparator+sFieldName).Content
else
ReadUserField = ""
end If
End Function
Sub WriteUserField(sValue as String, sFieldName as String, aDoc as Object, optional aCursor as Object)
Dim aMasters, aUserField, aTxtCursor as Object
aMasters = aDoc.TextFieldMasters
if aMasters.HasByName (cUnoUserField+cUnoSeparator+sFieldName) then
aUserField = aMasters.GetByName (cUnoUserField+cUnoSeparator+sFieldName)
else
aUserField = aDoc.CreateInstance (cUnoUserField)
aUserField.Name = sFieldName
end if
aUserField.Content = sValue
End Sub
Sub WriteExtUserField(nIndex as Integer, aCursor as Object, aDoc as Object)
Dim aUserField as Object
aUserField = aDoc.CreateInstance (cUnoExtUserField)
aUserField.UserDataType = nIndex
aCursor.Text.InsertTextContent (aCursor, aUserField, True)
aUserField.Fix = True
End Sub
</script:module>
Messung V0.5
¤ Dauer der Verarbeitung: 0.15 Sekunden
(vorverarbeitet)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.