?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
bump product version to 5.0.4.1
[LibreOffice.git] / testtools / source / bridgetest / cli / cli_vb_bridgetest.vb
blob9b55cad6ee16fd4946bed0499290a55b13ea3b41
1 '
2 ' This file is part of the LibreOffice project.
3 '
4 ' This Source Code Form is subject to the terms of the Mozilla Public
5 ' License, v. 2.0. If a copy of the MPL was not distributed with this
6 ' file, You can obtain one at http://mozilla.org/MPL/2.0/.
7 '
8 ' This file incorporates work covered by the following license notice:
9 '
10 ' Licensed to the Apache Software Foundation (ASF) under one or more
11 ' contributor license agreements. See the NOTICE file distributed
12 ' with this work for additional information regarding copyright
13 ' ownership. The ASF licenses this file to you under the Apache
14 ' License, Version 2.0 (the "License"); you may not use this file
15 ' except in compliance with the License. You may obtain a copy of
16 ' the License at http://www.apache.org/licenses/LICENSE-2.0 .
17 '
18
19 Option Explicit On
20 Option Strict On
21
22 imports System
23 imports uno
24 imports uno.util
25 imports unoidl.com.sun.star.lang
26 imports unoidl.com.sun.star.uno
27 'imports unoidl.com.sun.star.test.bridge
28 imports unoidl.test.testtools.bridgetest
29 imports System.Windows.Forms
30 imports System.Diagnostics
31 imports System.Reflection
32
33 Class CONSTANTS
34 Friend Shared STRING_TEST_CONSTANT As String = """ paco\' chorizo\\\' ""\'"
35 End Class
36
37 Namespace foo
38
39 Public Interface MyInterface
40 End Interface
41 End Namespace
42
43 Namespace vb_bridetest
44 Class ORecursiveCall
45 Inherits WeakBase
46 Implements XRecursiveCall
47
48 Overridable Sub callRecursivly(xCall As XRecursiveCall, nToCall As Integer) _
49 Implements XRecursiveCall.callRecursivly
50 SyncLock Me
51 If nToCall > 0
52 nToCall = nToCall - 1
53 xCall.callRecursivly(Me, nToCall)
54 End If
55 End SyncLock
56 End Sub
57 End Class
58
59
60
61
62 Public Class BridgeTest
63 Inherits uno.util.WeakBase
64 Implements XMain
65
66 Private m_xContext As XComponentContext
67
68 Public Sub New( xContext As unoidl.com.sun.star.uno.XComponentContext )
69 mybase.New()
70 m_xContext = xContext
71 End Sub
72
73 Private Shared Function check( b As Boolean , message As String ) As Boolean
74 If Not b
75 Console.WriteLine("{0} failed\n" , message)
76 End If
77 Return b
78 End Function
79
80 Private Shared Sub assign( rData As TestElement, bBool As Boolean, _
81 aChar As Char, nByte As Byte, nShort As Short, nUShort As UInt16, _
82 nLong As Integer, nULong As UInt32, nHyper As Long, _
83 nUHyper As UInt64, fFloat As Single, fDouble As Double, _
84 eEnum As TestEnum, rStr As String, xTest As Object, _
85 rAny As Any)
86
87 rData.Bool = bBool
88 rData.Char = aChar
89 rData.Byte = nByte
90 rData.Short = nShort
91 rData.UShort = nUShort
92 rData.Long = nLong
93 rData.ULong = nULong
94 rData.Hyper = nHyper
95 rData.UHyper = nUHyper
96 rData.Float = fFloat
97 rData.Double = fDouble
98 rData.Enum = eEnum
99 rData.String = rStr
100 rData.Interface = xTest
101 rData.Any = rAny
102 End Sub
103
104 Private Shared Sub assign( rData As TestDataElements, bBool As Boolean, _
105 aChar As Char, nByte As Byte, nShort As Short, nUShort As UInt16, _
106 nLong As Integer, nULong As UInt32, nHyper As Long, _
107 nUHyper As UInt64, fFloat As Single, fDouble As Double, _
108 eEnum As TestEnum, rStr As String, xTest As Object, _
109 rAny As Any, rSequence() As TestElement)
110
111 assign( DirectCast( rData,TestElement), _
112 bBool, aChar, nByte, nShort, nUShort, nLong, nULong, nHyper, _
113 nUHyper, fFloat, fDouble, eEnum, rStr, xTest, rAny )
114 rData.Sequence = rSequence
115 End Sub
116
117 Private Shared Function compareData(val1 As Object, val2 As Object) As Boolean
118 If val1 Is Nothing And val2 Is Nothing OrElse _
119 val1 Is val2
120 Return True
121 End If
122 If val1 Is Nothing And Not(val2 Is Nothing) OrElse _
123 Not (val1 Is Nothing) And val2 Is Nothing OrElse _
124 Not val1.GetType().Equals( val2.GetType())
125 Return False
126 End If
127
128 Dim ret As Boolean = False
129 Dim t1 As Type = val1.GetType()
130 'Sequence
131 If t1.IsArray()
132 ret = compareSequence(DirectCast( val1, Array), _
133 DirectCast( val2, Array))
134 'String
135 ElseIf TypeOf val1 Is String
136 ret = DirectCast( val1, string) = DirectCast( val2, string)
137 ' Interface implementation
138 ElseIf t1.GetInterfaces().Length > 0 And Not t1.IsValueType
139 ret = val1 Is val2
140 ' Struct
141 ElseIf Not t1.IsValueType
142 ret = compareStruct(val1, val2)
143 ElseIf TypeOf val1 Is Any
144 Dim a1 As Any = DirectCast( val1, Any)
145 Dim a2 As Any = DirectCast( val2, Any)
146 ret = a1.Type.Equals( a2.Type ) And compareData( a1.Value, a2.Value )
147 ElseIf t1.IsValueType
148 'Any, enum, int, bool char, float, double etc.
149 ret = val1.Equals(val2)
150 Else
151 Debug.Assert(False)
152 End If
153 Return ret
154 End Function
155
156 ' Arrays have only one dimension
157 Private Shared Function compareSequence( ar1 As Array, ar2 As Array) As Boolean
158 Debug.Assert( Not (ar1 Is Nothing) And Not (ar2 Is Nothing) )
159 Dim t1 As Type = ar1.GetType()
160 Dim t2 As Type = ar2.GetType()
161
162 if ( Not(ar1.Rank = 1 And ar2.Rank = 1 _
163 And ar1.Length = ar2.Length And t1.GetElementType().Equals(t2.GetElementType())))
164 return False
165 End If
166 'arrays have same rank and size and element type.
167 Dim len As Integer = ar1.Length
168 Dim elemType As Type = t1.GetElementType()
169 Dim ret As Boolean = True
170 Dim i As Integer
171 For i = 0 To len - 1
172 If (compareData(ar1.GetValue(i), ar2.GetValue(i)) = False)
173 ret = False
174 Exit For
175 End If
176 Next i
177
178 Return ret
179 End Function
180
181 Private Shared Function compareStruct( val1 As Object, val2 As Object) As Boolean
182 Debug.Assert( Not(val1 Is Nothing) And Not(val2 Is Nothing))
183 Dim t1 As Type = val1.GetType()
184 Dim t2 As Type = val2.GetType()
185 If Not t1.Equals(t2)
186 Return False
187 End If
188 Dim fields() As FieldInfo = t1.GetFields()
189 Dim cFields As Integer = fields.Length
190 Dim ret As Boolean = True
191 Dim i As Integer
192 For i = 0 To cFields - 1
193 Dim fieldVal1 As Object = fields(i).GetValue(val1)
194 Dim fieldVal2 As Object = fields(i).GetValue(val2)
195 If Not compareData(fieldVal1, fieldVal2)
196 ret = False
197 Exit For
198 End If
199 Next i
200 Return ret
201 End Function
202
203
204 Private Shared Function performSequenceTest(xBT As XBridgeTest) As Boolean
205 Dim bRet As Boolean = True
206 'Automati cast ?? like with COM objects
207 Dim xBT2 As XBridgeTest2
208 Try
209 xBT2 = DirectCast(xBT,XBridgeTest2)
210 Catch e As InvalidCastException
211 Return False
212 End Try
213
214 ' perform sequence tests (XBridgeTest2)
215 'create the sequence which are compared with the results
216 Dim arBool() As Boolean = {True, False, True}
217 Dim arChar() As Char = {"A"C,"B"C,"C"C}
218 Dim arByte() As Byte = { 1, 2, &Hff}
219 Dim arShort() As Short = {Int16.MinValue, 1, Int16.MaxValue}
220 Dim arUShort() As UInt16 = {Convert.ToUInt16(0), Convert.ToUInt16(1), _
221 Convert.ToUInt16(&Hffff)}
222 Dim arLong() As Integer = {Int32.MinValue, 1, Int32.MaxValue}
223 Dim arULong() As UInt32 = {Convert.ToUInt32(0), Convert.ToUInt32(1), _
224 Convert.ToUInt32(&HffffffffL)}
225 Dim arHyper() As Long = {Int64.MinValue, 1, Int64.MaxValue}
226 Dim arUHyper() As UInt64 = {Convert.ToUInt64(0), Convert.ToUInt64(1), _
227 Convert.ToUInt64(&Hffffffff5L)}
228 Dim arFloat() As Single = {1.1f, 2.2f, 3.3f}
229 Dim arDouble() As Double = {1.11, 2.22, 3.33}
230 Dim arString() As String = {"String 1", "String 2", "String 3"}
231
232 Dim arAny() As Any = {New Any(True), New Any(11111), New Any(3.14)}
233 Dim arObject() As Object = {New WeakBase(), New WeakBase(), New WeakBase()}
234 Dim arEnum() As TestEnum = {TestEnum.ONE, TestEnum.TWO, TestEnum.CHECK}
235
236 Dim arStruct() As TestElement = {New TestElement(), New TestElement(), _
237 New TestElement()}
238 assign( arStruct(0), True, "@"C, 17, &H1234, Convert.ToUInt16(&Hfedc), _
239 &H12345678, Convert.ToUInt32(&H123456), &H123456789abcdef0, _
240 Convert.ToUInt64(123456788), 17.0815F, 3.1415926359, _
241 TestEnum.LOLA, CONSTANTS.STRING_TEST_CONSTANT, arObject(0), _
242 New Any(GetType(System.Object), arObject(0)))
243 assign( arStruct(1), True, "A"C, 17, &H1234, Convert.ToUInt16(&Hfedc), _
244 &H12345678, Convert.ToUInt32(&H123456), &H123456789abcdef0, _
245 Convert.ToUInt64(12345678), 17.0815F, 3.1415926359, _
246 TestEnum.TWO, CONSTANTS.STRING_TEST_CONSTANT, arObject(1), _
247 New Any(GetType(System.Object), arObject(1)) )
248 assign( arStruct(2), True, "B"C, 17, &H1234, Convert.ToUInt16(&Hfedc), _
249 &H12345678, Convert.ToUInt32(654321), &H123456789abcdef0, _
250 Convert.ToUInt64(87654321), 17.0815F, 3.1415926359, _
251 TestEnum.CHECK, Constants.STRING_TEST_CONSTANT, arObject(2), _
252 New Any(GetType(System.Object), arObject(2)))
253
254
255 Dim arLong3()()() As Integer = New Integer()()() { _
256 New Integer()(){New Integer(){1,2,3},New Integer(){4,5,6}, New Integer(){7,8,9} }, _
257 New Integer ()(){New Integer(){1,2,3},New Integer(){4,5,6}, New Integer(){7,8,9}}, _
258 New Integer()(){New Integer(){1,2,3},New Integer(){4,5,6}, New Integer(){7,8,9}}}
259
260 Dim seqSeqRet()() As Integer = xBT2.setDim2(arLong3(0))
261 bRet = check( compareData(seqSeqRet, arLong3(0)), "sequence test") _
262 And bRet
263 Dim seqSeqRet2()()() As Integer = xBT2.setDim3(arLong3)
264 bRet = check( compareData(seqSeqRet2, arLong3), "sequence test") _
265 And bRet
266 Dim seqAnyRet() As Any = xBT2.setSequenceAny(arAny)
267 bRet = check( compareData(seqAnyRet, arAny), "sequence test") And bRet
268 Dim seqBoolRet() As Boolean = xBT2.setSequenceBool(arBool)
269 bRet = check( compareData(seqBoolRet, arBool), "sequence test") _
270 And bRet
271 Dim seqByteRet() As Byte = xBT2.setSequenceByte(arByte)
272 bRet = check( compareData(seqByteRet, arByte), "sequence test") _
273 And bRet
274 Dim seqCharRet() As Char = xBT2.setSequenceChar(arChar)
275 bRet = check( compareData(seqCharRet, arChar), "sequence test") _
276 And bRet
277 Dim seqShortRet() As Short = xBT2.setSequenceShort(arShort)
278 bRet = check( compareData(seqShortRet, arShort), "sequence test") _
279 And bRet
280 Dim seqLongRet() As Integer = xBT2.setSequenceLong(arLong)
281 bRet = check( compareData(seqLongRet, arLong), "sequence test") _
282 And bRet
283 Dim seqHyperRet() As Long = xBT2.setSequenceHyper(arHyper)
284 bRet = check( compareData(seqHyperRet,arHyper), "sequence test") _
285 And bRet
286 Dim seqFloatRet() As Single = xBT2.setSequenceFloat(arFloat)
287 bRet = check( compareData(seqFloatRet, arFloat), "sequence test") _
288 And bRet
289 Dim seqDoubleRet() As Double= xBT2.setSequenceDouble(arDouble)
290 bRet = check( compareData(seqDoubleRet, arDouble), "sequence test") _
291 And bRet
292 Dim seqEnumRet() As TestEnum = xBT2.setSequenceEnum(arEnum)
293 bRet = check( compareData(seqEnumRet, arEnum), "sequence test") _
294 And bRet
295 Dim seqUShortRet() As UInt16 = xBT2.setSequenceUShort(arUShort)
296 bRet = check( compareData(seqUShortRet, arUShort), "sequence test") _
297 And bRet
298 Dim seqULongRet() As UInt32 = xBT2.setSequenceULong(arULong)
299 bRet = check( compareData(seqULongRet, arULong), "sequence test") _
300 And bRet
301 Dim seqUHyperRet() As UInt64 = xBT2.setSequenceUHyper(arUHyper)
302 bRet = check( compareData(seqUHyperRet, arUHyper), "sequence test") _
303 And bRet
304 Dim seqObjectRet() As Object = xBT2.setSequenceXInterface(arObject)
305 bRet = check( compareData(seqObjectRet, arObject), "sequence test") _
306 And bRet
307 Dim seqStringRet() As String = xBT2.setSequenceString(arString)
308 bRet = check( compareData(seqStringRet, arString), "sequence test") _
309 And bRet
310 Dim seqStructRet() As TestElement = xBT2.setSequenceStruct(arStruct)
311 bRet = check( compareData(seqStructRet, arStruct), "sequence test") _
312 And bRet
313
314
315 Dim arBoolTemp() As Boolean = DirectCast(arBool.Clone(), Boolean())
316 Dim arCharTemp() As Char = DirectCast(arChar.Clone(), Char())
317 Dim arByteTemp() As Byte = DirectCast(arByte.Clone(), Byte())
318 Dim arShortTemp() As Short = DirectCast(arShort.Clone(), Short())
319 Dim arUShortTemp() As UInt16 = DirectCast(arUShort.Clone(), UInt16())
320 Dim arLongTemp() As Integer= DirectCast(arLong.Clone(), Integer())
321 Dim arULongTemp() As UInt32 = DirectCast(arULong.Clone(), UInt32())
322 Dim arHyperTemp() As Long = DirectCast(arHyper.Clone(), Long())
323 Dim arUHyperTemp() As UInt64 = DirectCast(arUHyper.Clone(), UInt64())
324 Dim arFloatTemp() As Single = DirectCast(arFloat.Clone(), Single())
325 Dim arDoubleTemp() As Double = DirectCast(arDouble.Clone(), Double())
326 Dim arEnumTemp() As TestEnum = DirectCast(arEnum.Clone(), TestEnum())
327 Dim arStringTemp() As String = DirectCast(arString.Clone(), String())
328 Dim arObjectTemp() As Object = DirectCast(arObject.Clone(), Object())
329 Dim arAnyTemp() As Any = DirectCast(arAny.Clone(), Any())
330 ' make sure this are has the same contents as arLong3(0)
331 Dim arLong2Temp()() As Integer = New Integer()(){New Integer(){1,2,3}, _
332 New Integer(){4,5,6}, New Integer(){7,8,9} }
333 ' make sure this are has the same contents as arLong3
334 Dim arLong3Temp()()() As Integer = New Integer()()(){ _
335 New Integer()(){New Integer(){1,2,3},New Integer(){4,5,6}, New Integer(){7,8,9} }, _
336 New Integer ()(){New Integer(){1,2,3},New Integer(){4,5,6}, New Integer(){7,8,9}}, _
337 New Integer()(){New Integer(){1,2,3},New Integer(){4,5,6}, New Integer(){7,8,9}}}
338
339 xBT2.setSequencesInOut( arBoolTemp, arCharTemp, arByteTemp, _
340 arShortTemp, arUShortTemp, arLongTemp, _
341 arULongTemp, arHyperTemp, arUHyperTemp, _
342 arFloatTemp, arDoubleTemp, arEnumTemp, _
343 arStringTemp, arObjectTemp, _
344 arAnyTemp, arLong2Temp, arLong3Temp)
345 bRet = check( _
346 compareData(arBoolTemp, arBool) And _
347 compareData(arCharTemp , arChar) And _
348 compareData(arByteTemp , arByte) And _
349 compareData(arShortTemp , arShort) And _
350 compareData(arUShortTemp , arUShort) And _
351 compareData(arLongTemp , arLong) And _
352 compareData(arULongTemp , arULong) And _
353 compareData(arHyperTemp , arHyper) And _
354 compareData(arUHyperTemp , arUHyper) And _
355 compareData(arFloatTemp , arFloat) And _
356 compareData(arDoubleTemp , arDouble) And _
357 compareData(arEnumTemp , arEnum) And _
358 compareData(arStringTemp , arString) And _
359 compareData(arObjectTemp , arObject) And _
360 compareData(arAnyTemp , arAny) And _
361 compareData(arLong2Temp , arLong3(0)) And _
362 compareData(arLong3Temp , arLong3), "sequence test") And bRet
363
364 Dim arBoolOut() As Boolean
365 Dim arCharOut() As Char
366 Dim arByteOut() As Byte
367 Dim arShortOut() As Short
368 Dim arUShortOut() As UInt16
369 Dim arLongOut() As Integer
370 Dim arULongOut() As UInt32
371 Dim arHyperOut() As Long
372 Dim arUHyperOut() As UInt64
373 Dim arFloatOut() As Single
374 Dim arDoubleOut() As Double
375 Dim arEnumOut() As TestEnum
376 Dim arStringOut() As String
377 Dim arObjectOut() As Object
378 Dim arAnyOut() As Any
379 Dim arLong2Out()() As Integer
380 Dim arLong3Out()()() As Integer
381
382 xBT2.setSequencesOut( arBoolOut, arCharOut, arByteOut, _
383 arShortOut, arUShortOut, arLongOut, _
384 arULongOut, arHyperOut, arUHyperOut, _
385 arFloatOut, arDoubleOut, arEnumOut, _
386 arStringOut, arObjectOut, arAnyOut, _
387 arLong2Out, arLong3Out)
388 bRet = check( _
389 compareData(arBoolOut, arBool) And _
390 compareData(arCharOut, arChar) And _
391 compareData(arByteOut, arByte) And _
392 compareData(arShortOut, arShort) And _
393 compareData(arUShortOut, arUShort) And _
394 compareData(arLongOut, arLong) And _
395 compareData(arULongOut, arULong) And _
396 compareData(arHyperOut, arHyper) And _
397 compareData(arUHyperOut, arUHyper) And _
398 compareData(arFloatOut, arFloat) And _
399 compareData(arDoubleOut, arDouble) And _
400 compareData(arEnumOut, arEnum) And _
401 compareData(arStringOut, arString) And _
402 compareData(arObjectOut, arObject) And _
403 compareData(arAnyOut, arAny) And _
404 compareData(arLong2Out, arLong3(0)) And _
405 compareData(arLong3Out, arLong3), "sequence test") And bRet
406
407
408 'test with empty sequences
409 Dim _arLong2()() As Integer = New Integer()(){}
410 seqSeqRet = xBT2.setDim2(_arLong2)
411 bRet = check( compareData(seqSeqRet, _arLong2), "sequence test") And bRet
412 Dim _arLong3()()() As Integer = New Integer()()(){}
413 seqSeqRet2 = xBT2.setDim3(_arLong3)
414 bRet = check( compareData(seqSeqRet2, _arLong3), "sequence test") And bRet
415 Dim _arAny() As Any = New Any(){}
416 seqAnyRet = xBT2.setSequenceAny(_arAny)
417 bRet = check( compareData(seqAnyRet, _arAny), "sequence test") And bRet
418 Dim _arBool() As Boolean = New Boolean() {}
419 seqBoolRet = xBT2.setSequenceBool(_arBool)
420 bRet = check( compareData(seqBoolRet, _arBool), "sequence test") And bRet
421 Dim _arByte() As Byte = New Byte() {}
422 seqByteRet = xBT2.setSequenceByte(_arByte)
423 bRet = check( compareData(seqByteRet, _arByte), "sequence test") And bRet
424 Dim _arChar() As Char = New Char() {}
425 seqCharRet = xBT2.setSequenceChar(_arChar)
426 bRet = check( compareData(seqCharRet, _arChar), "sequence test") And bRet
427 Dim _arShort() As Short = New Short() {}
428 seqShortRet = xBT2.setSequenceShort(_arShort)
429 bRet = check( compareData(seqShortRet, _arShort), "sequence test") And bRet
430 Dim _arLong() As Integer = New Integer() {}
431 seqLongRet = xBT2.setSequenceLong(_arLong)
432 bRet = check( compareData(seqLongRet, _arLong), "sequence test") And bRet
433 Dim _arHyper() As Long = New Long(){}
434 seqHyperRet = xBT2.setSequenceHyper(_arHyper)
435 bRet = check( compareData(seqHyperRet, _arHyper), "sequence test") And bRet
436 Dim _arFloat() As Single = New Single(){}
437 seqFloatRet = xBT2.setSequenceFloat(_arFloat)
438 bRet = check( compareData(seqFloatRet, _arFloat), "sequence test") And bRet
439 Dim _arDouble() As Double = New Double(){}
440 seqDoubleRet = xBT2.setSequenceDouble(_arDouble)
441 bRet = check( compareData(seqDoubleRet, _arDouble), "sequence test") And bRet
442 Dim _arEnum() As TestEnum = New TestEnum(){}
443 seqEnumRet = xBT2.setSequenceEnum(_arEnum)
444 bRet = check( compareData(seqEnumRet, _arEnum), "sequence test") And bRet
445 Dim _arUShort() As UInt16 = New UInt16(){}
446 seqUShortRet = xBT2.setSequenceUShort(_arUShort)
447 bRet = check( compareData(seqUShortRet, _arUShort), "sequence test") And bRet
448 Dim _arULong() As UInt32 = New UInt32(){}
449 seqULongRet = xBT2.setSequenceULong(_arULong)
450 bRet = check( compareData(seqULongRet, _arULong), "sequence test") And bRet
451 Dim _arUHyper() As UInt64 = New UInt64(){}
452 seqUHyperRet = xBT2.setSequenceUHyper(_arUHyper)
453 bRet = check( compareData(seqUHyperRet, _arUHyper), "sequence test") And bRet
454 Dim _arObject() As Object = New Object(){}
455 seqObjectRet = xBT2.setSequenceXInterface(_arObject)
456 bRet = check( compareData(seqObjectRet, _arObject), "sequence test") And bRet
457 Dim _arString() As String = New String(){}
458 seqStringRet = xBT2.setSequenceString(_arString)
459 bRet = check( compareData(seqStringRet, _arString), "sequence test") And bRet
460 Dim _arStruct() As TestElement = New TestElement(){}
461 seqStructRet = xBT2.setSequenceStruct(_arStruct)
462 bRet = check( compareData(seqStructRet, _arStruct), "sequence test") And bRet
463 Return bRet
464 End Function
465
466 Private Shared Function testAny(typ As Type, value As Object, _
467 xLBT As XBridgeTest ) As Boolean
468
469 Dim any As Any
470 If (typ Is Nothing)
471 any = New Any(value.GetType(), value)
472 Else
473 any = New Any(typ, value)
474 End If
475
476 Dim any2 As Any = xLBT.transportAny(any)
477 Dim ret As Boolean = compareData(any, any2)
478 If ret = False
479 Console.WriteLine("any is different after roundtrip: in {0}, " _
480 & "out {1}\n", _
481 any.Type.FullName, any2.Type.FullName)
482 End If
483 Return ret
484 End Function
485
486 Private Shared Function performAnyTest(xLBT As XBridgeTest, _
487 data As TestDataElements) As Boolean
488 Dim bReturn As Boolean = True
489 bReturn = testAny( Nothing, data.Byte ,xLBT ) And bReturn
490 bReturn = testAny( Nothing, data.Short,xLBT ) And bReturn
491 bReturn = testAny( Nothing, data.UShort,xLBT ) And bReturn
492 bReturn = testAny( Nothing, data.Long,xLBT ) And bReturn
493 bReturn = testAny( Nothing, data.ULong,xLBT ) And bReturn
494 bReturn = testAny( Nothing, data.Hyper,xLBT ) And bReturn
495 bReturn = testAny( Nothing,data.UHyper,xLBT ) And bReturn
496 bReturn = testAny( Nothing, data.Float,xLBT ) And bReturn
497 bReturn = testAny( Nothing, data.Double,xLBT ) And bReturn
498 bReturn = testAny( Nothing, data.Enum,xLBT ) And bReturn
499 bReturn = testAny( Nothing, data.String,xLBT ) And bReturn
500 bReturn = testAny(GetType(unoidl.com.sun.star.uno.XWeak), _
501 data.Interface,xLBT ) And bReturn
502 bReturn = testAny(Nothing, data, xLBT ) And bReturn
503
504 Dim a1 As Any = New Any(True)
505 Dim a2 As Any = xLBT.transportAny( a1 )
506 bReturn = compareData(a2, a1) And bReturn
507
508 Dim a3 As Any = New Any("A"C)
509 Dim a4 As Any = xLBT.transportAny(a3)
510 bReturn = compareData(a4, a3) And bReturn
511
512 Return bReturn
513 End Function
514
515 Private Shared Function performSequenceOfCallTest(xLBT As XBridgeTest) As Boolean
516
517 Dim i, nRounds As Integer
518 Dim nGlobalIndex As Integer = 0
519 const nWaitTimeSpanMUSec As Integer = 10000
520 For nRounds = 0 To 9
521 For i = 0 To nRounds - 1
522 ' fire oneways
523 xLBT.callOneway(nGlobalIndex, nWaitTimeSpanMUSec)
524 nGlobalIndex = nGlobalIndex + 1
525 Next
526
527 ' call synchron
528 xLBT.call(nGlobalIndex, nWaitTimeSpanMUSec)
529 nGlobalIndex = nGlobalIndex + 1
530 Next
531 Return xLBT.sequenceOfCallTestPassed()
532 End Function
533
534 Private Shared Function performRecursiveCallTest(xLBT As XBridgeTest) As Boolean
535 xLBT.startRecursiveCall(new ORecursiveCall(), 50)
536 ' on failure, the test would lock up or crash
537 Return True
538 End Function
539
540
541 Private Shared Function performTest(xLBT As XBridgeTest) As Boolean
542 check( Not xLBT Is Nothing, "### no test interface!" )
543 Dim bRet As Boolean = True
544 If xLBT Is Nothing
545 Return False
546 End If
547 'this data is never ever granted access to by calls other than equals(), assign()!
548 Dim aData As New TestDataElements' test against this data
549 Dim xI As New WeakBase
550
551 Dim aAny As New Any(GetType(System.Object), xI)
552 assign( DirectCast(aData, TestElement), _
553 True, "@"C, 17, &H1234, Convert.ToUInt16(&HdcS), &H12345678, _
554 Convert.ToUInt32(4294967294), _
555 &H123456789abcdef0, Convert.ToUInt64(14294967294), _
556 17.0815f, 3.1415926359, TestEnum.LOLA, _
557 CONSTANTS.STRING_TEST_CONSTANT, xI, _
558 aAny)
559
560 bRet = check( aData.Any.Value Is xI, "### unexpected any!" ) And bRet
561
562 aData.Sequence = New TestElement(1){}
563 aData.Sequence(0) = New TestElement( _
564 aData.Bool, aData.Char, aData.Byte, aData.Short, _
565 aData.UShort, aData.Long, aData.ULong, _
566 aData.Hyper, aData.UHyper, aData.Float, _
567 aData.Double, aData.Enum, aData.String, _
568 aData.Interface, aData.Any)
569 aData.Sequence(1) = New TestElement 'is empty
570
571 ' aData complete
572 '
573 ' this is a manually copy of aData for first setting...
574 Dim aSetData As New TestDataElements
575 Dim aAnySet As New Any(GetType(System.Object), xI)
576 assign( DirectCast(aSetData, TestElement), _
577 aData.Bool, aData.Char, aData.Byte, aData.Short, aData.UShort, _
578 aData.Long, aData.ULong, aData.Hyper, aData.UHyper, aData.Float, _
579 aData.Double, aData.Enum, aData.String, xI, aAnySet)
580
581 aSetData.Sequence = New TestElement(1){}
582 aSetData.Sequence(0) = New TestElement( _
583 aSetData.Bool, aSetData.Char, aSetData.Byte, aSetData.Short, _
584 aSetData.UShort, aSetData.Long, aSetData.ULong, _
585 aSetData.Hyper, aSetData.UHyper, aSetData.Float, _
586 aSetData.Double, aSetData.Enum, aSetData.String, _
587 aSetData.Interface, aSetData.Any)
588 aSetData.Sequence(1) = New TestElement ' empty struct
589
590 xLBT.setValues( _
591 aSetData.Bool, aSetData.Char, aSetData.Byte, aSetData.Short, _
592 aSetData.UShort, aSetData.Long, aSetData.ULong, _
593 aSetData.Hyper, aSetData.UHyper, aSetData.Float, _
594 aSetData.Double, aSetData.Enum, aSetData.String, _
595 aSetData.Interface, aSetData.Any, aSetData.Sequence, _
596 aSetData )
597
598
599 Dim aRet As New TestDataElements
600 Dim aRet2 As New TestDataElements
601 xLBT.getValues( _
602 aRet.Bool, aRet.Char, aRet.Byte, aRet.Short, _
603 aRet.UShort, aRet.Long, aRet.ULong, _
604 aRet.Hyper, aRet.UHyper, aRet.Float, _
605 aRet.Double, aRet.Enum, aRet.String, _
606 aRet.Interface, aRet.Any, aRet.Sequence, _
607 aRet2 )
608
609 bRet = check( compareData( aData, aRet ) And _
610 compareData( aData, aRet2 ) , "getValues test") And bRet
611
612 ' set last retrieved values
613 Dim aSV2ret As TestDataElements= xLBT.setValues2( _
614 aRet.Bool, aRet.Char, aRet.Byte, _
615 aRet.Short, aRet.UShort, aRet.Long, _
616 aRet.ULong, aRet.Hyper, aRet.UHyper, _
617 aRet.Float, aRet.Double, aRet.Enum, _
618 aRet.String, aRet.Interface, aRet.Any, _
619 aRet.Sequence, aRet2 )
620
621 ' check inout sequence order
622 ' => inout sequence parameter was switched by test objects
623 Dim temp As TestElement = aRet.Sequence( 0 )
624 aRet.Sequence( 0 ) = aRet.Sequence( 1 )
625 aRet.Sequence( 1 ) = temp
626
627 bRet = check( _
628 compareData( aData, aSV2ret ) And compareData( aData, aRet2 ), _
629 "getValues2 test") And bRet
630
631
632 aRet = New TestDataElements
633 aRet2 = New TestDataElements
634 Dim aGVret As TestDataElements= xLBT.getValues( _
635 aRet.Bool, aRet.Char, aRet.Byte, _
636 aRet.Short, aRet.UShort, aRet.Long, _
637 aRet.ULong, aRet.Hyper, aRet.UHyper, _
638 aRet.Float, aRet.Double, aRet.Enum, _
639 aRet.String, aRet.Interface, aRet.Any, _
640 aRet.Sequence, aRet2 )
641
642 bRet = check( compareData( aData, aRet ) And _
643 compareData( aData, aRet2 ) And _
644 compareData( aData, aGVret ), "getValues test" ) And bRet
645
646 ' set last retrieved values
647 xLBT.Bool = aRet.Bool
648 xLBT.Char = aRet.Char
649 xLBT.Byte = aRet.Byte
650 xLBT.Short = aRet.Short
651 xLBT.UShort = aRet.UShort
652 xLBT.Long = aRet.Long
653 xLBT.ULong = aRet.ULong
654 xLBT.Hyper = aRet.Hyper
655 xLBT.UHyper = aRet.UHyper
656 xLBT.Float = aRet.Float
657 xLBT.Double = aRet.Double
658 xLBT.Enum = aRet.Enum
659 xLBT.String = aRet.String
660 xLBT.Interface = aRet.Interface
661 xLBT.Any = aRet.Any
662 xLBT.Sequence = aRet.Sequence
663 xLBT.Struct = aRet2
664
665
666 aRet = New TestDataElements
667 aRet2 = New TestDataElements
668 aRet.Hyper = xLBT.Hyper
669 aRet.UHyper = xLBT.UHyper
670 aRet.Float = xLBT.Float
671 aRet.Double = xLBT.Double
672 aRet.Byte = xLBT.Byte
673 aRet.Char = xLBT.Char
674 aRet.Bool = xLBT.Bool
675 aRet.Short = xLBT.Short
676 aRet.UShort = xLBT.UShort
677 aRet.Long = xLBT.Long
678 aRet.ULong = xLBT.ULong
679 aRet.Enum = xLBT.Enum
680 aRet.String = xLBT.String
681 aRet.Interface = xLBT.Interface
682 aRet.Any = xLBT.Any
683 aRet.Sequence = xLBT.Sequence
684 aRet2 = xLBT.Struct
685
686 bRet = check( compareData( aData, aRet ) And _
687 compareData( aData, aRet2 ) , "struct comparison test") _
688 And bRet
689
690 bRet = check(performSequenceTest(xLBT), "sequence test") And bRet
691
692 ' any test
693 bRet = check( performAnyTest( xLBT , aData ) , "any test" ) And bRet
694
695 'sequence of call test
696 bRet = check( performSequenceOfCallTest( xLBT ) , _
697 "sequence of call test" ) And bRet
698
699 ' recursive call test
700 bRet = check( performRecursiveCallTest( xLBT ) , "recursive test" ) _
701 And bRet
702
703 bRet = (compareData( aData, aRet ) And compareData( aData, aRet2 )) _
704 And bRet
705
706 ' check setting of null reference
707 xLBT.Interface = Nothing
708 aRet.Interface = xLBT.Interface
709 bRet = (aRet.Interface Is Nothing) And bRet
710
711 Return bRet
712 End Function
713
714 Private Shared Function raiseException(xLBT As XBridgeTest) As Boolean
715 Dim nCount As Integer = 0
716 Try
717 Try
718 Try
719 Dim aRet As TestDataElements = New TestDataElements
720 Dim aRet2 As TestDataElements = New TestDataElements
721 xLBT.raiseException( _
722 5, CONSTANTS.STRING_TEST_CONSTANT, xLBT.Interface )
723 Catch rExc As unoidl.com.sun.star.lang.IllegalArgumentException
724 If rExc.ArgumentPosition = 5 And _
725 rExc.Context Is xLBT.Interface
726 nCount = nCount + 1
727 Else
728 check( False, "### unexpected exception content!" )
729 End If
730
731 'it is certain, that the RuntimeException testing will fail,
732 ' if no
733 xLBT.RuntimeException = 0
734 End Try
735 Catch rExc As unoidl.com.sun.star.uno.RuntimeException
736 If rExc.Context Is xLBT.Interface
737 nCount = nCount + 1
738 Else
739 check( False, "### unexpected exception content!" )
740 End If
741 xLBT.RuntimeException = CType(&Hcafebabe, Integer)
742 End Try
743 Catch rExc As unoidl.com.sun.star.uno.Exception
744 If rExc.Context Is xLBT.Interface
745 nCount = nCount + 1
746 Else
747 check( False, "### unexpected exception content!" )
748 End If
749 Return nCount = 3
750 End Try
751 Return False
752 End Function
753
754 Private Shared Function raiseOnewayException(xLBT As XBridgeTest) As Boolean
755 Dim bReturn As Boolean= True
756 Dim sCompare As String = CONSTANTS.STRING_TEST_CONSTANT
757 Try
758 ' Note : the exception may fly or not (e.g. remote scenario).
759 ' When it flies, it must contain the correct elements.
760 xLBT.raiseRuntimeExceptionOneway(sCompare, xLBT.Interface )
761 Catch e As RuntimeException
762 bReturn = xLBT.Interface Is e.Context
763 End Try
764 Return bReturn
765 End Function
766
767 'Test the System::Object method on the proxy object
768 '
769 Private Shared Function testObjectMethodsImplemention(xLBT As XBridgeTest) As Boolean
770 Dim ret As Boolean = False
771 Dim obj As Object = New Object
772 Dim xInt As Object = DirectCast(xLBT, Object)
773 Dim xBase As XBridgeTestBase = DirectCast(xLBT, XBridgeTestBase)
774 ' Object.Equals
775 ret = DirectCast(xLBT, Object).Equals(obj) = False
776 ret = DirectCast(xLBT, Object).Equals(xLBT) And ret
777 ret = Object.Equals(obj, obj) And ret
778 ret = Object.Equals(xLBT, xBase) And ret
779 'Object.GetHashCode
780 ' Don't know how to verify this. Currently it is not possible to get the object id from a proxy
781 Dim nHash As Integer = DirectCast(xLBT, Object).GetHashCode()
782 ret = nHash = DirectCast(xBase, Object).GetHashCode() And ret
783
784 'Object.ToString
785 ' Don't know how to verify this automatically.
786 Dim s As String = DirectCast(xLBT, Object).ToString()
787 ret = (s.Length > 0) And ret
788 Return ret
789 End Function
790
791 Private Shared Function performQueryForUnknownType(xLBT As XBridgeTest) As Boolean
792 Dim bRet As Boolean = False
793 ' test queryInterface for an unknown type
794 Try
795 Dim a As foo.MyInterface = DirectCast(xLBT, foo.MyInterface)
796 Catch e As System.InvalidCastException
797 bRet = True
798 End Try
799
800 Return bRet
801 End Function
802
803
804 Private Shared Sub perform_test( xLBT As XBridgeTest)
805 Dim bRet As Boolean = True
806 bRet = check( performTest( xLBT ), "standard test" ) And bRet
807 bRet = check( raiseException( xLBT ) , "exception test" ) And bRet
808 bRet = check( raiseOnewayException( xLBT ), "oneway exception test" ) _
809 And bRet
810 bRet = check( testObjectMethodsImplemention(xLBT), _
811 "object methods test") And bRet
812 bRet = performQueryForUnknownType( xLBT ) And bRet
813 If Not bRet
814 Throw New unoidl.com.sun.star.uno.RuntimeException( "error: test failed!", Nothing)
815 End If
816 End Sub
817
818
819
820 Public Overridable Function run(args() As String) As Integer _
821 Implements XMain.run
822 Try
823 If (args.Length < 1)
824 Throw New RuntimeException( _
825 "missing argument for bridgetest!", Me )
826 End If
827
828 Dim test_obj As Object = _
829 m_xContext.getServiceManager().createInstanceWithContext( _
830 args( 0 ), m_xContext )
831
832 Debug.WriteLine( _
833 "cli target bridgetest obj: {0}", test_obj.ToString() )
834 Dim xTest As XBridgeTest = DirectCast(test_obj, XBridgeTest)
835 perform_test( xTest )
836 Console.WriteLine("### cli_uno VB bridgetest succeeded.")
837 return 0
838 Catch e as unoidl.com.sun.star.uno.RuntimeException
839 Throw
840 Catch e as System.Exception
841 Throw New unoidl.com.sun.star.uno.RuntimeException( _
842 "cli_vb_bridgetest.vb: unexpected exception occurred in XMain::run. " _
843 & "Original exception: " + e.GetType().Name + "\n Message: " _
844 & e.Message , Nothing)
845
846 End Try
847 End Function
848
849 End Class
850
851 End Namespace
FREE OFFICE SUITE