RegressionTests__Win32OperatingSystemTest.st
author sr
Wed, 05 Feb 2020 14:14:49 +0100
changeset 2555 b3fd3a67477b
parent 2481 8ed6ac4c665d
permissions -rw-r--r--
#FEATURE by sr class: WebSocketTest changed: #withData:do:

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