"{ Encoding: utf8 }"
"
COPYRIGHT (c) 2018 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#Win32OperatingSystemTest
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'tests-Regression-RuntimeSystem'
!
!Win32OperatingSystemTest class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2018 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
! !
!Win32OperatingSystemTest methodsFor:'tests'!
test01_Registry
|k hasContentType|
self
skipIf:[OperatingSystem isMSWINDOWSlike not]
description:'test skipped (OS is not WINDOWS)'.
k := OperatingSystem registryEntry key:'HKEY_CLASSES_ROOT\MIME\Database\'.
self assert:(k notNil).
hasContentType := false.
k subKeyNamesAndClassesDo:[:nm :clsNm |
"/ Transcript showCR:nm.
nm = 'Content Type' ifTrue:[hasContentType := true].
].
self assert:hasContentType.
"/ k subKeysDo:[:k | Transcript showCR:k].
"
self new test01_Registry
"
!
test02_RegistryStore_and_Retrieve
|k s20 s40 s200 s800 s1600 s3200 s6400|
self
skipIf:[OperatingSystem isMSWINDOWSlike not]
description:'test skipped (OS is not WINDOWS)'.
(OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software\ExeptTest') isNil ifTrue:[
(OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software') createSubKeyNamed:'ExeptTest'.
].
k := OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software\ExeptTest'.
self assert:k notNil.
(k valueNamed:'BLA10') isNil ifTrue:[
k valueNamed:'BLA10' put:'1234567890'
].
s20 := '12345678901234567890'.
s40 := s20,s20.
s200 := s40,s40,s40,s40,s40.
s800 := s200,s200,s200,s200.
s1600 := s800,s800.
s3200 := s1600,s1600.
s6400 := s3200,s3200.
(k valueNamed:'BLA1600') isNil ifTrue:[
k valueNamed:'BLA1600' put:s1600
].
(k valueNamed:'BLA3200') isNil ifTrue:[
k valueNamed:'BLA3200' put:s3200
].
(k valueNamed:'BLA6400') isNil ifTrue:[
k valueNamed:'BLA6400' put:s6400
].
self assert:(k valueNames includesAll:#('BLA10' 'BLA1600' 'BLA3200')).
self assert:(k valueNamed:'BLA10') = '1234567890'.
self assert:(k valueNamed:'BLA1600') = s1600.
self assert:(k valueNamed:'BLA3200') = s3200.
self assert:(k valueNamed:'BLA6400') = s6400.
"
self new test02_RegistryStore_and_Retrieve
"
!
test03_RegistryStore_and_Retrieve_Unicode
"with unicode keys and values"
|k s20 s40 s200 s800 s1600 s3200 s6400|
self
skipIf:[OperatingSystem isMSWINDOWSlike not]
description:'test skipped (OS is not WINDOWS)'.
self
skip:'Unicode not yet supported in Registry code'.
(OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software\ExeptTest') isNil ifTrue:[
(OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software') createSubKeyNamed:'ExeptTest'.
].
k := OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software\ExeptTest'.
self assert:k notNil.
(k valueNamed:'BLA10_u') isNil ifTrue:[
k valueNamed:'BLA10_u' put:'αβγ4567890'
].
s20 := 'αβγ45678901234567890'.
s40 := s20,s20.
s200 := s40,s40,s40,s40,s40.
s800 := s200,s200,s200,s200.
s1600 := s800,s800.
s3200 := s1600,s1600.
s6400 := s3200,s3200.
(k valueNamed:'BLA1600_u') isNil ifTrue:[
k valueNamed:'BLA1600_u' put:s1600
].
(k valueNamed:'BLA3200_u') isNil ifTrue:[
k valueNamed:'BLA3200_u' put:s3200
].
(k valueNamed:'BLA6400_u') isNil ifTrue:[
k valueNamed:'BLA6400_u' put:s6400
].
self assert:(k valueNames includesAll:#('BLA10_u' 'BLA1600_u' 'BLA3200_u')).
self assert:(k valueNamed:'BLA10_u') = 'αβγ4567890'.
self assert:(k valueNamed:'BLA1600_u') = s1600.
self assert:(k valueNamed:'BLA3200_u') = s3200.
self assert:(k valueNamed:'BLA6400_u') = s6400.
"
self new test03_RegistryStore_and_Retrieve_Unicode
"
!
test10_Mutex
|handle alreadyExists lastErrorCode handleAndLastErrorCode|
self
skipIf:[OperatingSystem isMSWINDOWSlike not]
description:'test skipped (OS is not WINDOWS)'.
handleAndLastErrorCode := Win32OperatingSystem createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'.
handle := handleAndLastErrorCode first.
handle isNil ifTrue:[^ self].
lastErrorCode := handleAndLastErrorCode second.
self assert: lastErrorCode == 0.
alreadyExists := (lastErrorCode == 5 "ERROR_ACCESS_DENIED" or:[ lastErrorCode == 183 "ERROR_ALREADY_EXISTS"]).
alreadyExists ifTrue:[
Transcript showCR: 'Mutex already exists!!'.
^ self.
].
Transcript showCR: 'Mutex created!!'.
Win32OperatingSystem waitForSingleObject: handle.
Delay waitForSeconds:0.5. "/ self halt.
Win32OperatingSystem releaseMutex: handle.
Win32OperatingSystem primCloseHandle: handle.
Transcript showCR: 'Mutex closed!!'.
"
self new test10_Mutex
"
! !
!Win32OperatingSystemTest class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !