RegressionTests__Win32OLETests.st
author Claus Gittinger <cg@exept.de>
Tue, 29 Mar 2016 03:42:35 +0200
changeset 1372 a990b4eb7030
parent 1356 a8e8d673f22e
child 1374 caed36c1303d
permissions -rw-r--r--
#REFACTORING class: RegressionTests::Win32OLETests changed: #test01_SysAllocString

"{ Encoding: utf8 }"

"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#Win32OLETests
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression-RuntimeSystem'
!


!Win32OLETests class methodsFor:'queries'!

coveredPackageNames
    ^ #('exept:ole')
! !

!Win32OLETests methodsFor:'tests'!

test00_loadOLE
    |iid_IEnum|

    OperatingSystem isMSWINDOWSlike ifFalse:[
        Transcript showCR:'test skipped (OS is not WINDOWS)'.
        ^ self.
    ].

    Smalltalk at:#ExternalLibraryFunction:Verbose put:true.
    Smalltalk at:#ObjectFileLoader:Verbose put:true.
    "/
    "/ this will already perform a number of calls into OLE,
    "/ to get the CLSIDs of various wellknown interfaces
    "/ (see OLEInterfaceConstants initialize)
    Smalltalk loadPackage:'exept:ole'.

    "/ so when we arrive here without error, some is already known to work..        
    self assert:(OLEInterfaceConstants notNil).

    iid_IEnum := OLEInterfaceConstants classVarAt:#'IID_IEnum'.
    self assert:(iid_IEnum notNil).
    self assert:(iid_IEnum class == GUID).
    self assert:(iid_IEnum printString = '{2AE64960-CDDD-101C-9029-040224007802}').

    "
     self new test00_loadOLE
    "
!

test01_SysAllocString
    |ole rslt bstr|

    ole := OLEAutomationDLL current.
    rslt := ole SysAllocString: 'hello World'.

    self assert:(rslt notNil).
    self assert:(rslt sizeInBytes == (4 + ('hello World' size * 2) "+ 2")).
    self assert:(rslt sizeInCharacters == 'hello World' size).
    self assert:(rslt characterAt:1) == $h.
    self assert:(rslt characterAt:2) == $e.

    "
     self new test01_SysAllocString
    "
! !

!Win32OLETests class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !