[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