From e6c29f8b1abd4892bcb4a8626fc817e16ab960cd Mon Sep 17 00:00:00 2001
From: rrt <unknown>
Date: Tue, 25 Apr 2000 11:27:35 +0000
Subject: [PATCH] [project @ 2000-04-25 11:27:35 by rrt] Numerous tweaks to
remove out-of-date constructs and make tests Windows- friendly.
---
ghc/tests/io/should_run/Makefile | 8 ++++++++
ghc/tests/io/should_run/io005.hs | 2 ++
ghc/tests/io/should_run/io006.hs | 2 +-
ghc/tests/io/should_run/io007.hs | 2 +-
ghc/tests/io/should_run/io007.stdout | 2 +-
ghc/tests/io/should_run/io008.hs | 17 +++++++++--------
ghc/tests/io/should_run/io011.hs | 2 +-
ghc/tests/io/should_run/io012.hs | 7 ++++---
ghc/tests/io/should_run/io012.stdout | 1 +
ghc/tests/io/should_run/io013.hs | 11 +++--------
ghc/tests/io/should_run/io014.hs | 3 +--
ghc/tests/io/should_run/io015.hs | 2 +-
ghc/tests/io/should_run/io016.hs | 7 ++++---
ghc/tests/io/should_run/io017.hs | 2 +-
ghc/tests/io/should_run/io018.hs | 22 ++++++++++------------
ghc/tests/io/should_run/io021.hs | 2 +-
ghc/tests/io/should_run/io024.hs | 16 +++++++++-------
ghc/tests/io/should_run/io024.stdout | 8 ++++----
ghc/tests/io/should_run/io029.hs | 12 ++++++++----
ghc/tests/io/should_run/io031.hs | 8 +++++---
20 files changed, 75 insertions(+), 61 deletions(-)
diff --git a/ghc/tests/io/should_run/Makefile b/ghc/tests/io/should_run/Makefile
index 6cc9f8c4af6b..dcdd7e6c8b71 100644
--- a/ghc/tests/io/should_run/Makefile
+++ b/ghc/tests/io/should_run/Makefile
@@ -1,11 +1,19 @@
TOP = ../..
+
include $(TOP)/mk/boilerplate.mk
+
+ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
+OMITTED_RUNTESTS = io005.run io033.run
+endif
+
include $(TOP)/mk/should_run.mk
HC_OPTS += -dcore-lint
io022_HC_OPTS += -fglasgow-exts
io010_HC_OPTS += -fglasgow-exts
io011_HC_OPTS += -fglasgow-exts
+io018_HC_OPTS += -fglasgow-exts
+io030_HC_OPTS += -fglasgow-exts
io032_HC_OPTS += -fglasgow-exts
io004_RUNTEST_OPTS += -x 42
diff --git a/ghc/tests/io/should_run/io005.hs b/ghc/tests/io/should_run/io005.hs
index 0fd1f8624830..ac12847e52e6 100644
--- a/ghc/tests/io/should_run/io005.hs
+++ b/ghc/tests/io/should_run/io005.hs
@@ -1,3 +1,5 @@
+-- Not run on mingw, because of /dev/null use
+
import System (system, ExitCode(..), exitWith)
main =
diff --git a/ghc/tests/io/should_run/io006.hs b/ghc/tests/io/should_run/io006.hs
index 27fc0059811a..fe237d33ef31 100644
--- a/ghc/tests/io/should_run/io006.hs
+++ b/ghc/tests/io/should_run/io006.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main = do
hClose stderr
diff --git a/ghc/tests/io/should_run/io007.hs b/ghc/tests/io/should_run/io007.hs
index 596a78191d4c..0cd2f7e9ff87 100644
--- a/ghc/tests/io/should_run/io007.hs
+++ b/ghc/tests/io/should_run/io007.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main =
openFile "io007.hs" ReadMode >>= \ hIn ->
diff --git a/ghc/tests/io/should_run/io007.stdout b/ghc/tests/io/should_run/io007.stdout
index 596a78191d4c..0cd2f7e9ff87 100644
--- a/ghc/tests/io/should_run/io007.stdout
+++ b/ghc/tests/io/should_run/io007.stdout
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main =
openFile "io007.hs" ReadMode >>= \ hIn ->
diff --git a/ghc/tests/io/should_run/io008.hs b/ghc/tests/io/should_run/io008.hs
index 059e889b8499..5a3e3373ede5 100644
--- a/ghc/tests/io/should_run/io008.hs
+++ b/ghc/tests/io/should_run/io008.hs
@@ -1,15 +1,17 @@
+-- !!! Test file positioning
+
module Main(main) where
-import IO -- 1.3
---import IOBase -- tryIO 1.3
---import GHCio
+import IO
+import Monad
-import Directory (removeFile)
+import Directory (removeFile, doesFileExist)
main = do
- hIn <- openFile "io008.in" ReadMode
- hOut <- openFile "io008.out" ReadWriteMode
- removeFile "io008.out"
+ hIn <- openFile "io008.in" ReadMode
+ f <- doesFileExist "io008.out"
+ when f (removeFile "io008.out")
+ hOut <- openFile "io008.out" ReadWriteMode
bof <- hGetPosn hIn
copy hIn hOut
hSetPosn bof
@@ -23,4 +25,3 @@ copy hIn hOut =
try (hGetChar hIn) >>=
either (\ err -> if isEOFError err then return () else error "copy")
( \ x -> hPutChar hOut x >> copy hIn hOut)
-
diff --git a/ghc/tests/io/should_run/io011.hs b/ghc/tests/io/should_run/io011.hs
index 62750f71d5c7..0df9e00c904f 100644
--- a/ghc/tests/io/should_run/io011.hs
+++ b/ghc/tests/io/should_run/io011.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
import Directory
import IOExts (trace)
diff --git a/ghc/tests/io/should_run/io012.hs b/ghc/tests/io/should_run/io012.hs
index 5b7fe9ee12a7..06114c633d30 100644
--- a/ghc/tests/io/should_run/io012.hs
+++ b/ghc/tests/io/should_run/io012.hs
@@ -1,10 +1,11 @@
-import IO -- 1.3
+-- !!! Test getCPUTime
+
+import IO
import CPUTime
main = do
- h <- openFile "/dev/null" WriteMode
- hPrint h (nfib 30)
+ print (nfib 30)
t <- getCPUTime
print (length (show t)) -- printing the CPU time itself is un-cool if you want to diff the output..
diff --git a/ghc/tests/io/should_run/io012.stdout b/ghc/tests/io/should_run/io012.stdout
index b1bd38b62a08..a72e4b091f74 100644
--- a/ghc/tests/io/should_run/io012.stdout
+++ b/ghc/tests/io/should_run/io012.stdout
@@ -1 +1,2 @@
+2692537
13
diff --git a/ghc/tests/io/should_run/io013.hs b/ghc/tests/io/should_run/io013.hs
index a59921eba121..de3714002f29 100644
--- a/ghc/tests/io/should_run/io013.hs
+++ b/ghc/tests/io/should_run/io013.hs
@@ -1,8 +1,6 @@
--- If you're testing on a Win32 box, be aware that
--- line termination conventions differ (and that
--- io013 uses /dev/null, which is also unix centric.)
+-- !!! Test seeking
-import IO -- 1.3
+import IO
main = do
h <- openFile "io013.in" ReadMode
@@ -14,9 +12,6 @@ main = do
hSeek h RelativeSeek (-2)
w <- hGetChar h
putStr (w:"\n")
- ~True <- hIsSeekable h
- hClose h
- h <- openFile "/dev/null" ReadMode
- ~False <- hIsSeekable h
+ True <- hIsSeekable h
hClose h
diff --git a/ghc/tests/io/should_run/io014.hs b/ghc/tests/io/should_run/io014.hs
index 5249fbcccb63..9b956b00731a 100644
--- a/ghc/tests/io/should_run/io014.hs
+++ b/ghc/tests/io/should_run/io014.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main =
sequence (map hIsOpen [stdin, stdout, stderr]) >>= \ opens ->
@@ -16,7 +16,6 @@ main =
sequence (map hIsNotBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
print buffereds
where
- -- these didn't make it into 1.3
hIsBlockBuffered h = hGetBuffering h >>= \ b -> return $ case b of { BlockBuffering _ -> True; _ -> False }
hIsLineBuffered h = hGetBuffering h >>= \ b -> return $ case b of { LineBuffering -> True; _ -> False }
hIsNotBuffered h = hGetBuffering h >>= \ b -> return $ case b of { NoBuffering -> True; _ -> False }
diff --git a/ghc/tests/io/should_run/io015.hs b/ghc/tests/io/should_run/io015.hs
index 37f0cc134ab0..440493fce2e6 100644
--- a/ghc/tests/io/should_run/io015.hs
+++ b/ghc/tests/io/should_run/io015.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main =
isEOF >>= \ eof ->
diff --git a/ghc/tests/io/should_run/io016.hs b/ghc/tests/io/should_run/io016.hs
index a8b6eece0859..fc48cb5b534d 100644
--- a/ghc/tests/io/should_run/io016.hs
+++ b/ghc/tests/io/should_run/io016.hs
@@ -1,13 +1,14 @@
-import IO -- 1.3
+import IO
import System (getArgs)
import Char (toUpper)
-import Directory (removeFile)
+import Directory (removeFile, doesFileExist)
main = getArgs >>= \ [f1,f2] ->
openFile f1 ReadMode >>= \ h1 ->
+ doesFileExist f2 >>= \ f ->
+ if f then removeFile f2 else return () >>
openFile f2 WriteMode >>= \ h2 ->
- removeFile f2 >>
copyFile h1 h2 >>
hClose h1 >>
hClose h2
diff --git a/ghc/tests/io/should_run/io017.hs b/ghc/tests/io/should_run/io017.hs
index 2be725480b62..cba9fbd4cc71 100644
--- a/ghc/tests/io/should_run/io017.hs
+++ b/ghc/tests/io/should_run/io017.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main =
hSetBuffering stdout NoBuffering >>
diff --git a/ghc/tests/io/should_run/io018.hs b/ghc/tests/io/should_run/io018.hs
index 02b24bbee018..e465b5b90a94 100644
--- a/ghc/tests/io/should_run/io018.hs
+++ b/ghc/tests/io/should_run/io018.hs
@@ -1,17 +1,20 @@
-- !!! Testing RW handles
module Main(main) where
-
import IO
-import Directory (removeFile)
+import IOExts
+import Directory (removeFile, doesFileExist)
+import Monad
-- This test is weird, full marks to whoever dreamt it up!
main :: IO ()
main = do
let username = "io018.inout"
+ f <- doesFileExist username
+ when f (removeFile username)
cd <- openFile username ReadWriteMode
- removeFile username
+ hSetBinaryMode cd True
hSetBuffering stdin NoBuffering
hSetBuffering stdout NoBuffering
hSetBuffering cd NoBuffering
@@ -28,14 +31,9 @@ main = do
speakString = "Someone wants to speak with you\n"
speak cd = do
- (do
- ready <- hReady cd
- if ready then
- hGetChar cd >>= putChar
- else
- return ()
- ready <- hReady stdin
- if ready then (do { ch <- getChar; hPutChar cd ch})
- else return ())
+ ready <- hReady cd
+ if ready then hGetChar cd >>= putChar else return ()
+ ready <- hReady stdin
+ if ready then (do { ch <- getChar; hPutChar cd ch}) else return ()
speak cd
diff --git a/ghc/tests/io/should_run/io021.hs b/ghc/tests/io/should_run/io021.hs
index c45a40b9b1e4..396d4353c974 100644
--- a/ghc/tests/io/should_run/io021.hs
+++ b/ghc/tests/io/should_run/io021.hs
@@ -1,4 +1,4 @@
-import IO -- 1.3
+import IO
main =
hSetBuffering stdin NoBuffering >>
diff --git a/ghc/tests/io/should_run/io024.hs b/ghc/tests/io/should_run/io024.hs
index d0c698b35bb9..ade7de7de7ee 100644
--- a/ghc/tests/io/should_run/io024.hs
+++ b/ghc/tests/io/should_run/io024.hs
@@ -2,32 +2,34 @@
module Main(main) where
import IO
-import Directory ( removeFile )
+import Directory ( removeFile, doesFileExist )
+import Monad
main = do
sz <- hFileSize stdin `catch` (\ _ -> return (-1))
print sz
- let fn = "io025.out"
+ let fn = "io025.out"
+ f <- doesFileExist fn
+ when f (removeFile fn)
hdl <- openFile fn WriteMode
- removeFile fn
- hPutStrLn hdl "file_size"
+ hPutStr hdl "file_size"
-- with default buffering
sz <- hFileSize hdl
print sz
hSetBuffering hdl NoBuffering
- hPutStrLn hdl "file_size"
+ hPutStr hdl "file_size"
-- with no buffering
sz <- hFileSize hdl
print sz
hSetBuffering hdl LineBuffering
- hPutStrLn hdl "file_size"
+ hPutStr hdl "file_size"
-- with line buffering
sz <- hFileSize hdl
print sz
hSetBuffering hdl (BlockBuffering (Just 4))
-- with block buffering
- hPutStrLn hdl "file_size"
+ hPutStr 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
index 2f3d38d47aee..23dd73404861 100644
--- a/ghc/tests/io/should_run/io024.stdout
+++ b/ghc/tests/io/should_run/io024.stdout
@@ -1,5 +1,5 @@
-1
-10
-20
-30
-40
+9
+18
+27
+36
diff --git a/ghc/tests/io/should_run/io029.hs b/ghc/tests/io/should_run/io029.hs
index 8af28463fcb3..4eb722d507cb 100644
--- a/ghc/tests/io/should_run/io029.hs
+++ b/ghc/tests/io/should_run/io029.hs
@@ -2,7 +2,8 @@
module Main(main) where
import IO
-import Directory ( removeFile )
+import Directory ( removeFile, doesFileExist )
+import Monad
main = do
hFlush stdin `catch` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
@@ -13,15 +14,18 @@ main = do
hdl <- openFile "io029.hs" ReadMode
hFlush hdl `catch` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
hClose hdl
+ remove
hdl <- openFile "io029.out" WriteMode
- removeFile "io029.out"
hFlush hdl
hClose hdl
+ remove
hdl <- openFile "io029.out" AppendMode
- removeFile "io029.out"
hFlush hdl
hClose hdl
+ remove
hdl <- openFile "io029.out" ReadWriteMode
- removeFile "io029.out"
hFlush hdl
hClose hdl
+ where remove = do
+ f <- doesFileExist "io029.out"
+ when f (removeFile "io029.out")
diff --git a/ghc/tests/io/should_run/io031.hs b/ghc/tests/io/should_run/io031.hs
index 798c154a668d..7cae45162f96 100644
--- a/ghc/tests/io/should_run/io031.hs
+++ b/ghc/tests/io/should_run/io031.hs
@@ -2,11 +2,13 @@
module Main(main) where
import IO
-import Directory ( removeFile )
+import Directory ( removeFile, doesFileExist )
+import Monad
-main = do
+main = do
+ f <- doesFileExist "io031.inout"
+ when f (removeFile "io031.inout")
hdl <- openFile "io031.inout" ReadWriteMode
- removeFile "io031.inout"
hSetBuffering hdl LineBuffering
hPutStr hdl "as"
hSeek hdl AbsoluteSeek 0
--
GitLab