REM 10er Test const sSWLogFileName = "swlog.dat", sSCLogFileName = "sclog.dat" const sSDLogFileName = "sdlog.dat", sSMathLogFileName = "smalog.dat" const sSChartLogFileName = "schlog.dat" const sSHptLogFileName = "shptlog.dat" const sSDrawLogFileName = "sdrwlog.dat", sJavaLogFileName = "javalog.dat" const sSDBLogFileName = "dblog.dat", sExtLogFileName = "extlog.dat" const sTestGlueLogFileName = "testclosure.log" const sLogFileName = "smoketest.log" const cTempFileName = "smoketest_file" const cMessageSaveOpen8Doc = "Save/Open open Documents (8.0)" const cMessageNewDoc = "New Document" const cMessageCloseDoc = "Close Document" const cMessageRunMacros = "Run Macros" Global sWorkPath$ Global sWorkPathURL$ Global LocalTestLog% Global GlobalTestLog% Sub Main call TestAllDocs() end Sub Sub DeleteAllSavedFiles() Dim sFileName as String sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter) If FileExists (sFileName) then Kill (sFileName) End If sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc) If FileExists (sFileName) then Kill (sFileName) End If sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress) If FileExists (sFileName) then Kill (sFileName) End If sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw) If FileExists (sFileName) then Kill (sFileName) End If sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmHyperText) If FileExists (sFileName) then Kill (sFileName) End If End Sub Sub DeleteAllLogFiles() If FileExists (sWorkPath+sLogFileName) then Kill (sWorkPath+sLogFileName) End If If FileExists (sWorkPath+sSWLogFileName) then Kill (sWorkPath+sSWLogFileName) End If If FileExists (sWorkPath+sSCLogFileName) then Kill (sWorkPath+sSCLogFileName) End If If FileExists (sWorkPath+sSDLogFileName) then Kill (sWorkPath+sSDLogFileName) End If If FileExists (sWorkPath+sSMathLogFileName) then Kill (sWorkPath+sSMathLogFileName) End If If FileExists (sWorkPath+sSChartLogFileName) then Kill (sWorkPath+sSChartLogFileName) End If If FileExists (sWorkPath+sSHptLogFileName) then Kill (sWorkPath+sSHptLogFileName) End If If FileExists (sWorkPath+sSDrawLogFileName) then Kill (sWorkPath+sSDrawLogFileName) End If If FileExists (sWorkPath+sJavaLogFileName) then Kill (sWorkPath+sJavaLogFileName) End If If FileExists (sWorkPath+sTestGlueLogFileName) then Kill (sWorkPath+sTestGlueLogFileName) End If If FileExists (sWorkPath+sSDBLogFileName) then Kill (sWorkPath+sSDBLogFileName) End If If FileExists (sWorkPath+sExtLogFileName) then Kill (sWorkPath+sExtLogFileName) End If end Sub Function OpenLogDat (sFileName as String) as Integer Dim LocaleFileChannel% If FileExists (sWorkPath+sFileName) then Kill (sWorkPath+sFileName) End If LocaleFileChannel% = Freefile Open sWorkPath+sFileName For Output As LocaleFileChannel% OpenLogDat = LocaleFileChannel% end Function Sub SetupWorkPath Dim configManager as Object configManager = CreateUnoService( "com.sun.star.config.SpecialConfigManager" ) sWorkPath = configManager.SubstituteVariables( "$(userpath)/temp/" ) sWorkPathURL = configManager.SubstituteVariables( "$(userurl)/temp/" ) End Sub Function GetSystem (sTmpWorkPath as string) as string GetSystem = "" if InStr (sTmpWorkPath, ":") then GetSystem = "windows" else GetSystem = "unix" End If end Function Function ConvertPathToWin (sTmpWorkPath as string) as string for i%=1 to Len(sTmpWorkPath) sTemp = Mid (sTmpWorkPath, i%, 1) if sTemp = "/" then sTmpWorkPath = Left (sTmpWorkPath, i%-1) + "\" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%) else if sTemp = "|" then sTmpWorkPath = Left (sTmpWorkPath, i%-1) + ":" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%) end If end If next i% ConvertPathToWin = sTmpWorkPath end Function Sub TestAllDocs() DIM sDocURL as String, sDocPath as String DIM nStrPos as Long 'search ExtensionURL sDocURL = gOutputDoc.URL CompatibilityMode(true) nStrPos = InStrRev (sDocURL, "/" ) CompatibilityMode(false) sExtensionURL = Left (sDocURL, nStrPos) + "../Extension/" + cExtensionFileName GlobalTestLog = OpenLogDat (sLogFileName) call WriteTestSequence ' Do extension test first to avoid OOM with ASAN if bMakeExtensionTest then gCurrentDocTest = frmExtension call Test_Ext.TestExtensions end if if bMakeWriterTest then gCurrentDocTest = frmWriter call MakeDocTest end if if bMakeCalcTest then gCurrentDocTest = frmCalc call MakeDocTest end if if bMakeImpressTest then gCurrentDocTest = frmImpress call MakeDocTest end if if bMakeDrawTest then gCurrentDocTest = frmDraw call MakeDocTest end if if bMakeHTMLTest then gCurrentDocTest = frmHyperText call MakeDocTest end if if bMakeChartTest then gCurrentDocTest = frmChart call MakeChartTest end if if bMakeMathTest then gCurrentDocTest = frmMath call MakeNewDoc end if if bMakeJavaTest then gCurrentDocTest = frmJava call TestJava end if if bMakeDBTest then gCurrentDocTest = frmDataBase call Test_DB.TestDB end if Close #GlobalTestLog GlobalTestLog = 0 end Sub Sub WriteTestSequence Print #GlobalTestLog, "Sequence of testing" if bMakeExtensionTest then WriteExtensionTests ("Extension : ", GlobalTestLog) if bMakeWriterTest then WriteTests ("writer : ", true, GlobalTestLog) end if if bMakeCalcTest then WriteTests ("calc : ", true, GlobalTestLog) end if if bMakeImpressTest then WriteTests ("impress : ", true, GlobalTestLog) end if if bMakeDrawTest then WriteTests ("draw : ", true, GlobalTestLog) end if if bMakeHTMLTest then WriteTests ("HTML : ", true, GlobalTestLog) end if if bMakeChartTest then WriteTests ("chart : ", false, GlobalTestLog) end if if bMakeMathTest then WriteTests ("math : ", false, GlobalTestLog) end if if bMakeJavaTest then WriteTests ("Java : ", false, GlobalTestLog) end if if bMakeDBTest then WriteDBTests ("Database : ", GlobalTestLog) end if end if Print #GlobalTestLog, "testclosure : setup, write_status" Print #GlobalTestLog end Sub Sub WriteTests (sText as string, bTestAll as boolean) Dim sWriteStr as string sWriteStr = sText sWriteStr = sWriteStr + "new" if bTestAll then if bMakeSaveOpen8Test then sWriteStr = sWriteStr + ", save 8.0" end if if bMakeSaveOpen8Test then sWriteStr = sWriteStr + ", open 8.0" end if if bMakeMacrosTest then sWriteStr = sWriteStr + ", run macros" end if end if sWriteStr = sWriteStr + ", close" Print #GlobalTestLog, sWriteStr end Sub Sub WriteDBTests (sText as string, nFileChannel as integer) Dim sWriteStr as string sWriteStr = sText sWriteStr = sWriteStr + "open / services" sWriteStr = sWriteStr + ", insert" sWriteStr = sWriteStr + ", delete" sWriteStr = sWriteStr + ", seek" sWriteStr = sWriteStr + ", close" Print #nFileChannel, sWriteStr end Sub Sub WriteExtensionTests (sText as string, nFileChannel as integer) Dim sWriteStr as string sWriteStr = sText sWriteStr = sWriteStr + "services" sWriteStr = sWriteStr + ", install" sWriteStr = sWriteStr + ", uninstall" Print #nFileChannel, sWriteStr end Sub Sub MakeDocTest Dim oDoc as Object Dim sFileNameXML$, sFileName8$ Dim bSuccess as Boolean On Local Error GoTo DOCTESTERROR gCurrentTestCase = cLogfileFailed LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) gCurrentTestCase = cDocNew oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc)) LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, not IsNull (oDoc) ) if not IsNull (oDoc) then gCurrentTestCase = cDocSaveOpen8 if bMakeSaveOpen8Test and IsFilterAvailable (gCurrentDocTest or cFlt8) then sFileName8 = sWorkPathURL+cTempFileName+"."+GetDocEndings(gCurrentDocTest or cFlt8) SaveDoc (sFileName8, oDoc, GetDocFilter(gCurrentDocTest or cFlt8)) end if gCurrentTestCase = cDocClose bSuccess = CloseDoc( oDoc ) LogTestResult( GetDocFilter(gCurrentDocTest)+" "+ cMessageCloseDoc, bSuccess ) gCurrentTestCase = cDocSaveOpen8 if bMakeSaveOpen8Test and IsFilterAvailable (gCurrentDocTest or cFlt8) then oDoc = LoadDoc (sFileName8) ' oDoc = Documents.open(sFileName) LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, not IsNull (oDoc) ) if not IsNull (oDoc) then gCurrentTestCase = cDocClose oDoc.close (true) end If end if gCurrentTestCase = cDocMacros ' Just one calc macro test for now ' To-Do split this into its own per-module/test .xml and add more if bMakeMacrosTest and gCurrentDocTest = frmCalc then oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc)) oDocCtrl = oDoc.getCurrentController() oDocFrame = oDocCtrl.getFrame() oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args(0) as new com.sun.star.beans.PropertyValue args(0).Name = "ToPoint" args(0).Value = "$A$1" oDispatcher.executeDispatch(oDocFrame, ".uno:GoToCell", "", 0, args()) args(0).Name = "By" args(0).Value = 5 oDispatcher.executeDispatch(oDocFrame, ".uno:GoRightSel", "", 0, args()) args(0).Name = "By" args(0).Value = 5 oDispatcher.executeDispatch(oDocFrame, ".uno:GoDownSel", "", 0, args()) oRangeAddr = oDoc.getCurrentSelection().getRangeAddress() bResult = oRangeAddr.StartColumn = 0 and oRangeAddr.EndColumn = 5 and oRangeAddr.StartRow = 0 and oRangeAddr.EndRow = 5 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageRunMacros, bResult ) if not IsNull (oDoc) then gCurrentTestCase = cDocClose oDoc.close (true) end If end if end If Print #LocalTestLog, "---" Close #LocalTestLog% LocalTestLog = 0 Exit Sub ' Without error DOCTESTERROR: If ( gCurrentTestCase = cLogfileFailed ) then LogTestResult( " ", False ) Exit Sub else LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), False ) Close #LocalTestLog% LocalTestLog = 0 End If Exit Sub ' With error End Sub Sub MakeNewDoc DIM oDoc as Object Dim bSuccess as Boolean On Local Error GoTo DOCTESTERROR2 gCurrentTestCase = cLogfileFailed LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) gCurrentTestCase = cDocNew ' oDoc = Documents.Add(GetDocFilter(gCurrentDocTest)) oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc)) LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, not IsNull (oDoc) ) if not IsNull (oDoc) then gCurrentTestCase = cDocClose bSuccess = CloseDoc( oDoc ) LogTestResult( GetDocFilter(gCurrentDocTest)+" "+ cMessageCloseDoc, bSuccess ) end If Print #LocalTestLog, "---" Close #LocalTestLog% LocalTestLog = 0 Exit Sub ' Without error DOCTESTERROR2: If ( gCurrentTestCase = cLogfileFailed ) then LogTestResult( " ", False ) Exit Sub else LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), False ) Close #LocalTestLog% LocalTestLog = 0 End If Exit Sub ' With error End Sub Sub MakeChartTest Dim oCharts as Object Dim oDoc as Object Dim oRange(0) as New com.sun.star.table.CellRangeAddress Dim oRect as New com.sun.star.awt.Rectangle const cChartName="TestChart" Dim bSuccess as Boolean On Local Error GoTo CHARTTESTERROR gCurrentTestCase = cLogfileFailed LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) gCurrentTestCase = cDocNew oDoc = LoadDoc ("private:factory/" + GetDocFilter(frmCalc or cFltNewDoc)) if not IsNull (oDoc) then oCharts = oDoc.sheets(0).Charts oCharts.AddNewByName (cChartName, oRect, oRange(), true, true) bSuccess=oCharts.HasByName(cChartName) LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, bSuccess ) gCurrentTestCase = cDocClose oDoc.close (true) else LogTestResult( GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, FALSE ) End if Print #LocalTestLog, "---" Close #LocalTestLog% LocalTestLog = 0 Exit Sub ' Without error CHARTTESTERROR: If ( gCurrentTestCase = cLogfileFailed ) then LogTestResult( " ", False ) Exit Sub else LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), FALSE ) Close #LocalTestLog% LocalTestLog = 0 End If Exit Sub ' With error End Sub Sub LogState (bState as Boolean, sText as String, nLocaleFileChannel as integer) if bState then Print #nLocaleFileChannel, sText+" -> ok" else Print #nLocaleFileChannel, sText+" -> error" end If end Sub Function GetDocEndings (DocType as Integer) as String Select Case ( DocType ) case frmWriter or cFlt8 GetDocEndings = "odt" ' Textdokument case frmCalc or cFlt8 GetDocEndings = "ods" 'Tabellendokument case frmImpress or cFlt8 GetDocEndings = "odp" 'PrÕsentation case frmDraw or cFlt8 GetDocEndings = "odg" 'Zeichen case frmHyperText, frmHyperText or cFltXML GetDocEndings = "html" 'Hypertext-Dokument case frmWriter or cFltXML GetDocEndings = "sxw" ' Textdokument case frmCalc or cFltXML GetDocEndings = "sxc" 'Tabellendokument case frmImpress or cFltXML GetDocEndings = "sxi" 'PrÕsentation case frmDraw or cFltXML GetDocEndings = "sxd" 'Zeichen case else GetDocEndings = "" end Select end Function Function GetDocFilter (DocType as Integer) as String Select Case ( DocType ) case frmWriter or cFlt8 GetDocFilter = "writer8" ' text document case frmCalc or cFlt8 GetDocFilter = "calc8" ' spreadsheet document case frmImpress or cFlt8 GetDocFilter = "impress8" ' presentation case frmDraw or cFlt8 GetDocFilter = "draw8" ' drawing case frmMath or cFlt8 GetDocFilter = "math8" ' formula case frmWriter or cFltXML GetDocFilter = "StarOffice XML (Writer)" ' text document case frmCalc or cFltXML GetDocFilter = "StarOffice XML (Calc)" ' spreadsheet document case frmImpress or cFltXML GetDocFilter = "StarOffice XML (Impress)" ' presentation case frmDraw or cFltXML GetDocFilter = "StarOffice XML (Draw)" ' drawing case frmMath or cFltXML GetDocFilter = "StarOffice XML (Math)" ' formula case frmHyperText, frmHyperText or cFltXML GetDocFilter = "HTML" ' HTML document case frmWriter or cFltNewDoc GetDocFilter = "swriter" ' text document case frmCalc or cFltNewDoc GetDocFilter = "scalc" ' spreadsheet document case frmImpress or cFltNewDoc GetDocFilter = "simpress" ' presentation case frmDraw or cFltNewDoc GetDocFilter = "sdraw" ' drawing case frmMath or cFltNewDoc GetDocFilter = "smath" ' formula case frmHyperText or cFltNewDoc GetDocFilter = "swriter/web" ' HTML document case frmChart or cFltNewDoc GetDocFilter = "schart" ' chart case else GetDocFilter = "" end Select end Function Function GetLogFileName (DocType as Integer) as String Select Case ( DocType ) case frmWriter GetLogFileName = sSWLogFileName ' text document case frmCalc GetLogFileName = sSCLogFileName ' spreadsheet document case frmImpress GetLogFileName = sSDLogFileName ' presentation case frmDraw GetLogFileName = sSDrawLogFileName ' drawing case frmMath GetLogFileName = sSMathLogFileName ' formula case frmHyperText GetLogFileName = sSHptLogFileName ' HTML document case frmChart GetLogFileName = sSChartLogFileName ' chart case frmJava GetLogFileName = sJavaLogFileName 'Java case frmTestClosure GetLogFileName = sTestGlueLogFileName ' test framework case frmDataBase GetLogFileName = sSDBLogFileName 'Database case frmExtension GetLogFileName = sExtLogFileName 'Extension case else GetLogFileName = "" end Select end Function Function GetErrorMessageOnAction (nAction as Integer) as String Select Case ( nAction ) case cDocNew GetErrorMessageOnAction = cMessageNewDoc case cDocSaveOpen8 GetErrorMessageOnAction = cMessageSaveOpen8Doc case cDocMacros GetErrorMessageOnAction = cMessageRunMacros case cDocClose GetErrorMessageOnAction = cMessageCloseDoc case else GetErrorMessageOnAction = "" end Select end Function Function IsFilterAvailable (FilterType as Integer) as boolean IsFilterAvailable = true if (FilterType = (frmHyperText or cFltXML)) then IsFilterAvailable = false end if End Function Function TestJava Dim oObj as Object gCurrentTestCase = cLogfileFailed LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) gCurrentTestCase = cDocNew oObj = createUnoService( cUnoJavaLoader ) LogTestResult( "Java "+ cMessageNewDoc, not IsNull (oObj) ) Print #LocalTestLog, "---" Close #LocalTestLog% LocalTestLog = 0 TestJava = not IsNull (oObj) End Function 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 LoadDoc (DocName as String) as Object dim trans as object trans = createUnoService("com.sun.star.util.URLTransformer" ) url = createUnoStruct("com.sun.star.util.URL" ) url.Complete = DocName if Left(DocName, 5 ) <> "file:" then trans.parsestrict( url ) endif Dim aPropArray(0) as Object aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue") aPropArray(0).Name = "OpenFlags" aPropArray(0).Value = "S" dim doc as object dim noargs() doc = StarDesktop.loadComponentFromURL( url.Complete, "_blank", 0, aPropArray() ) ' XModel LoadDoc = doc End Sub Sub SaveDoc (DocName as String, oDoc as Object, sFilterName as string ) dim trans as object trans = createUnoService("com.sun.star.util.URLTransformer" ) url = createUnoStruct("com.sun.star.util.URL" ) url.Complete = DocName if Left(DocName, 5 ) <> "file:" then trans.parsestrict( url ) endif if not (sFilterName = "") then Dim aPropArray(0) as Object aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue") aPropArray(0).Name = "FilterName" aPropArray(0).Value = sFilterName oDoc.storeAsURL( url.Complete, aPropArray() ) else MessageBox "Filtername is unknown!" end if end Sub Function CloseDoc( oDoc as Object ) Dim oListener as Object oListener = CreateUnoListener( "Events.closeListener_", "com.sun.star.util.XCloseListener" ) oDoc.addCloseListener( oListener ) Events.ResetCloseListenerFlag() oDoc.close( true ) closeDoc = Events.HasCloseListenerBeenCalled() if ( Not Events.HasCloseListenerBeenCalled() ) Then ' do this only if closing was not successful - otherwise, we'd get a DisposedException oDoc.removeCloseListener( oListener ) End If End Function