1'
2' Copyright 2014 Jacek Caban for CodeWeavers
3'
4' This library is free software; you can redistribute it and/or
5' modify it under the terms of the GNU Lesser General Public
6' License as published by the Free Software Foundation; either
7' version 2.1 of the License, or (at your option) any later version.
8'
9' This library is distributed in the hope that it will be useful,
10' but WITHOUT ANY WARRANTY; without even the implied warranty of
11' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12' Lesser General Public License for more details.
13'
14' You should have received a copy of the GNU Lesser General Public
15' License along with this library; if not, write to the Free Software
16' Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17'
18
19Option Explicit
20
21const E_TESTERROR = &h80080008&
22
23const VB_E_FORLOOPNOTINITIALIZED = 92
24const VB_E_OBJNOTCOLLECTION = 451
25
26const E_NOTIMPL = &h80004001&
27const E_NOINTERFACE = &h80004002&
28const DISP_E_UNKNOWNINTERFACE = &h80020001&
29const DISP_E_MEMBERNOTFOUND = &h80020003&
30const DISP_E_PARAMNOTFOUND = &h80020004&
31const DISP_E_TYPEMISMATCH = &h80020005&
32const DISP_E_UNKNOWNNAME = &h80020006&
33const DISP_E_NONAMEDARGS = &h80020007&
34const DISP_E_BADVARTYPE = &h80020008&
35const DISP_E_OVERFLOW = &h8002000A&
36const DISP_E_BADINDEX = &h8002000B&
37const DISP_E_UNKNOWNLCID = &h8002000C&
38const DISP_E_ARRAYISLOCKED = &h8002000D&
39const DISP_E_BADPARAMCOUNT = &h8002000E&
40const DISP_E_PARAMNOTOPTIONAL = &h8002000F&
41const DISP_E_NOTACOLLECTION = &h80020011&
42const TYPE_E_DLLFUNCTIONNOTFOUND = &h8002802F&
43const TYPE_E_TYPEMISMATCH = &h80028CA0&
44const TYPE_E_OUTOFBOUNDS = &h80028CA1&
45const TYPE_E_IOERROR = &h80028CA2&
46const TYPE_E_CANTCREATETMPFILE = &h80028CA3&
47const STG_E_FILENOTFOUND = &h80030002&
48const STG_E_PATHNOTFOUND = &h80030003&
49const STG_E_TOOMANYOPENFILES = &h80030004&
50const STG_E_ACCESSDENIED = &h80030005&
51const STG_E_INSUFFICIENTMEMORY = &h80030008&
52const STG_E_NOMOREFILES = &h80030012&
53const STG_E_DISKISWRITEPROTECTED = &h80030013&
54const STG_E_WRITEFAULT = &h8003001D&
55const STG_E_READFAULT = &h8003001E&
56const STG_E_SHAREVIOLATION = &h80030020&
57const STG_E_LOCKVIOLATION = &h80030021&
58const STG_E_FILEALREADYEXISTS = &h80030050&
59const STG_E_MEDIUMFULL = &h80030070&
60const STG_E_INVALIDNAME = &h800300FC&
61const STG_E_INUSE = &h80030100&
62const STG_E_NOTCURRENT = &h80030101&
63const STG_E_CANTSAVE = &h80030103&
64const REGDB_E_CLASSNOTREG = &h80040154&
65const MK_E_UNAVAILABLE = &h800401E3&
66const MK_E_INVALIDEXTENSION = &h800401E6&
67const MK_E_CANTOPENFILE = &h800401EA&
68const CO_E_CLASSSTRING = &h800401F3&
69const CO_E_APPNOTFOUND = &h800401F5&
70const O_E_APPDIDNTREG = &h800401FE&
71const E_ACCESSDENIED = &h80070005&
72const E_OUTOFMEMORY = &h8007000E&
73const E_INVALIDARG = &h80070057&
74const RPC_S_SERVER_UNAVAILABLE = &h800706BA&
75const CO_E_SERVER_EXEC_FAILURE = &h80080005&
76
77call ok(Err.Number = 0, "Err.Number = " & Err.Number)
78call ok(getVT(Err.Number) = "VT_I4", "getVT(Err.Number) = " & getVT(Err.Number))
79
80dim calledFunc
81
82sub returnTrue
83    calledFunc = true
84    returnTrue = true
85end sub
86
87sub testThrow
88    on error resume next
89
90    dim x, y
91
92    call throwInt(1000)
93    call ok(Err.Number = 0, "Err.Number = " & Err.Number)
94
95    call throwInt(E_TESTERROR)
96    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
97
98    call throwInt(1000)
99    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
100
101    call Err.clear()
102    call ok(Err.Number = 0, "Err.Number = " & Err.Number)
103
104    x = 6
105    calledFunc = false
106    x = throwInt(E_TESTERROR) and returnTrue()
107    call ok(x = 6, "x = " & x)
108    call ok(not calledFunc, "calledFunc = " & calledFunc)
109    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
110
111    x = false
112    call Err.clear()
113    if false and throwInt(E_TESTERROR) then
114        x = true
115    else
116        call ok(false, "unexpected if else branch on throw")
117    end if
118    call ok(x, "if branch not taken")
119    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
120
121    x = false
122    call Err.clear()
123    if throwInt(E_TESTERROR) then x = true
124    call ok(x, "if branch not taken")
125    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
126
127    x = false
128    call Err.clear()
129    if false then
130        call ok(false, "unexpected if else branch on throw")
131    elseif throwInt(E_TESTERROR) then
132        x = true
133    else
134        call ok(false, "unexpected if else branch on throw")
135    end if
136    call ok(x, "elseif branch not taken")
137    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
138
139    call Err.clear()
140    if true then
141        call throwInt(E_TESTERROR)
142    else
143        call ok(false, "unexpected if else branch on throw")
144    end if
145    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
146
147    x = false
148    call Err.clear()
149    do while throwInt(E_TESTERROR)
150        call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
151        x = true
152        exit do
153    loop
154    call ok(x, "if branch not taken")
155    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
156
157    x = 0
158    call Err.clear()
159    do
160        x = x+1
161        call ok(Err.Number = 0, "Err.Number = " & Err.Number)
162    loop while throwInt(E_TESTERROR)
163    call ok(x = 1, "if branch not taken")
164    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
165
166    x = 0
167    call Err.clear()
168    do
169        x = x+1
170        call ok(Err.Number = 0, "Err.Number = " & Err.Number)
171    loop until throwInt(E_TESTERROR)
172    call ok(x = 1, "if branch not taken")
173    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
174
175    call Err.clear()
176    x = 0
177    while x < 2
178        x = x+1
179        call throwInt(E_TESTERROR)
180    wend
181    call ok(x = 2, "x = " & x)
182    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
183
184    call Err.clear()
185    x = 2
186    y = 0
187    for each x in throwInt(E_TESTERROR)
188        call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
189        y = y+1
190    next
191    call ok(x = 2, "x = " & x)
192    call ok(y = 1, "y = " & y)
193    call todo_wine_ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = " & Err.Number)
194
195    Err.clear()
196    y = 0
197    x = 6
198    for x = throwInt(E_TESTERROR) to 100
199        call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
200        call ok(x = 6, "x = " & x)
201        y = y+1
202    next
203    call ok(y = 1, "y = " & y)
204    call ok(x = 6, "x = " & x)
205    call todo_wine_ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number = " & Err.Number)
206
207    Err.clear()
208    y = 0
209    x = 6
210    for x = 100 to throwInt(E_TESTERROR)
211        call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
212        call todo_wine_ok(x = 6, "x = " & x)
213        y = y+1
214    next
215    call ok(y = 1, "y = " & y)
216    call todo_wine_ok(x = 6, "x = " & x)
217    call todo_wine_ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number = " & Err.Number)
218
219    select case throwInt(E_TESTERROR)
220    case true
221         call ok(false, "unexpected case true")
222    case false
223         call ok(false, "unexpected case false")
224    case empty
225         call ok(false, "unexpected case empty")
226    case else
227         call ok(false, "unexpected case else")
228    end select
229    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
230
231    x = false
232    select case false
233    case true
234         call ok(false, "unexpected case true")
235    case throwInt(E_TESTERROR)
236         x = true
237    case else
238         call ok(false, "unexpected case else")
239    end select
240    call ok(x, "case not executed")
241    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
242
243    'Exception in non-trivial stack context
244    for x = 1 to 1
245        for each y in collectionObj
246            select case 3
247            case 1
248                call ok(false, "unexpected case")
249            case throwInt(E_TESTERROR)
250                exit for
251            case 2
252                call ok(false, "unexpected case")
253            end select
254        next
255    next
256end sub
257
258call testThrow
259
260dim x
261
262sub testOnError(resumeNext)
263    if resumeNext then
264        on error resume next
265    else
266        on error goto 0
267    end if
268    x = 1
269    throwInt(E_TESTERROR)
270    x = 2
271    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
272end sub
273
274sub callTestOnError(resumeNext)
275    on error resume next
276    call testOnError(resumeNext)
277    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
278end sub
279
280x = 0
281call callTestOnError(true)
282call ok(x = 2, "x = " & x)
283
284x = 0
285call callTestOnError(false)
286call ok(x = 1, "x = " & x)
287
288sub testOnErrorClear()
289    on error resume next
290    call ok(Err.Number = 0, "Err.Number = " & Err.Number)
291    throwInt(E_TESTERROR)
292    call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
293
294    on error goto 0
295    call ok(Err.Number = 0, "Err.Number = " & Err.Number)
296    x = "ok"
297end sub
298
299call testOnErrorClear()
300call ok(x = "ok", "testOnErrorClear failed")
301
302sub testForEachError()
303    on error resume next
304
305    dim x, y
306    y = false
307    for each x in empty
308        y = true
309    next
310    call ok(y, "for each not executed")
311    call todo_wine_ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = " & Err.Number)
312end sub
313
314call testForEachError()
315
316sub testHresMap(hres, code)
317    on error resume next
318
319    call Err.Clear()
320    call throwInt(hres)
321    call ok(Err.Number = code, "throw(" & hex(hres) & ") Err.Number = " & Err.Number)
322end sub
323
324testHresMap E_NOTIMPL, 445
325testHresMap E_NOINTERFACE, 430
326testHresMap DISP_E_UNKNOWNINTERFACE, 438
327testHresMap DISP_E_MEMBERNOTFOUND, 438
328testHresMap DISP_E_PARAMNOTFOUND, 448
329testHresMap DISP_E_TYPEMISMATCH, 13
330testHresMap DISP_E_UNKNOWNNAME, 438
331testHresMap DISP_E_NONAMEDARGS, 446
332testHresMap DISP_E_BADVARTYPE, 458
333testHresMap DISP_E_OVERFLOW, 6
334testHresMap DISP_E_BADINDEX, 9
335testHresMap DISP_E_UNKNOWNLCID, 447
336testHresMap DISP_E_ARRAYISLOCKED, 10
337testHresMap DISP_E_BADPARAMCOUNT, 450
338testHresMap DISP_E_PARAMNOTOPTIONAL, 449
339testHresMap DISP_E_NOTACOLLECTION, 451
340testHresMap TYPE_E_DLLFUNCTIONNOTFOUND, 453
341testHresMap TYPE_E_TYPEMISMATCH, 13
342testHresMap TYPE_E_OUTOFBOUNDS, 9
343testHresMap TYPE_E_IOERROR, 57
344testHresMap TYPE_E_CANTCREATETMPFILE, 322
345testHresMap STG_E_FILENOTFOUND, 432
346testHresMap STG_E_PATHNOTFOUND, 76
347testHresMap STG_E_TOOMANYOPENFILES, 67
348testHresMap STG_E_ACCESSDENIED, 70
349testHresMap STG_E_INSUFFICIENTMEMORY, 7
350testHresMap STG_E_NOMOREFILES, 67
351testHresMap STG_E_DISKISWRITEPROTECTED, 70
352testHresMap STG_E_WRITEFAULT, 57
353testHresMap STG_E_READFAULT, 57
354testHresMap STG_E_SHAREVIOLATION, 75
355testHresMap STG_E_LOCKVIOLATION, 70
356testHresMap STG_E_FILEALREADYEXISTS, 58
357testHresMap STG_E_MEDIUMFULL, 61
358testHresMap STG_E_INVALIDNAME, 53
359testHresMap STG_E_INUSE, 70
360testHresMap STG_E_NOTCURRENT, 70
361testHresMap STG_E_CANTSAVE, 57
362testHresMap REGDB_E_CLASSNOTREG, 429
363testHresMap MK_E_UNAVAILABLE, 429
364testHresMap MK_E_INVALIDEXTENSION, 432
365testHresMap MK_E_CANTOPENFILE, 432
366testHresMap CO_E_CLASSSTRING, 429
367testHresMap CO_E_APPNOTFOUND, 429
368testHresMap O_E_APPDIDNTREG, 429
369testHresMap E_ACCESSDENIED, 70
370testHresMap E_OUTOFMEMORY, 7
371testHresMap E_INVALIDARG, 5
372testHresMap RPC_S_SERVER_UNAVAILABLE, 462
373testHresMap CO_E_SERVER_EXEC_FAILURE, 429
374
375sub testVBErrorCodes()
376    on error resume next
377
378    Err.clear()
379    throwInt(&h800a00aa&)
380    call ok(Err.number = 170, "Err.number = " & Err.number)
381
382    Err.clear()
383    throwInt(&h800a10aa&)
384    call ok(Err.number = 4266, "Err.number = " & Err.number)
385end sub
386
387call testVBErrorCodes
388
389call reportSuccess()
390