+++ /dev/null
-'
-' Copyright 2014 Jacek Caban for CodeWeavers
-'
-' This library is free software; you can redistribute it and/or
-' modify it under the terms of the GNU Lesser General Public
-' License as published by the Free Software Foundation; either
-' version 2.1 of the License, or (at your option) any later version.
-'
-' This library is distributed in the hope that it will be useful,
-' but WITHOUT ANY WARRANTY; without even the implied warranty of
-' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-' Lesser General Public License for more details.
-'
-' You should have received a copy of the GNU Lesser General Public
-' License along with this library; if not, write to the Free Software
-' Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
-'
-
-Option Explicit
-
-const E_TESTERROR = &h80080008&
-
-const VB_E_FORLOOPNOTINITIALIZED = 92
-const VB_E_OBJNOTCOLLECTION = 451
-
-const E_NOTIMPL = &h80004001&
-const E_NOINTERFACE = &h80004002&
-const DISP_E_UNKNOWNINTERFACE = &h80020001&
-const DISP_E_MEMBERNOTFOUND = &h80020003&
-const DISP_E_PARAMNOTFOUND = &h80020004&
-const DISP_E_TYPEMISMATCH = &h80020005&
-const DISP_E_UNKNOWNNAME = &h80020006&
-const DISP_E_NONAMEDARGS = &h80020007&
-const DISP_E_BADVARTYPE = &h80020008&
-const DISP_E_OVERFLOW = &h8002000A&
-const DISP_E_BADINDEX = &h8002000B&
-const DISP_E_UNKNOWNLCID = &h8002000C&
-const DISP_E_ARRAYISLOCKED = &h8002000D&
-const DISP_E_BADPARAMCOUNT = &h8002000E&
-const DISP_E_PARAMNOTOPTIONAL = &h8002000F&
-const DISP_E_NOTACOLLECTION = &h80020011&
-const TYPE_E_DLLFUNCTIONNOTFOUND = &h8002802F&
-const TYPE_E_TYPEMISMATCH = &h80028CA0&
-const TYPE_E_OUTOFBOUNDS = &h80028CA1&
-const TYPE_E_IOERROR = &h80028CA2&
-const TYPE_E_CANTCREATETMPFILE = &h80028CA3&
-const STG_E_FILENOTFOUND = &h80030002&
-const STG_E_PATHNOTFOUND = &h80030003&
-const STG_E_TOOMANYOPENFILES = &h80030004&
-const STG_E_ACCESSDENIED = &h80030005&
-const STG_E_INSUFFICIENTMEMORY = &h80030008&
-const STG_E_NOMOREFILES = &h80030012&
-const STG_E_DISKISWRITEPROTECTED = &h80030013&
-const STG_E_WRITEFAULT = &h8003001D&
-const STG_E_READFAULT = &h8003001E&
-const STG_E_SHAREVIOLATION = &h80030020&
-const STG_E_LOCKVIOLATION = &h80030021&
-const STG_E_FILEALREADYEXISTS = &h80030050&
-const STG_E_MEDIUMFULL = &h80030070&
-const STG_E_INVALIDNAME = &h800300FC&
-const STG_E_INUSE = &h80030100&
-const STG_E_NOTCURRENT = &h80030101&
-const STG_E_CANTSAVE = &h80030103&
-const REGDB_E_CLASSNOTREG = &h80040154&
-const MK_E_UNAVAILABLE = &h800401E3&
-const MK_E_INVALIDEXTENSION = &h800401E6&
-const MK_E_CANTOPENFILE = &h800401EA&
-const CO_E_CLASSSTRING = &h800401F3&
-const CO_E_APPNOTFOUND = &h800401F5&
-const O_E_APPDIDNTREG = &h800401FE&
-const E_ACCESSDENIED = &h80070005&
-const E_OUTOFMEMORY = &h8007000E&
-const E_INVALIDARG = &h80070057&
-const RPC_S_SERVER_UNAVAILABLE = &h800706BA&
-const CO_E_SERVER_EXEC_FAILURE = &h80080005&
-
-call ok(Err.Number = 0, "Err.Number = " & Err.Number)
-call ok(getVT(Err.Number) = "VT_I4", "getVT(Err.Number) = " & getVT(Err.Number))
-
-dim calledFunc
-
-sub returnTrue
- calledFunc = true
- returnTrue = true
-end sub
-
-sub testThrow
- on error resume next
-
- dim x, y
-
- call throwInt(1000)
- call ok(Err.Number = 0, "Err.Number = " & Err.Number)
-
- call throwInt(E_TESTERROR)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- call throwInt(1000)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- call Err.clear()
- call ok(Err.Number = 0, "Err.Number = " & Err.Number)
-
- x = 6
- calledFunc = false
- x = throwInt(E_TESTERROR) and returnTrue()
- call ok(x = 6, "x = " & x)
- call ok(not calledFunc, "calledFunc = " & calledFunc)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = false
- call Err.clear()
- if false and throwInt(E_TESTERROR) then
- x = true
- else
- call ok(false, "unexpected if else branch on throw")
- end if
- call ok(x, "if branch not taken")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = false
- call Err.clear()
- if throwInt(E_TESTERROR) then x = true
- call ok(x, "if branch not taken")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = false
- call Err.clear()
- if false then
- call ok(false, "unexpected if else branch on throw")
- elseif throwInt(E_TESTERROR) then
- x = true
- else
- call ok(false, "unexpected if else branch on throw")
- end if
- call ok(x, "elseif branch not taken")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- call Err.clear()
- if true then
- call throwInt(E_TESTERROR)
- else
- call ok(false, "unexpected if else branch on throw")
- end if
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = false
- call Err.clear()
- do while throwInt(E_TESTERROR)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
- x = true
- exit do
- loop
- call ok(x, "if branch not taken")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = 0
- call Err.clear()
- do
- x = x+1
- call ok(Err.Number = 0, "Err.Number = " & Err.Number)
- loop while throwInt(E_TESTERROR)
- call ok(x = 1, "if branch not taken")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = 0
- call Err.clear()
- do
- x = x+1
- call ok(Err.Number = 0, "Err.Number = " & Err.Number)
- loop until throwInt(E_TESTERROR)
- call ok(x = 1, "if branch not taken")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- call Err.clear()
- x = 0
- while x < 2
- x = x+1
- call throwInt(E_TESTERROR)
- wend
- call ok(x = 2, "x = " & x)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- call Err.clear()
- x = 2
- y = 0
- for each x in throwInt(E_TESTERROR)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
- y = y+1
- next
- call ok(x = 2, "x = " & x)
- call ok(y = 1, "y = " & y)
- 'todo_wine call ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = " & Err.Number)
-
- Err.clear()
- y = 0
- x = 6
- for x = throwInt(E_TESTERROR) to 100
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
- call ok(x = 6, "x = " & x)
- y = y+1
- next
- call ok(y = 1, "y = " & y)
- call ok(x = 6, "x = " & x)
- 'todo_wine call ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number = " & Err.Number)
-
- Err.clear()
- y = 0
- x = 6
- for x = 100 to throwInt(E_TESTERROR)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
- 'todo_wine call ok(x = 6, "x = " & x)
- y = y+1
- next
- call ok(y = 1, "y = " & y)
- 'todo_wine call ok(x = 6, "x = " & x)
- 'todo_wine call ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number = " & Err.Number)
-
- select case throwInt(E_TESTERROR)
- case true
- call ok(false, "unexpected case true")
- case false
- call ok(false, "unexpected case false")
- case empty
- call ok(false, "unexpected case empty")
- case else
- call ok(false, "unexpected case else")
- end select
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- x = false
- select case false
- case true
- call ok(false, "unexpected case true")
- case throwInt(E_TESTERROR)
- x = true
- case else
- call ok(false, "unexpected case else")
- end select
- call ok(x, "case not executed")
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- 'Exception in non-trivial stack context
- for x = 1 to 1
- for each y in collectionObj
- select case 3
- case 1
- call ok(false, "unexpected case")
- case throwInt(E_TESTERROR)
- exit for
- case 2
- call ok(false, "unexpected case")
- end select
- next
- next
-end sub
-
-call testThrow
-
-dim x
-
-sub testOnError(resumeNext)
- if resumeNext then
- on error resume next
- else
- on error goto 0
- end if
- x = 1
- throwInt(E_TESTERROR)
- x = 2
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-end sub
-
-sub callTestOnError(resumeNext)
- on error resume next
- call testOnError(resumeNext)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-end sub
-
-x = 0
-call callTestOnError(true)
-call ok(x = 2, "x = " & x)
-
-x = 0
-call callTestOnError(false)
-call ok(x = 1, "x = " & x)
-
-sub testOnErrorClear()
- on error resume next
- call ok(Err.Number = 0, "Err.Number = " & Err.Number)
- throwInt(E_TESTERROR)
- call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-
- on error goto 0
- call ok(Err.Number = 0, "Err.Number = " & Err.Number)
- x = "ok"
-end sub
-
-call testOnErrorClear()
-call ok(x = "ok", "testOnErrorClear failed")
-
-sub testForEachError()
- on error resume next
-
- dim x, y
- y = false
- for each x in empty
- y = true
- next
- call ok(y, "for each not executed")
- 'todo_wine call ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = " & Err.Number)
-end sub
-
-call testForEachError()
-
-sub testHresMap(hres, code)
- on error resume next
-
- call Err.Clear()
- call throwInt(hres)
- call ok(Err.Number = code, "throw(" & hex(hres) & ") Err.Number = " & Err.Number)
-end sub
-
-testHresMap E_NOTIMPL, 445
-testHresMap E_NOINTERFACE, 430
-testHresMap DISP_E_UNKNOWNINTERFACE, 438
-testHresMap DISP_E_MEMBERNOTFOUND, 438
-testHresMap DISP_E_PARAMNOTFOUND, 448
-testHresMap DISP_E_TYPEMISMATCH, 13
-testHresMap DISP_E_UNKNOWNNAME, 438
-testHresMap DISP_E_NONAMEDARGS, 446
-testHresMap DISP_E_BADVARTYPE, 458
-testHresMap DISP_E_OVERFLOW, 6
-testHresMap DISP_E_BADINDEX, 9
-testHresMap DISP_E_UNKNOWNLCID, 447
-testHresMap DISP_E_ARRAYISLOCKED, 10
-testHresMap DISP_E_BADPARAMCOUNT, 450
-testHresMap DISP_E_PARAMNOTOPTIONAL, 449
-testHresMap DISP_E_NOTACOLLECTION, 451
-testHresMap TYPE_E_DLLFUNCTIONNOTFOUND, 453
-testHresMap TYPE_E_TYPEMISMATCH, 13
-testHresMap TYPE_E_OUTOFBOUNDS, 9
-testHresMap TYPE_E_IOERROR, 57
-testHresMap TYPE_E_CANTCREATETMPFILE, 322
-testHresMap STG_E_FILENOTFOUND, 432
-testHresMap STG_E_PATHNOTFOUND, 76
-testHresMap STG_E_TOOMANYOPENFILES, 67
-testHresMap STG_E_ACCESSDENIED, 70
-testHresMap STG_E_INSUFFICIENTMEMORY, 7
-testHresMap STG_E_NOMOREFILES, 67
-testHresMap STG_E_DISKISWRITEPROTECTED, 70
-testHresMap STG_E_WRITEFAULT, 57
-testHresMap STG_E_READFAULT, 57
-testHresMap STG_E_SHAREVIOLATION, 75
-testHresMap STG_E_LOCKVIOLATION, 70
-testHresMap STG_E_FILEALREADYEXISTS, 58
-testHresMap STG_E_MEDIUMFULL, 61
-testHresMap STG_E_INVALIDNAME, 53
-testHresMap STG_E_INUSE, 70
-testHresMap STG_E_NOTCURRENT, 70
-testHresMap STG_E_CANTSAVE, 57
-testHresMap REGDB_E_CLASSNOTREG, 429
-testHresMap MK_E_UNAVAILABLE, 429
-testHresMap MK_E_INVALIDEXTENSION, 432
-testHresMap MK_E_CANTOPENFILE, 432
-testHresMap CO_E_CLASSSTRING, 429
-testHresMap CO_E_APPNOTFOUND, 429
-testHresMap O_E_APPDIDNTREG, 429
-testHresMap E_ACCESSDENIED, 70
-testHresMap E_OUTOFMEMORY, 7
-testHresMap E_INVALIDARG, 5
-testHresMap RPC_S_SERVER_UNAVAILABLE, 462
-testHresMap CO_E_SERVER_EXEC_FAILURE, 429
-
-sub testVBErrorCodes()
- on error resume next
-
- Err.clear()
- throwInt(&h800a00aa&)
- call ok(Err.number = 170, "Err.number = " & Err.number)
-
- Err.clear()
- throwInt(&h800a10aa&)
- call ok(Err.number = 4266, "Err.number = " & Err.number)
-end sub
-
-call testVBErrorCodes
-
-call reportSuccess()