Something went wrong. Try again.
Reactos
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390'' 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 = 92const 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 = trueend 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) call todo_wine_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) call todo_wine_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) call todo_wine_ok(x = 6, "x = " & x) y = y+1 next call ok(y = 1, "y = " & y) call todo_wine_ok(x = 6, "x = " & x) call todo_wine_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 nextend 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 = 0call callTestOnError(true)call ok(x = 2, "x = " & x)
x = 0call 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") call todo_wine_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, 445testHresMap E_NOINTERFACE, 430testHresMap DISP_E_UNKNOWNINTERFACE, 438testHresMap DISP_E_MEMBERNOTFOUND, 438testHresMap DISP_E_PARAMNOTFOUND, 448testHresMap DISP_E_TYPEMISMATCH, 13testHresMap DISP_E_UNKNOWNNAME, 438testHresMap DISP_E_NONAMEDARGS, 446testHresMap DISP_E_BADVARTYPE, 458testHresMap DISP_E_OVERFLOW, 6testHresMap DISP_E_BADINDEX, 9testHresMap DISP_E_UNKNOWNLCID, 447testHresMap DISP_E_ARRAYISLOCKED, 10testHresMap DISP_E_BADPARAMCOUNT, 450testHresMap DISP_E_PARAMNOTOPTIONAL, 449testHresMap DISP_E_NOTACOLLECTION, 451testHresMap TYPE_E_DLLFUNCTIONNOTFOUND, 453testHresMap TYPE_E_TYPEMISMATCH, 13testHresMap TYPE_E_OUTOFBOUNDS, 9testHresMap TYPE_E_IOERROR, 57testHresMap TYPE_E_CANTCREATETMPFILE, 322testHresMap STG_E_FILENOTFOUND, 432testHresMap STG_E_PATHNOTFOUND, 76testHresMap STG_E_TOOMANYOPENFILES, 67testHresMap STG_E_ACCESSDENIED, 70testHresMap STG_E_INSUFFICIENTMEMORY, 7testHresMap STG_E_NOMOREFILES, 67testHresMap STG_E_DISKISWRITEPROTECTED, 70testHresMap STG_E_WRITEFAULT, 57testHresMap STG_E_READFAULT, 57testHresMap STG_E_SHAREVIOLATION, 75testHresMap STG_E_LOCKVIOLATION, 70testHresMap STG_E_FILEALREADYEXISTS, 58testHresMap STG_E_MEDIUMFULL, 61testHresMap STG_E_INVALIDNAME, 53testHresMap STG_E_INUSE, 70testHresMap STG_E_NOTCURRENT, 70testHresMap STG_E_CANTSAVE, 57testHresMap REGDB_E_CLASSNOTREG, 429testHresMap MK_E_UNAVAILABLE, 429testHresMap MK_E_INVALIDEXTENSION, 432testHresMap MK_E_CANTOPENFILE, 432testHresMap CO_E_CLASSSTRING, 429testHresMap CO_E_APPNOTFOUND, 429testHresMap O_E_APPDIDNTREG, 429testHresMap E_ACCESSDENIED, 70testHresMap E_OUTOFMEMORY, 7testHresMap E_INVALIDARG, 5testHresMap RPC_S_SERVER_UNAVAILABLE, 462testHresMap 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()