[commit: packages/Win32] depend-os-windows, fix-appveyor-curl-ussue, master, win32-2.5.4.1-ghc-8.2: Respect signedness of literals (#78) (06d5849)

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


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

On branches: 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/06d584916a4c32e6d31b60499afd52e32e4281ef

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

commit 06d584916a4c32e6d31b60499afd52e32e4281ef
Author: Tamar Christina <Mistuke at users.noreply.github.com>
Date:   Tue Mar 7 22:03:17 2017 +0000

    Respect signedness of literals (#78)
    
    * Use maxBound instead of (-1) to define iNVALID_HANDLE_VALUE
    
    The former results in an out-of-bounds literal warning (introduced in GHC 8.2).
    
    * Menu: Use maxBound instead of (-1) to discern error
    
    The value being compared against is unsigned so (-1) is technically out
    of range.
    
    * Window: Define cW_USE_DEFAULT as Int, not Word
    
    Since its value is signed.
    
    * Using NegativeLiterals
    
    * use negative number to fit bit pattern.
    
    * use negative number to fit bit pattern
    
    * Weird convoluted way to get a value with the top bit set..
    
    * Add clarifying comment.
    
    * Mark for release.


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

06d584916a4c32e6d31b60499afd52e32e4281ef
 Graphics/Win32/Menu.hsc   | 10 +++++-----
 Graphics/Win32/Window.hsc |  8 ++++++--
 System/Win32/Types.hsc    |  2 +-
 Win32.cabal               |  2 +-
 changelog.md              |  3 ++-
 5 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/Graphics/Win32/Menu.hsc b/Graphics/Win32/Menu.hsc
index 45e7a9e..58eef5c 100644
--- a/Graphics/Win32/Menu.hsc
+++ b/Graphics/Win32/Menu.hsc
@@ -79,7 +79,7 @@ type MenuName = LPCTSTR
 
 checkMenuItem :: HMENU -> MenuItem -> MenuFlag -> IO Bool
 checkMenuItem menu item check = do
-  rv <- failIf (== -1) "CheckMenuItem" $ c_CheckMenuItem menu item check
+  rv <- failIf (== maxBound) "CheckMenuItem" $ c_CheckMenuItem menu item check
   return (rv == mF_CHECKED)
 foreign import WINDOWS_CCONV unsafe "windows.h CheckMenuItem"
   c_CheckMenuItem :: HMENU -> UINT -> UINT -> IO DWORD
@@ -230,13 +230,13 @@ foreign import WINDOWS_CCONV unsafe "windows.h GetMenu"
 
 getMenuDefaultItem :: HMENU -> Bool -> GMDIFlag -> IO MenuItem
 getMenuDefaultItem menu bypos flags =
-  failIf (== -1) "GetMenuDefaultItem" $ c_GetMenuDefaultItem menu bypos flags
+  failIf (== maxBound) "GetMenuDefaultItem" $ c_GetMenuDefaultItem menu bypos flags
 foreign import WINDOWS_CCONV unsafe "windows.h GetMenuDefaultItem"
   c_GetMenuDefaultItem :: HMENU -> Bool -> UINT -> IO UINT
 
 getMenuState :: HMENU -> MenuItem -> MenuFlag -> IO MenuState
 getMenuState menu item flags =
-  failIf (== -1) "GetMenuState" $ c_GetMenuState menu item flags
+  failIf (== maxBound) "GetMenuState" $ c_GetMenuState menu item flags
 foreign import WINDOWS_CCONV unsafe "windows.h GetMenuState"
   c_GetMenuState :: HMENU -> UINT -> UINT -> IO MenuState
 
@@ -254,7 +254,7 @@ foreign import WINDOWS_CCONV unsafe "windows.h SetMenu"
 
 getMenuItemCount :: HMENU -> IO Int
 getMenuItemCount menu =
-  failIf (== -1) "GetMenuItemCount" $ c_GetMenuItemCount menu
+  failIf (== maxBound) "GetMenuItemCount" $ c_GetMenuItemCount menu
 foreign import WINDOWS_CCONV unsafe "windows.h GetMenuItemCount"
   c_GetMenuItemCount :: HMENU -> IO Int
 
@@ -262,7 +262,7 @@ type MenuID = UINT
 
 getMenuItemID :: HMENU -> MenuItem -> IO MenuID
 getMenuItemID menu item =
-  failIf (== -1) "GetMenuItemID" $ c_GetMenuItemID menu item
+  failIf (== maxBound) "GetMenuItemID" $ c_GetMenuItemID menu item
 foreign import WINDOWS_CCONV unsafe "windows.h GetMenuItemID"
   c_GetMenuItemID :: HMENU -> UINT -> IO MenuID
 
diff --git a/Graphics/Win32/Window.hsc b/Graphics/Win32/Window.hsc
index 90fb2d2..b3abd54 100644
--- a/Graphics/Win32/Window.hsc
+++ b/Graphics/Win32/Window.hsc
@@ -1,4 +1,5 @@
 {-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE NegativeLiterals #-}
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
 #endif
@@ -20,7 +21,7 @@ module Graphics.Win32.Window where
 
 import Control.Monad (liftM)
 import Data.Maybe (fromMaybe)
-import Data.Word (Word32)
+import Data.Int (Int32)
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Ptr (FunPtr, Ptr, castFunPtrToPtr, castPtr, nullPtr)
@@ -185,7 +186,10 @@ type WindowStyleEx   = DWORD
 
 cW_USEDEFAULT :: Pos
 -- See Note [Overflow checking and fromIntegral] in Graphics/Win32/GDI/HDC.hs
-cW_USEDEFAULT = fromIntegral (#{const CW_USEDEFAULT} :: Word32)
+-- Weird way to essentially get a value with the top bit set. But GHC 7.8.4 was
+-- rejecting all other sane attempts.
+cW_USEDEFAULT = let val = negate (#{const CW_USEDEFAULT}) :: Integer
+                in fromIntegral (fromIntegral val :: Int32) :: Pos
 
 type Pos = Int
 
diff --git a/System/Win32/Types.hsc b/System/Win32/Types.hsc
index afefb50..0402e8e 100755
--- a/System/Win32/Types.hsc
+++ b/System/Win32/Types.hsc
@@ -219,7 +219,7 @@ nullFinalHANDLE :: ForeignPtr a
 nullFinalHANDLE = unsafePerformIO (newForeignPtr_ nullPtr)
 
 iNVALID_HANDLE_VALUE :: HANDLE
-iNVALID_HANDLE_VALUE = castUINTPtrToPtr (-1)
+iNVALID_HANDLE_VALUE = castUINTPtrToPtr maxBound
 
 foreign import ccall "_open_osfhandle"
   _open_osfhandle :: CIntPtr -> CInt -> IO CInt
diff --git a/Win32.cabal b/Win32.cabal
index 3dd32bf..8cbd3cb 100644
--- a/Win32.cabal
+++ b/Win32.cabal
@@ -1,5 +1,5 @@
 name:		Win32
-version:	2.5.1.0
+version:	2.5.2.0
 license:	BSD3
 license-file:	LICENSE
 author:		Alastair Reid, shelarcy
diff --git a/changelog.md b/changelog.md
index d3069b6..2fff272 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,7 +1,8 @@
 # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32)
 
-## Unreleased GIT version
+## 2.5.2.0 *March 2017*
 
+* Fix constant underflows with (-1) and unsigned numbers.
 * Add `commandLineToArgv`
 
 ## 2.5.1.0 *Feb 2017*



More information about the ghc-commits mailing list