From 5ee08e70032d7d53e7b50ed409c554cf044f1348 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Sun, 9 Aug 1998 21:04:17 +0000
Subject: [PATCH] [project @ 1998-08-09 21:03:56 by sof] more IO tests

---
 ghc/tests/io/should_run/io012.stdout |    1 +
 ghc/tests/io/should_run/io024.hs     |   33 ++++++++++++++
 ghc/tests/io/should_run/io024.stdout |    5 +++
 ghc/tests/io/should_run/io025.hs     |   24 +++++++++++
 ghc/tests/io/should_run/io025.stdout |    5 +++
 ghc/tests/io/should_run/io026.hs     |   10 +++++
 ghc/tests/io/should_run/io026.stdout |    1 +
 ghc/tests/io/should_run/io027.hs     |    8 ++++
 ghc/tests/io/should_run/io027.stdout |    2 +
 ghc/tests/io/should_run/io028.hs     |   79 ++++++++++++++++++++++++++++++++++
 ghc/tests/io/should_run/io028.stderr |    1 +
 ghc/tests/io/should_run/io028.stdout |   22 ++++++++++
 ghc/tests/io/should_run/io029.hs     |   27 ++++++++++++
 ghc/tests/io/should_run/io029.stdout |    2 +
 ghc/tests/io/should_run/io030.hs     |   50 +++++++++++++++++++++
 ghc/tests/io/should_run/io030.stdout |   24 +++++++++++
 16 files changed, 294 insertions(+)
 create mode 100644 ghc/tests/io/should_run/io012.stdout
 create mode 100644 ghc/tests/io/should_run/io024.hs
 create mode 100644 ghc/tests/io/should_run/io024.stdout
 create mode 100644 ghc/tests/io/should_run/io025.hs
 create mode 100644 ghc/tests/io/should_run/io025.stdout
 create mode 100644 ghc/tests/io/should_run/io026.hs
 create mode 100644 ghc/tests/io/should_run/io026.stdout
 create mode 100644 ghc/tests/io/should_run/io027.hs
 create mode 100644 ghc/tests/io/should_run/io027.stdout
 create mode 100644 ghc/tests/io/should_run/io028.hs
 create mode 100644 ghc/tests/io/should_run/io028.stderr
 create mode 100644 ghc/tests/io/should_run/io028.stdout
 create mode 100644 ghc/tests/io/should_run/io029.hs
 create mode 100644 ghc/tests/io/should_run/io029.stdout
 create mode 100644 ghc/tests/io/should_run/io030.hs
 create mode 100644 ghc/tests/io/should_run/io030.stdout

diff --git a/ghc/tests/io/should_run/io012.stdout b/ghc/tests/io/should_run/io012.stdout
new file mode 100644
index 0000000..b1bd38b
--- /dev/null
+++ b/ghc/tests/io/should_run/io012.stdout
@@ -0,0 +1 @@
+13
diff --git a/ghc/tests/io/should_run/io024.hs b/ghc/tests/io/should_run/io024.hs
new file mode 100644
index 0000000..cc95899
--- /dev/null
+++ b/ghc/tests/io/should_run/io024.hs
@@ -0,0 +1,33 @@
+--!!! Testing IO.hFileSize
+module Main(main) where
+
+import IO
+import Directory ( removeFile )
+
+main = do
+  sz <- hFileSize stdin `catch` (\ _ -> return (-1))
+  print sz
+  let fn = "io025.out" 
+  hdl <- openFile fn WriteMode
+  removeFile fn
+  hPutStrLn hdl "file_size"
+   -- with default buffering
+  sz <- hFileSize hdl
+  print sz
+
+  hSetBuffering hdl NoBuffering
+  hPutStrLn hdl "file_size"
+   -- with no buffering
+  sz <- hFileSize hdl
+  print sz
+  hSetBuffering hdl LineBuffering
+  hPutStrLn hdl "file_size"
+   -- with line buffering
+  sz <- hFileSize hdl
+  print sz
+  hSetBuffering hdl (BlockBuffering (Just 4))
+   -- with block buffering
+  hPutStrLn hdl "file_size"
+  sz <- hFileSize hdl
+  print sz
+  hClose hdl
diff --git a/ghc/tests/io/should_run/io024.stdout b/ghc/tests/io/should_run/io024.stdout
new file mode 100644
index 0000000..2f3d38d
--- /dev/null
+++ b/ghc/tests/io/should_run/io024.stdout
@@ -0,0 +1,5 @@
+-1
+10
+20
+30
+40
diff --git a/ghc/tests/io/should_run/io025.hs b/ghc/tests/io/should_run/io025.hs
new file mode 100644
index 0000000..d1ac09b
--- /dev/null
+++ b/ghc/tests/io/should_run/io025.hs
@@ -0,0 +1,24 @@
+--!!! Testing EOF (and the clearing of it)
+module Main(main) where
+
+import IO
+import Directory ( removeFile )
+
+main :: IO ()
+main = do
+   hdl <- openFile "io025.hs" ReadMode
+   flg <- hIsEOF hdl
+   print flg
+   hSeek hdl SeekFromEnd 0
+   flg <- hIsEOF hdl
+   print flg
+   hSeek hdl SeekFromEnd (-1)
+   flg <- hIsEOF hdl
+   print flg
+   hGetChar hdl
+   flg <- hIsEOF hdl
+   print flg
+   hSeek hdl SeekFromEnd (-1)
+   flg <- hIsEOF hdl
+   print flg
+   hClose hdl
diff --git a/ghc/tests/io/should_run/io025.stdout b/ghc/tests/io/should_run/io025.stdout
new file mode 100644
index 0000000..8069fe3
--- /dev/null
+++ b/ghc/tests/io/should_run/io025.stdout
@@ -0,0 +1,5 @@
+False
+True
+False
+True
+False
diff --git a/ghc/tests/io/should_run/io026.hs b/ghc/tests/io/should_run/io026.hs
new file mode 100644
index 0000000..d89fb31
--- /dev/null
+++ b/ghc/tests/io/should_run/io026.hs
@@ -0,0 +1,10 @@
+-- !!! isEOF
+module Main(main) where
+
+import IO ( isEOF )
+
+main = do
+  flg <- isEOF
+  print flg
+
+   
diff --git a/ghc/tests/io/should_run/io026.stdout b/ghc/tests/io/should_run/io026.stdout
new file mode 100644
index 0000000..0ca9514
--- /dev/null
+++ b/ghc/tests/io/should_run/io026.stdout
@@ -0,0 +1 @@
+True
diff --git a/ghc/tests/io/should_run/io027.hs b/ghc/tests/io/should_run/io027.hs
new file mode 100644
index 0000000..8bb3229
--- /dev/null
+++ b/ghc/tests/io/should_run/io027.hs
@@ -0,0 +1,8 @@
+-- !!! hIsEOF (on stdout)
+module Main(main) where
+
+import IO ( hIsEOF, stdout )
+
+main = do
+  flg <- hIsEOF stdout `catch` \ _ -> putStrLn "hIsEOF failed" >> return False
+  print flg
diff --git a/ghc/tests/io/should_run/io027.stdout b/ghc/tests/io/should_run/io027.stdout
new file mode 100644
index 0000000..76460ac
--- /dev/null
+++ b/ghc/tests/io/should_run/io027.stdout
@@ -0,0 +1,2 @@
+hIsEOF failed
+False
diff --git a/ghc/tests/io/should_run/io028.hs b/ghc/tests/io/should_run/io028.hs
new file mode 100644
index 0000000..424be16
--- /dev/null
+++ b/ghc/tests/io/should_run/io028.hs
@@ -0,0 +1,79 @@
+-- !!! Reconfiguring the buffering of a handle
+module Main(main) where
+
+import IO
+
+queryBuffering :: String -> Handle -> IO ()
+queryBuffering handle_nm handle = do
+  bufm  <- hGetBuffering handle
+  putStrLn ("Buffering for " ++ handle_nm ++ " is: " ++ show bufm)
+   
+main = do
+  queryBuffering "stdin" stdin
+  queryBuffering "stdout" stdout
+  queryBuffering "stderr" stderr
+
+   -- twiddling the setting for stdin.
+  hSetBuffering stdin NoBuffering
+  queryBuffering "stdin" stdin
+  hSetBuffering stdin LineBuffering
+  queryBuffering "stdin" stdin
+  hSetBuffering stdin (BlockBuffering (Just 2))
+  queryBuffering "stdin" stdin
+  hSetBuffering stdin (BlockBuffering Nothing)
+  queryBuffering "stdin" stdin
+  let bmo = BlockBuffering (Just (-3))
+  hSetBuffering stdin bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdin " ++ showParen True (showsPrec 9 bmo) [])
+
+  putChar '\n'
+
+   -- twiddling the buffering for stdout
+  hPutStr stdout "Hello stdout 1"
+  hSetBuffering stdout NoBuffering
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 2"
+  hSetBuffering stdout LineBuffering
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 3"
+  hSetBuffering stdout (BlockBuffering (Just 2))
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 4"
+  hSetBuffering stdout (BlockBuffering Nothing)
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 5"
+  let bmo = BlockBuffering (Just (-3))
+  hSetBuffering stdout bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdout " ++ showParen True (showsPrec 9 bmo) [])
+
+  putChar '\n'
+
+   -- twiddling the buffering for stderr
+  hPutStr stderr "Hello stderr 1"
+  hSetBuffering stderr NoBuffering
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 2"
+  hSetBuffering stderr LineBuffering
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 3"
+  hSetBuffering stderr (BlockBuffering (Just 2))
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 4"
+  hSetBuffering stderr (BlockBuffering Nothing)
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 5"
+  let bmo = BlockBuffering (Just (-3))
+  hSetBuffering stderr bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stderr " ++ showParen True (showsPrec 9 bmo) [])
+
+  ls  <- hGetContents stdin
+  ls' <- putLine ls
+  hSetBuffering stdin NoBuffering
+  putLine ls'
+  return ()
+
+putLine :: String -> IO String
+putLine [] = return []
+putLine (x:xs) = do
+   putChar x
+   case x of
+     '\n' -> return xs
+     _    -> putLine xs
+  
diff --git a/ghc/tests/io/should_run/io028.stderr b/ghc/tests/io/should_run/io028.stderr
new file mode 100644
index 0000000..a4cf877
--- /dev/null
+++ b/ghc/tests/io/should_run/io028.stderr
@@ -0,0 +1 @@
+Hello stderr 1Hello stderr 2Hello stderr 3Hello stderr 4Hello stderr 5
\ No newline at end of file
diff --git a/ghc/tests/io/should_run/io028.stdout b/ghc/tests/io/should_run/io028.stdout
new file mode 100644
index 0000000..7768773
--- /dev/null
+++ b/ghc/tests/io/should_run/io028.stdout
@@ -0,0 +1,22 @@
+Buffering for stdin is: BlockBuffering Nothing
+Buffering for stdout is: BlockBuffering Nothing
+Buffering for stderr is: NoBuffering
+Buffering for stdin is: NoBuffering
+Buffering for stdin is: LineBuffering
+Buffering for stdin is: BlockBuffering (Just 2)
+Buffering for stdin is: BlockBuffering Nothing
+Caught illegal op: hSetBuffering stdin (BlockBuffering (Just (-3)))
+
+Hello stdout 1Buffering for stdout is: NoBuffering
+Hello stdout 2Buffering for stdout is: LineBuffering
+Hello stdout 3Buffering for stdout is: BlockBuffering (Just 2)
+Hello stdout 4Buffering for stdout is: BlockBuffering Nothing
+Hello stdout 5Caught illegal op: hSetBuffering stdout (BlockBuffering (Just (-3)))
+
+Buffering for stderr is: NoBuffering
+Buffering for stderr is: LineBuffering
+Buffering for stderr is: BlockBuffering (Just 2)
+Buffering for stderr is: BlockBuffering Nothing
+Caught illegal op: hSetBuffering stderr (BlockBuffering (Just (-3)))
+-- !!! Reconfiguring the buffering of a handle
+module Main(main) where
diff --git a/ghc/tests/io/should_run/io029.hs b/ghc/tests/io/should_run/io029.hs
new file mode 100644
index 0000000..ccda98b
--- /dev/null
+++ b/ghc/tests/io/should_run/io029.hs
@@ -0,0 +1,27 @@
+--!!! Flushing
+module Main(main) where
+
+import IO
+import Directory ( removeFile )
+
+main = do
+  hFlush stdin `catch` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
+  putStr "Hello,"
+  hFlush stdout
+  putStr "Hello - "
+  hFlush stderr
+  hdl <- openFile "io029.hs" ReadMode
+  hFlush hdl `catch` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
+  hClose hdl
+  hdl <- openFile "io029.out" WriteMode
+  removeFile "io029.out"
+  hFlush hdl
+  hClose hdl
+  hdl <- openFile "io029.out" AppendMode
+  removeFile "io029.out"
+  hFlush hdl
+  hClose hdl
+  hdl <- openFile "io029.out" ReadWriteMode
+  removeFile "io029.out"
+  hFlush hdl
+  hClose hdl
diff --git a/ghc/tests/io/should_run/io029.stdout b/ghc/tests/io/should_run/io029.stdout
new file mode 100644
index 0000000..0954a7a
--- /dev/null
+++ b/ghc/tests/io/should_run/io029.stdout
@@ -0,0 +1,2 @@
+No can do - flushing read-only handles isn't legal
+Hello,Hello - No can do - flushing read-only handles isn't legal
diff --git a/ghc/tests/io/should_run/io030.hs b/ghc/tests/io/should_run/io030.hs
new file mode 100644
index 0000000..89eeda8
--- /dev/null
+++ b/ghc/tests/io/should_run/io030.hs
@@ -0,0 +1,50 @@
+--!!! file positions (hGetPosn and hSetPosn)
+module Main(main) where
+
+import IO
+import Monad ( accumulate )
+
+testPosns :: Handle -> BufferMode -> IO ()
+testPosns hdl bmo = do
+   hSetBuffering hdl bmo
+   putStrLn ("Testing positioning with buffer mode set to: " ++ show bmo)
+   testPositioning hdl
+
+bmo_ls = [NoBuffering, LineBuffering, BlockBuffering Nothing, 
+          BlockBuffering (Just 511),BlockBuffering (Just 3), BlockBuffering (Just 11)]
+
+main = do
+  hdl  <- openFile "io030.hs" ReadMode
+  sequence (zipWith testPosns (repeat hdl) bmo_ls)
+  hClose hdl
+
+testPositioning hdl = do
+  hSeek hdl AbsoluteSeek 0  -- go to the beginning of the file again.
+  ps   <- getFilePosns 10 hdl
+  hSeek hdl AbsoluteSeek 0
+  putStr "First ten chars: "
+  ls   <- hGetChars 10 hdl
+  putStrLn ls
+    -- go to the end
+  hSeek hdl SeekFromEnd 0  
+  ls   <- accumulate (map (\ p -> hSetPosn p >> hGetChar hdl) ps)
+  putStr "First ten chars: "
+  putStrLn ls
+
+    -- position ourselves in the middle.
+  sz <- hFileSize hdl
+  hSeek hdl AbsoluteSeek (sz `div` 2)
+  ls   <- accumulate (map (\ p -> hSetPosn p >> hGetChar hdl) ps)
+  putStr "First ten chars: "
+  putStrLn ls
+
+hGetChars :: Int -> Handle -> IO String
+hGetChars n h = accumulate (replicate n (hGetChar h))
+
+getFilePosns :: Int -> Handle -> IO [HandlePosn]
+getFilePosns 0 h = return []
+getFilePosns x h = do
+   p <- hGetPosn h
+   hGetChar h
+   ps <- getFilePosns (x-1) h
+   return (p:ps)
diff --git a/ghc/tests/io/should_run/io030.stdout b/ghc/tests/io/should_run/io030.stdout
new file mode 100644
index 0000000..9a24d34
--- /dev/null
+++ b/ghc/tests/io/should_run/io030.stdout
@@ -0,0 +1,24 @@
+Testing positioning with buffer mode set to: NoBuffering
+First ten chars: --!!! file
+First ten chars: --!!! file
+First ten chars: --!!! file
+Testing positioning with buffer mode set to: LineBuffering
+First ten chars: --!!! file
+First ten chars: --!!! file
+First ten chars: --!!! file
+Testing positioning with buffer mode set to: BlockBuffering Nothing
+First ten chars: --!!! file
+First ten chars: --!!! file
+First ten chars: --!!! file
+Testing positioning with buffer mode set to: BlockBuffering (Just 511)
+First ten chars: --!!! file
+First ten chars: --!!! file
+First ten chars: --!!! file
+Testing positioning with buffer mode set to: BlockBuffering (Just 3)
+First ten chars: --!!! file
+First ten chars: --!!! file
+First ten chars: --!!! file
+Testing positioning with buffer mode set to: BlockBuffering (Just 11)
+First ten chars: --!!! file
+First ten chars: --!!! file
+First ten chars: --!!! file
-- 
1.7.10.4