RegressionTests__Win32OLETests.st
author Claus Gittinger <cg@exept.de>
Wed, 30 Mar 2016 02:28:36 +0200
changeset 1377 c68053a15d26
parent 1376 d2973f7acf8c
child 1378 9f3b1678697b
permissions -rw-r--r--
#REFACTORING 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).
1377
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    87
        "/ self assert:(guid printString = '').
1375
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
1377
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    90
     guid := (GUID clsidFromProgID:'InternetExplorer.Application'). 
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    91
     self assert:(guid notNil).
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    92
     self assert:(guid printString = '{0002DF01-0000-0000-C000-000000000046}').
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    93
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    94
     guid := (GUID clsidFromProgID: 'Msxml2.DOMDocument.4.0'). 
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    95
     self assert:(guid notNil).
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    96
     self assert:(guid printString = '{88D969C0-F192-11D4-A65F-0040963251E5}').
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    97
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    98
     guid := (GUID clsidFromProgID: 'Microsoft.JScript.Vsa.VsaEngine'). 
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
    99
     self assert:(guid notNil).
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
   100
     self assert:(guid printString = '{B71E484D-93ED-4B56-BFB9-CEED5134822B}').
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
   101
1374
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   102
    "
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   103
     self new test02_GuidFromProgID
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   104
    "
1377
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
   105
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
   106
    "Modified: / 30-03-2016 / 02:28:15 / cg"
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
!Win32OLETests class methodsFor:'documentation'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
version
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
version_CVS
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118