RegressionTests__Win32OperatingSystemTest.st
author Claus Gittinger <cg@exept.de>
Tue, 09 Jul 2019 18:53:03 +0200
changeset 2327 bf482d49aeaf
parent 1648 d0e3584dd9a2
child 2481 8ed6ac4c665d
permissions -rw-r--r--
#QUALITY by exept class: RegressionTests::StringTests added: #test82c_expanding

"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

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


!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$'
! !