Move win32 tests to win32 repository.
authorPaolo Capriotti <p.capriotti@gmail.com>
Wed, 9 May 2012 16:39:05 +0000 (17:39 +0100)
committerPaolo Capriotti <p.capriotti@gmail.com>
Wed, 9 May 2012 16:39:05 +0000 (17:39 +0100)
testsuite/tests/lib/win32/Makefile [deleted file]
testsuite/tests/lib/win32/all.T [deleted file]
testsuite/tests/lib/win32/win32001.hs [deleted file]
testsuite/tests/lib/win32/win32002.hs [deleted file]

diff --git a/testsuite/tests/lib/win32/Makefile b/testsuite/tests/lib/win32/Makefile
deleted file mode 100644 (file)
index 66afc12..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..\r
-include $(TOP)/mk/boilerplate.mk\r
-include $(TOP)/mk/test.mk\r
diff --git a/testsuite/tests/lib/win32/all.T b/testsuite/tests/lib/win32/all.T
deleted file mode 100644 (file)
index ccb0bdd..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-def win_only(opts):
-    if config.os != "mingw32" and config.os != "cygwin32":
-        opts.skip = 1
-
-# This isn't a very good test to run automatically at the moment, since
-# it doesn't terminate
-test('win32001', skip, compile_and_run, ['-package lang -package win32'])
-
-test('win32002', win_only, compile_and_run, ['-package Win32'])
diff --git a/testsuite/tests/lib/win32/win32001.hs b/testsuite/tests/lib/win32/win32001.hs
deleted file mode 100644 (file)
index 8765dcb..0000000
+++ /dev/null
@@ -1,104 +0,0 @@
--- Haskell version of "Hello, World" using the Win32 library.
--- Demonstrates how the Win32 library can be put to use.
--- (c) sof 1999
-
-
-module Main(main) where
-
-import qualified Win32
-import Addr 
-
--- Toplevel main just creates a window and pumps messages.
--- The window procedure (wndProc) we pass in is partially
--- applied with the user action that takes care of responding
--- to repaint messages (WM_PAINT).
-
-main :: IO ()
-main = do
-  lpps <- Win32.malloc Win32.sizeofPAINTSTRUCT
-  hwnd <- createWindow 200 200 (wndProc lpps onPaint)
-  messagePump hwnd
-
--- OnPaint handler for a window - draw a string centred
--- inside it.
-onPaint :: Win32.RECT -> Win32.HDC -> IO ()
-onPaint (_,_,w,h) hdc = do
-   Win32.setBkMode hdc Win32.tRANSPARENT
-   Win32.setTextColor hdc (Win32.rgb 255 255 0)
-   let y | h==10     = 0
-         | otherwise = ((h-10) `div` 2)
-       x | w==50     = 0
-         | otherwise = (w-50) `div` 2
-   Win32.textOut hdc x y "Hello, world"
-   return ()
-
--- Simple window procedure - one way to improve and generalise
--- it would be to pass it a message map (represented as a 
--- finite map from WindowMessages to actions, perhaps).
-
-wndProc :: Win32.LPPAINTSTRUCT
-       -> (Win32.RECT -> Win32.HDC -> IO ()) -- on paint action
-        -> Win32.HWND
-        -> Win32.WindowMessage
-       -> Win32.WPARAM
-       -> Win32.LPARAM
-       -> IO Win32.LRESULT
-wndProc lpps onPaint hwnd wmsg wParam lParam
- | wmsg == Win32.wM_DESTROY = do
-     Win32.sendMessage hwnd Win32.wM_QUIT 1 0
-     return 0
- | wmsg == Win32.wM_PAINT && hwnd /= nullAddr = do
-     r <- Win32.getClientRect hwnd
-     paintWith lpps hwnd (onPaint r)
-     return 0
- | otherwise = 
-     Win32.defWindowProc (Just hwnd) wmsg wParam lParam
-
-createWindow :: Int -> Int -> Win32.WindowClosure -> IO Win32.HWND
-createWindow width height wndProc = do
-  let winClass = Win32.mkClassName "Hello"
-  icon         <- Win32.loadIcon   Nothing Win32.iDI_APPLICATION
-  cursor       <- Win32.loadCursor Nothing Win32.iDC_ARROW
-  bgBrush      <- Win32.createSolidBrush (Win32.rgb 0 0 255)
-  mainInstance <- Win32.getModuleHandle Nothing
-  Win32.registerClass
-         ( Win32.cS_VREDRAW + Win32.cS_HREDRAW
-         , mainInstance
-         , Just icon
-         , Just cursor
-         , Just bgBrush
-         , Nothing
-         , winClass
-         )
-  w <- Win32.createWindow 
-                winClass
-                "Hello, World example"
-                Win32.wS_OVERLAPPEDWINDOW
-                Nothing Nothing -- leave it to the shell to decide the position
-                                -- at where to put the window initially
-                 (Just width)
-                (Just height)
-                Nothing      -- no parent, i.e, root window is the parent.
-                Nothing      -- no menu handle
-                mainInstance
-                wndProc
-  Win32.showWindow w Win32.sW_SHOWNORMAL
-  Win32.updateWindow w
-  return w
-
-messagePump :: Win32.HWND -> IO ()
-messagePump hwnd = do
-  msg  <- Win32.getMessage (Just hwnd) `catch` \ _ -> return nullAddr
-  if msg == nullAddr then
-    return ()
-   else do
-    Win32.translateMessage msg
-    Win32.dispatchMessage msg
-    messagePump hwnd
-
-paintWith :: Win32.LPPAINTSTRUCT -> Win32.HWND -> (Win32.HDC -> IO a) -> IO a
-paintWith lpps hwnd p = do
-  hdc  <- Win32.beginPaint hwnd lpps
-  a    <- p hdc
-  Win32.endPaint hwnd lpps
-  return a
diff --git a/testsuite/tests/lib/win32/win32002.hs b/testsuite/tests/lib/win32/win32002.hs
deleted file mode 100644 (file)
index 0b57985..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
--- Test that the Win32 error code from getLastError is thread-local.
-
-import System.Win32
-import Control.Monad
-import Control.Concurrent
-
-main = do
-  setLastError 42
-  r <- getLastError
-  when (r /= 42) $ fail ("wrong: " ++ show r)
-  m <- newEmptyMVar
-  forkIO $ do setLastError 43; putMVar m ()
-  takeMVar m
-  r <- getLastError
-  when (r /= 42) $ fail ("wrong: " ++ show r)
-
-foreign import stdcall unsafe "windows.h SetLastError"
-  setLastError :: ErrCode -> IO ()