RegressionTests__Win32OperatingSystemTest.st
changeset 1647 87d3c317faa4
parent 1447 2351db93aa5b
child 1648 d0e3584dd9a2
--- 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
     "
 ! !