[commit: packages/Win32] Mistuke-fix-build, depend-os-windows, fix-appveyor-curl-ussue, master, win32-2.5.4.1-ghc-8.2: Fix poke implementation for TIME_ZONE_INFORMATION (#65) (e330708)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:28:03 UTC 2017


Repository : ssh://git@git.haskell.org/Win32

On branches: Mistuke-fix-build,depend-os-windows,fix-appveyor-curl-ussue,master,win32-2.5.4.1-ghc-8.2
Link       : http://git.haskell.org/packages/Win32.git/commitdiff/e330708577a0508eecd045715afa0655a3ab0301

>---------------------------------------------------------------

commit e330708577a0508eecd045715afa0655a3ab0301
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Dec 22 03:25:40 2016 -0600

    Fix poke implementation for TIME_ZONE_INFORMATION (#65)
    
    * Fix poke implementation for TIME_ZONE_INFORMATION
    
    * Add test


>---------------------------------------------------------------

e330708577a0508eecd045715afa0655a3ab0301
 System/Win32/Time.hsc |  9 +++++----
 changelog.md          |  2 ++
 tests/PokeTZI.hs      | 15 +++++++++++++++
 tests/all.T           |  1 +
 4 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/System/Win32/Time.hsc b/System/Win32/Time.hsc
index 978a915..acabee1 100644
--- a/System/Win32/Time.hsc
+++ b/System/Win32/Time.hsc
@@ -111,10 +111,11 @@ instance Storable TIME_ZONE_INFORMATION where
         where
             write buf offset str = withCWStringLen str $ \(str,len) -> do
                 when (len>31) $ fail "Storable TIME_ZONE_INFORMATION.poke: Too long string."
-                let start = (advancePtr (castPtr buf) offset)
-                    end = advancePtr start len
-                copyArray (castPtr str :: Ptr Word8) start len
-                poke end 0
+                let len'  = len * sizeOf (undefined :: CWchar)
+                    start = (advancePtr (castPtr buf) offset)
+                    end   = advancePtr start len'
+                copyArray start (castPtr str :: Ptr Word8) len'
+                poke (castPtr end) (0 :: CWchar)
     peek buf = do
         bias <- (#peek TIME_ZONE_INFORMATION, Bias)         buf
         sdat <- (#peek TIME_ZONE_INFORMATION, StandardDate) buf
diff --git a/changelog.md b/changelog.md
index 050addb..2e5fc37 100644
--- a/changelog.md
+++ b/changelog.md
@@ -4,6 +4,8 @@
 
 * `failWith` (and the API calls that use it) now throw `IOError`s with proper
   `IOErrorType`s.
+* Fix a bug in the implementation of `poke` for `TIME_ZONE_INFORMATION` which
+  would cause it to be marshalled incorrectly.
 * Add `System.Win32.MinTTY` module for detecting the presence of MinTTY.
 * Add `ULONG` type to `System.Win32.Types`.
 * Add function `failIfNeg` to `System.Win32.Types`, which fails if a negative
diff --git a/tests/PokeTZI.hs b/tests/PokeTZI.hs
new file mode 100644
index 0000000..0853ffe
--- /dev/null
+++ b/tests/PokeTZI.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import Control.Exception (assert)
+import Foreign
+import System.Win32.Time
+
+main :: IO ()
+main = do
+    (_, tzi) <- getTimeZoneInformation
+    alloca $ \buf -> do
+        poke buf tzi
+        tzi' <- peek buf
+        print tzi
+        print tzi'
+        assert (tzi == tzi') $ return ()
diff --git a/tests/all.T b/tests/all.T
index 07d030b..e541f3c 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -6,3 +6,4 @@ test('helloworld', skip, compile_and_run, ['-package lang -package win32'])
 
 test('lasterror', normal, compile_and_run, ['-package Win32'])
 test('T4452', normal, compile_and_run, ['-package Win32'])
+test('PokeTZI', normal, compile_and_run, ['-package Win32'])



More information about the ghc-commits mailing list