RegressionTests__Win32OLETests.st
author Claus Gittinger <cg@exept.de>
Fri, 11 Mar 2016 18:09:41 +0100
changeset 1356 a8e8d673f22e
parent 1355 8844ec16d47b
child 1372 a990b4eb7030
permissions -rw-r--r--
#FEATURE class: RegressionTests::Win32OLETests added: #test01_SysAllocString
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'exept:regression' }"
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ NameSpace: RegressionTests }"
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
TestCase subclass:#Win32OLETests
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'tests-Regression-RuntimeSystem'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
1355
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    13
!Win32OLETests class methodsFor:'queries'!
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    14
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    15
coveredPackageNames
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    16
    ^ #('exept:ole')
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    17
! !
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    18
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!Win32OLETests methodsFor:'tests'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
test00_loadOLE
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
    |iid_IEnum|
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
    OperatingSystem isMSWINDOWSlike ifFalse:[
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
        Transcript showCR:'test skipped (OS is not WINDOWS)'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
        ^ self.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
    ].
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
    Smalltalk at:#ExternalLibraryFunction:Verbose put:true.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
    Smalltalk at:#ObjectFileLoader:Verbose put:true.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
    "/
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
    "/ this will already perform a number of calls into OLE,
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
    "/ to get the CLSIDs of various wellknown interfaces
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
    "/ (see OLEInterfaceConstants initialize)
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
    Smalltalk loadPackage:'exept:ole'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
    "/ so when we arrive here without error, some is already known to work..        
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
    self assert:(OLEInterfaceConstants notNil).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    iid_IEnum := OLEInterfaceConstants classVarAt:#'IID_IEnum'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    self assert:(iid_IEnum notNil).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    self assert:(iid_IEnum class == GUID).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    self assert:(iid_IEnum printString = '{2AE64960-CDDD-101C-9029-040224007802}').
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    "
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
     self new test00_loadOLE
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    "
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    48
!
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    49
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    50
test01_SysAllocString
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    51
    |ole rslt bstr|
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    52
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    53
    ole := OLEAutomationDLL current.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    54
    rslt := ole SysAllocString: 'hello World'.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    55
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    56
    self assert:(rslt notNil).
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    57
    bstr := BSTR atAddress:rslt.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    58
self halt.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    59
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    60
    "
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    61
     self new test01_SysAllocString
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    62
    "
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
!Win32OLETests class methodsFor:'documentation'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
version
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
version_CVS
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74