Ticket #3710: Bug1.hs

File Bug1.hs, 1.0 KB (added by dherington, 4 years ago)

test module

Line 
1import FilePlus
2
3import System.Win32
4import System.Environment (getArgs)
5import Control.Monad (unless)
6import qualified Numeric
7
8
9main = do
10  args <- getArgs
11  case args of
12    [alt, path, count] -> doit (read alt :: Int) path (read count :: Int)
13    _                  -> fail $ "bad command: " ++ unwords args
14
15writeSize = 512
16
17doit alt path count = do
18  handle <- createFile path (gENERIC_READ + gENERIC_WRITE) 0 Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing
19  let string = replicate writeSize '.'
20  let writeAt addr = do putStrLn $ "writing to handle " ++ show handle ++ " at 0x" ++ showHex addr
21                        case alt of
22                          1 -> writeFile' handle Nothing                    string  -- succeeds
23                          2 -> writeFile' handle (Just (fromIntegral addr)) string  -- fails
24                          _ -> fail $ "unknown alternative: " ++ show alt
25  mapM_ writeAt [0, writeSize .. count * writeSize - 1]
26
27showHex value = Numeric.showHex value ""