RegressionTests__Win32OLETests.st
author Claus Gittinger <cg@exept.de>
Tue, 29 Mar 2016 21:42:19 +0200
changeset 1376 d2973f7acf8c
parent 1375 7be5753688a8
child 1377 c68053a15d26
permissions -rw-r--r--
#UI_ENHANCEMENT class: RegressionTests::Win32OLETests changed: #test02_GuidFromProgID
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1372
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
     1
"{ Encoding: utf8 }"
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
     2
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ Package: 'exept:regression' }"
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
"{ NameSpace: RegressionTests }"
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
TestCase subclass:#Win32OLETests
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	instanceVariableNames:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	classVariableNames:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
	poolDictionaries:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
	category:'tests-Regression-RuntimeSystem'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
1355
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    15
!Win32OLETests class methodsFor:'queries'!
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    16
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    17
coveredPackageNames
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    18
    ^ #('exept:ole')
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    19
! !
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    20
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!Win32OLETests methodsFor:'tests'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
test00_loadOLE
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
    |iid_IEnum|
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
    OperatingSystem isMSWINDOWSlike ifFalse:[
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
        Transcript showCR:'test skipped (OS is not WINDOWS)'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
        ^ self.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
    ].
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
    Smalltalk at:#ExternalLibraryFunction:Verbose put:true.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
    Smalltalk at:#ObjectFileLoader:Verbose put:true.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
    "/
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
    "/ this will already perform a number of calls into OLE,
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
    "/ to get the CLSIDs of various wellknown interfaces
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
    "/ (see OLEInterfaceConstants initialize)
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
    Smalltalk loadPackage:'exept:ole'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
    "/ so when we arrive here without error, some is already known to work..        
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    self assert:(OLEInterfaceConstants notNil).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    iid_IEnum := OLEInterfaceConstants classVarAt:#'IID_IEnum'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    self assert:(iid_IEnum notNil).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    self assert:(iid_IEnum class == GUID).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    self assert:(iid_IEnum printString = '{2AE64960-CDDD-101C-9029-040224007802}').
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    "
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
     self new test00_loadOLE
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    "
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    50
!
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    51
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    52
test01_SysAllocString
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    53
    |ole rslt bstr|
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    54
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    55
    ole := OLEAutomationDLL current.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    56
    rslt := ole SysAllocString: 'hello World'.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    57
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    58
    self assert:(rslt notNil).
1372
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    59
    self assert:(rslt sizeInBytes == (4 + ('hello World' size * 2) "+ 2")).
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    60
    self assert:(rslt sizeInCharacters == 'hello World' size).
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    61
    self assert:(rslt characterAt:1) == $h.
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    62
    self assert:(rslt characterAt:2) == $e.
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    63
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    64
    "
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    65
     self new test01_SysAllocString
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    66
    "
1374
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    67
!
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    68
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    69
test02_GuidFromProgID
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    70
    |guid|
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    71
1376
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    72
    self 
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    73
        should:[
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    74
            guid := (GUID clsidFromProgID:'Foo.Bar'). 
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    75
        ] raise:OLEError.
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    76
1375
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    77
    OLEError handle:[:ex |
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    78
        ex hresult = (OLEStatusCodeConstants at:#CO_E_CLASSSTRING) ifTrue:[
1376
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    79
            "/ kind of expected - you machine has no AcroPDF installed...
1375
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    80
            Transcript showCR:'OLE: class not found: AcroPDF.PDF'
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    81
        ] ifFalse:[
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    82
            self assert:false description:'unexpected error code'.
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    83
        ]
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    84
    ] do:[
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    85
        guid := (GUID clsidFromProgID:'AcroPDF.PDF').
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    86
        self assert:(guid notNil).
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    87
        self assert:(guid printString = '').
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
    88
    ].
1374
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    89
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    90
    "
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    91
     self new test02_GuidFromProgID
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    92
    "
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
!Win32OLETests class methodsFor:'documentation'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
version
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
version_CVS
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104