--- a/RegressionTests__Win32OperatingSystemTest.st Wed Jul 26 13:02:05 2017 +0200
+++ b/RegressionTests__Win32OperatingSystemTest.st Wed Jul 26 13:48:53 2017 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
@@ -10,17 +12,135 @@
!
-!Win32OperatingSystemTest methodsFor:'release'!
-
-tearDown
-! !
-
!Win32OperatingSystemTest methodsFor:'tests'!
-testMutex
+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)'.
+ self
+ skipIf:[OperatingSystem isMSWINDOWSlike not]
+ description:'test skipped (OS is not WINDOWS)'.
handleAndLastErrorCode := Win32OperatingSystem createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'.
handle := handleAndLastErrorCode first.
@@ -29,8 +149,8 @@
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 already exists!!'.
+ ^ self.
].
Transcript showCR: 'Mutex created!!'.
Win32OperatingSystem waitForSingleObject: handle.
@@ -40,29 +160,7 @@
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
+ self new test10_Mutex
"
! !