huwcampbell.com
Reactos
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()