RegressionTests__Win32OperatingSystemTest.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 30 Jun 2016 09:02:08 +0100
branchjv
changeset 1500 d406a10b2965
parent 1499 26a16a04219b
parent 1447 2351db93aa5b
child 1566 2ca58098256d
permissions -rw-r--r--
Merge

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

"{ NameSpace: RegressionTests }"

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


!Win32OperatingSystemTest methodsFor:'release'!

tearDown
! !

!Win32OperatingSystemTest methodsFor:'tests'!

testMutex
    |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 testMutex
    "
!

testRegistry
    |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 testRegistry
    "
! !

!Win32OperatingSystemTest class methodsFor:'documentation'!

version
    ^ '$Header$'
! !