Repository : ssh://darcs.haskell.org//srv/darcs/packages/Win32 On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6c035c1fb7cb0bba64cdea3a3e1a84c19ef4cd18 >--------------------------------------------------------------- commit 6c035c1fb7cb0bba64cdea3a3e1a84c19ef4cd18 Author: Paolo Capriotti <[email protected]> Date: Wed May 9 14:29:28 2012 +0100 EnumClipboardFormats returning 0 is not an error (#4452) >--------------------------------------------------------------- Graphics/Win32/GDI/Clip.hsc | 8 ++++++-- tests/T4452.hs | 13 +++++++++++++ tests/all.T | 1 + 3 files changed, 20 insertions(+), 2 deletions(-) diff --git a/Graphics/Win32/GDI/Clip.hsc b/Graphics/Win32/GDI/Clip.hsc index 78a1eb7..f7d0ace 100644 --- a/Graphics/Win32/GDI/Clip.hsc +++ b/Graphics/Win32/GDI/Clip.hsc @@ -17,6 +17,7 @@ module Graphics.Win32.GDI.Clip where +import Control.Monad import Graphics.Win32.GDI.Types import System.Win32.Types @@ -75,8 +76,11 @@ foreign import stdcall unsafe "windows.h EmptyClipboard" -- original also tested GetLastError() != NO_ERROR enumClipboardFormats :: ClipboardFormat -> IO ClipboardFormat -enumClipboardFormats format = - failIfZero "EnumClipboardFormats" $ c_EnumClipboardFormats format +enumClipboardFormats format = do + format' <- c_EnumClipboardFormats format + when (format' == 0) $ + failUnlessSuccess "EnumClipboardFormats" getLastError + return format' foreign import stdcall unsafe "windows.h EnumClipboardFormats" c_EnumClipboardFormats :: ClipboardFormat -> IO ClipboardFormat diff --git a/tests/T4452.hs b/tests/T4452.hs new file mode 100644 index 0000000..551b32c --- /dev/null +++ b/tests/T4452.hs @@ -0,0 +1,13 @@ +module Main where + +import Control.Monad +import Foreign.Ptr +import Graphics.Win32.GDI.Clip + +main = do + openClipboard nullPtr + go 0 + where + go n = do + n' <- enumClipboardFormats n + unless (n == 0) (go n') diff --git a/tests/all.T b/tests/all.T index 589004c..07d030b 100644 --- a/tests/all.T +++ b/tests/all.T @@ -5,3 +5,4 @@ test('registry001', normal, compile_and_run, ['']) 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']) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
