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