'encoding UTF-8 Do not remove or change this line! '************************************************************************* ' ' 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 ' ' Unless required by applicable law or agreed to in writing, ' software distributed under the License is distributed on an ' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY ' KIND, either express or implied. See the License for the ' specific language governing permissions and limitations ' under the License. ' '************************************************************************* '* '* short description : very important routines to start a testscript '* '************************************************************************ '* ' Global: ' #1 GetUseFiles ' First routine which will be called automatically by starting a testscript ' #1 LoadDeclaration ' Includes the whole declaration (.sid- and .win-files) ' #1 LoadGlobalIncludeFiles ' Includes global .inc-files ' ' Recover routines: ' #1 TestEnter ' Internal subroutine called at testcase-start -> start recovering ' #1 TestExit ' Internal subroutine called at testcase-end ' If an error in a testscript occurs the test jumps directly into this routine ' #1 PleaseRecover ' Recover routine used by TestExit- and TestEnter ' ' Office Startroutines: ' #1 hStartTheOffice ' Routine to start the Office ' #1 ExitRestartTheOffice ' Exit and restart the office - after 30 seconds ' #1 FirstOfficeStart ' First office start with ResetApplication function ' #1 sStartUpOffice ' sub routine which is being called from hStartTheOffice and ExitRestartTheOffice ' #1 hExitTheOffice ' sub routine to just exit the office ' ' Special Information: ' #1 hFirstOutPut ' Creates a general information header in result files for all tests ' #1 mMakeGeneralOptionsAPI ' Sets general options in the office via API, without UI ' #1 hIsResultWriteable ' Is TT able to write the resultfile in the directory? ' #0 hDetectStatusDatabase ' Detecting the status database server ' #1 hDisableQuickstarter ' Disable the Quickstart feature on win32 systems '* '\*********************************************************************** sub GetUseFiles '///GetUseFiles: The first routine which will be called automatically by starting a testscript. '/// Include all important libraries (.inc) for the startup. Dim bQuickstarterStatus as boolean Dim sTemp as string Dim sPrivateEnvironmentLocation as string Dim sEnvironmentVersion as string Dim sEnvironmentDisplayVersion as string Dim sEnvironmentVersionMinor as string gTestcaseStart = Now() ' get start time of test preparation phase GVERBOSE = FALSE ' global switch to make some functions more talkative for profiling purposes use "global\system\includes\sysinfo.inc" '///+ sysinfo.inc : routines to get all system informations use "global\system\includes\inivalue.inc" '///+ inivalue.inc : routines to work with ini-files use "global\system\includes\iniinfo.inc" '///+ iniinfo.inc : routines to get all informations about OpenOffice.org use "global\system\includes\status.inc" '///+ status.inc : all routines to put the status-info into database '/// Call important system- and start-routines. Call LoadGlobalIncludeFiles '///+
  • LoadGlobalIncludeFiles: Include file with global routines (master.inc)
    • Call GetToolPlatform '///+
  • GetToolPlatform: Detect operating environment for the Testtool (sysinfo.inc)
    • Call GetOfficePlatform '///+
  • GetOfficePlatform: Detect operating environment for the office (sysinfo.inc)
    • Call GetIniInformation '///+
  • GetIniInformation: Get all information out of the testtool.ini/.testtoolrc and set it on global variables (iniinfo.inc)
    • Call GetOfficeInformation '///+
  • GetOfficeInformation: Set sAppExe for startup (iniinfo.inc)
    • gVersionsnummer = FindBuildID ' split versionstring into its parts call hSetBuildVersionInformation(False) Call LoadDeclaration '///+ Call PleaseRecover ("TestExit") if ((gTestName <> "") AND isStatusEnabled()) then 'gTestName set in hStatusIn call hStatusAddTestcase() end if end sub '------------------------------------------------------------------------- sub PleaseRecover (sWhat as String) Dim sError as String Dim sInterrupt as Boolean Dim sOtherError as Boolean Dim i as Integer Dim a as Integer sInterrupt = FALSE sOtherError = FALSE '/// Close the translation window. try if gDasNicht = 0 then Kontext "TranslationWindow" if TranslationWindow.Exists then TranslationWindow.Close end if end if catch endcatch '/// Use ResetApplication method try call hCloseAllToolbars 'All error-strings are in sError gStartTheOffice = FALSE 'This is the trigger for a restart after application crashed: sError = ResetApplication 'If sError = empty then no error occured. if sError <> "" then printlog " ** Error in " + sWhat + " -Routine **" warnlog sError end if catch if NOT gStartTheOffice then printlog "global::system::inc::PleaseRecover: No office running while trying to recover: " + sError + " " + sWhat sInterrupt = TRUE else resetApplication endif endcatch try 'Kill all commands after the reset AppAbort catch endcatch '/// If the office crashes interrupt = TRUE and the office should be started again. if sInterrupt = TRUE then try Call hStartTheOffice SetClipboard "" catch try QAErrorLog "killapp: "+gTestName+"--"+getTestcaseName killapp catch ExceptLog endcatch endcatch try 'kill all commands after the reset AppAbort catch endcatch end if try 'Only in a debug version of the office: Setting the assertion output to TestTool CaptureAssertions TRUE catch endcatch 'Disabling crash handling by TestTool. The crash reporter is used instead. try catchGPF false catch endcatch Kontext ' Recover to backingwindow, until resetApplication can handle this hFileCloseAll() end sub '------------------------------------------------------------------------- sub hFirstOutput '/// Create a general header in result files for all tests. Dim sDir as String Dim sDir1 as String Dim sMajor as String if gSamePC = TRUE then if (len(gMajor)>3) then sMajor = left(gMajor,3) end if 'Detecting child workspaces (CWS) and status database server if InStr(gVersionsnummer , "[CWS:") <> 0 then gCWS = TRUE else gCWS = FALSE end if if hDetectStatusDatabase = TRUE then gStatusDatabase = TRUE else gStatusDatabase = FALSE end if else gVersionsnummer = "REMOTE" end if iSystemSprache = hGetSystemLanguage bDebugVersion = NOT isProduct printlog "----------------------------------------------------------------------------------------------------" printlog " I n f o r m a t i o n A b o u t T h e T e s t E n v i r o n m e n t" printlog "----------------------------------------------------------------------------------------------------" printlog "** Application build ID : " & sMajor & gVersionsnummer if bDebugVersion = TRUE then printlog "** DEBUG version : " & bDebugVersion end if if gCWS = FALSE then printlog "** Build type : MASTER" else printlog "** Build type : CWS" end if if isStatusEnabled() then 'http://wiki.services.openoffice.org/wiki/QUASTe printlog "** Status feature (QUASTe) : Enabled " + gLocalStatusDatabase end if printlog "----------------------------------------------------------------------------------------------------" printlog "** Application installation path : " + gNetzOfficePath printlog "** User configuration path : " + gOfficePath printlog "** Started application : " + sAppExe printlog "----------------------------------------------------------------------------------------------------" printlog "** Application language : " + iSprache + " (" + gLanguage + " / " + gISOLang + ")" printlog "** System language : " + iSystemSprache + " (" + GetLanguageText (iSystemSprache) + ")" if gSamePC = FALSE then printlog "** Platform VCL TestTool : " + gtSYSName printlog "** Platform application : " + gSYSName + " (" + gHost + ") " printlog "** Path to remote base path : " + gRemotePath else printlog "** Testing platform : " + gtSYSName end if printlog "----------------------------------------------------------------------------------------------------" sDir1 = ConvertPath (gOfficePath + "user\work\" sDir = App.Dir (sDir1, 16) if sDir = "" then App.MKDir (sDir1) printlog "** Work path has been created : " + sDir1 end if 'Disabling embedded translation tooling gDasNicht = 1 'Disabling embedded screenshot tooling depending on value in .testtoolrc/ini gbSnapShot = sGetScreenshotValue end sub '------------------------------------------------------------------------- sub mMakeGeneralOptionsAPI '/// At the beginning of each testrun set some defaults with the API '///+ and write them down into the result file (.res). '///+ end sub '------------------------------------------------------------------------- function hIsResultWriteable() as boolean '///Running a test without being able to write the RESULT file to disk is worthless. '///+This functions checks if the directory exists, tries to create it and checks if it is writeable. '///+If this fails, the test won't start and presents a messagebox. Dim sResultFilePath as string Dim sTestDir as string 'Get the path to the RESULT directory sResultFilePath = GetIniValue (gTesttoolIni, gTTProfileName , "LogBaseDir") if (dir(sResultFilePath, 16) = "") then ' doesn't exist try MkDir (ConvertPath(sResultFilePath, gtPlatform)) ' WorkAround for bug in dir() #104037# MkDir (ConvertPath(sResultFilePath+ gPathSigne+"ID104037", gtPlatform)) if (dir(sResultFilePath, 16) <> "") then ' does exist hIsResultWriteable = TRUE printlog "global::system::inc::master.inc::hIsResultWriteable: created RESULT directory: '" + sResultFilePath + "'" ' WorkAround for bug in dir() RmDir (ConvertPath(sResultFilePath + gPathsigne + "ID104037", gtPlatform)) else warnlog "global::system::inc::master.inc::hIsResultWriteable: Make the directory '" + sResultFilePath + "' writeable; RESULT file can not be saved;" hIsResultWriteable = FALSE end if catch warnlog "global::system::inc::master.inc::hIsResultWriteable: Create the directory '" + sResultFilePath + "'; RESULT file can not be saved; (no right to create the directory)" hIsResultWriteable = FALSE endcatch else ' Check if it is writeable try sTestDir = "tbotest" ' nasty bug, if the path is with a path sign at the end; usually on on windows root dirs :-( if (right(ConvertPath(sResultFilePath, gtPlatform), 1) <> hGetPathSigne(gtPlatform)) then sTestDir = hgetPathSigne(gtPlatform) + sTestDir end if MkDir (ConvertPath(sResultFilePath + sTestDir, gtPlatform)) RmDir (ConvertPath(sResultFilePath + sTestDir, gtPlatform)) hIsResultWriteable = TRUE catch warnlog "global::system::inc::master.inc::hIsResultWriteable: Make the directory '" + convertPath(sResultFilePath, gtPlatform) + "' writeable; RESULT file can not be saved;" hIsResultWriteable = FALSE endcatch end if end function '------------------------------------------------------------------------- sub hDetectStatusDatabase as Boolean '/// Detecting the status database server. dim sOOoLocalStatusDatabase as string dim sPrivateEnvironmentLocation as string dim sTemp as string sTemp = GetIniValue ( gTesttoolIni, "StatusFeatureLevel" , "Current" ) if sTemp = "" then sPrivateEnvironmentLocation = ConvertPath (gTestToolPath + "errorlog\privateenvironment.txt") if fileExists(sPrivateEnvironmentLocation) then gStatusFeatureLevel = getIniValue(sPrivateEnvironmentLocation, "StatusFeatureLevel", "Current") else ' manual submitting status from errorlog directory gStatusFeatureLevel = 2 end if else gStatusFeatureLevel = sTemp end if if gStatusFeatureLevel = 0 then ' automatical submitting status; filespace location defined in privateenvironment.inc hDetectStatusDatabase = TRUE gLocalStatusDatabase = "" else if gStatusFeatureLevel = 1 then ' automatical submitting status; filespace location defined in testtoolrc hDetectStatusDatabase = TRUE sOOoLocalStatusDatabase = GetIniValue ( gTesttoolIni, "OOoLocalStatusDatabase" , "Current" ) if sOOoLocalStatusDatabase <> "" then if dir(sOOoLocalStatusDatabase,16) <> "" then gLocalStatusDatabase = sOOoLocalStatusDatabase 'printlog "** OOo Local Status Database Path: '" + sOOoLocalStatusDatabase + "'" else qaErrorLog "** OOo Local Status Database Path: '" + sOOoLocalStatusDatabase + "' doesn't exist or is not a directory." gLocalStatusDatabase = "" end if else qaErrorLog "You are using status mode 1; you have to define the public filespace location in your testtoolrc:"+chr(13)+"[OOoLocalStatusDatabase]"+chr(13)+"Type=Path"+chr(13)+"Current=." gLocalStatusDatabase = "" end if sTemp = GetIniValue ( gTesttoolIni, "StatusDatabaseServerIP" , "Current" ) if sTemp = "" then qaErrorLog "You are using status mode 1; you have to define the database server adress in your testtoolrc:"+chr(13)+"[StatusDatabaseServerIP]"+chr(13)+"Type=Path"+chr(13)+"Current=." else privateDatabaseServerIP = sTemp end if sTemp = GetIniValue ( gTesttoolIni, "StatusDatabaseServerPath" , "Current" ) if sTemp = "" then qaErrorLog "You are using status mode 1; you have to define the database server path in your testtoolrc:"+chr(13)+"[StatusDatabaseServerPath]"+chr(13)+"Type=Path"+chr(13)+"Current=." else privateDatabaseServerPath = sTemp end if else if gStatusFeatureLevel = 2 then hDetectStatusDatabase = TRUE gLocalStatusDatabase = "errorlog directory" else hDetectStatusDatabase = FALSE gLocalStatusDatabase = "" end if end if end if end sub '------------------------------------------------------------------------- function hDisableQuickstarter as boolean '/// On all systems, disable the Quickstart feature which is enabled by default. '///+ Returns: Answer to the question 'Was action taken, to disable it?' Dim bTemp as boolean Dim bResult as boolean Dim bVeto as boolean bTemp = FALSE bResult = TRUE bVeto = FALSE ' True if Tools-Options-Memory needs to get triggert 'This needs/can not be done on the following platforms: '- MacOS X '- Linux/Unix builds of StarOffice/Suite '- Win32 if already disabled, or not available. if gPlatGroup <> "unx" then ' if quickstart.exe exists, it might run, else no need to open options UI bVeto = fileExists(gNetzOfficePath + "program\quickstart.exe") else if (lcase(gPlatform) = "osx") then bVeto = FALSE else ' Not needed if StarOffice/Suite bVeto = gOOo end if end if if bVeto then 'First, disabling the Quickstarter via UI ToolsOptions call hToolsOptions ("STAROFFICE", "MEMORY") try bTemp = LoadQuickstarter.isChecked if bTemp then LoadQuickstarter.uncheck end if catch bResult = FALSE endcatch Kontext "ExtrasOptionenDlg" ExtrasOptionenDlg.OK else bResult = FALSE end if 'Second, closing the Quickstarter process that a restart of the office hDisableQuickstarterAPI() hDisableQuickstarter = bResult end function '------------------------------------------------------------------------- sub sStartUpOffice (optional sProfPath as String, optional sProfParameter as String) Dim sParameter as String Dim sErrorInformation as string Dim sUnoPort as string Dim sPlatformProgramPath as string Dim sPlatformBinExt as string sErrorInformation = "global::systen::inc::master.inc:sStartUpOffice: " '/// The environment for the non-GUI Crashreporter function will be set. setChildEnv("ERRORREPORT_HTTPPROXYSERVER",gProxyServer) setChildEnv("ERRORREPORT_HTTPPROXYPORT",gProxyPort) setChildEnv("ERRORREPORT_HTTPCONNECTIONTYPE",gConnectionType) setChildEnv("ERRORREPORT_RETURNADDRESS",gReturnAddress) setChildEnv("ERRORREPORT_SUBJECT","Error_Report_from_TestTool") setChildEnv("ERRORREPORT_BODYFILE",ConvertPath (gOfficePath & "user\work\crashrep.txt")) ' Set a valid URE_BOOTSTRAP path for soffice, else the invalid one from this testtool instance ' will get used i86718 - would result in a message about vcl stuff and a not starting soffice if lcase( gPlatform ) = "osx" then sPlatformProgramPath = "MacOS" sPlatformBinExt = "rc" else sPlatformProgramPath = "program" if gPlatGroup <> "unx" then sPlatformBinExt = ".ini" else sPlatformBinExt = "rc" end if end if setChildEnv("URE_BOOTSTRAP",convertToURL(convertPath(gNetzOfficePath + sPlatformProgramPath + "/fundamental" + sPlatformBinExt))) ' Getting UNO-port hGetUNOService(true, sUnoPort) if sUnoPort <> "" then sUnoPort = "-accept=socket,host=localhost,port=" + sUnoPort + ";urp " else sUnoPort = "" warnlog "UNO port is not defined: Set it in the TestTool application: Extra -> Settings -> Misc -> Remote UNO Port" end if '/// To start the application some parameter need to be set: '///+
    1. -enableautomation to enable the TCP/IP connection between office application and TestTool
      2. '///+
    2. -norestore to eliminate the the document recovery functionylity after a crash
      3. '///+
    3. -nolockcheck to elimante the 'parallel running instances'-check and always start the application
      4. '///+
    4. -autocrashreport to enable the non-GUI crash report functionality
      5. '///+
    5. -accept=socket,host=localhost,port=12345;urp to enable UNO connection
      6. '///+
    6. OPTIONAL application parameters for profiling tests
      7. sParameter = "-enableautomation -norestore -nolockcheck -autocrashreport -nofirststartwizard " & sUnoPort & sAppParameter & " " if IsMissing (sProfPath) then '///+
    7. Factory-parameter which depends on the value of gApplication (WRITER, CALC, ...)
    sParameter = sParameter & sFactory ' try/catch is needed for special tasks, to workaround time outs try Start sAppExe, sParameter catch endcatch try ' This is only >0 if defined in TestTool configuration file ' It is needed for valgrind (Memory leaks) tests ' Valgrind: 420;8min sleep(gOOoStartupTimeOut) catch endcatch else if IsMissing (sProfParameter) then '/// If OPTIONAL profiling path parameters have been set the profiling filename will be checked '///+ because then this parameter is not optional. QAErrorLog sErrorInformation & " Parameter 'sProfParameter' is NOT OPTIONAL if sProfPath has been set!" 'The test execution will be stopped here. end else '/// If both OPTIONAL parameters (path, filename) have been set, the office application '///+ will be started with an additional parameter: '///+ Start sAppExe, sParameter & " " & sFactory end if end sub sub StartTheOffice '/// this routine is not intended to be called from within a testscript. '/// this routine will get called by the VCL TestTool application, in case it recognizes there is no soffice.bin running anymore or not responding anymore '/// this happens usually after OpenOffice.org crashed 'keep it as short as possible! warnlog "OpenOffice.org application crashed or can not be started. Double click the above error message if exists for the culprint." sStartUpOffice() try catchGPF false catch endcatch hDisableQuickstarterAPI() ' set global variable for backwards compatibility gStartTheOffice = TRUE end sub