From: rrt <unknown>
Date: Tue, 25 Apr 2000 11:27:35 +0000 (+0000)
Subject: [project @ 2000-04-25 11:27:35 by rrt]
X-Git-Tag: Approximately_9120_patches~4618
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e6c29f8b1abd4892bcb4a8626fc817e16ab960cd;p=ghc-hetmet.git

[project @ 2000-04-25 11:27:35 by rrt]
Numerous tweaks to remove out-of-date constructs and make tests Windows-
friendly.
---

diff --git a/ghc/tests/io/should_run/Makefile b/ghc/tests/io/should_run/Makefile
index 6cc9f8c..dcdd7e6 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 0fd1f86..ac12847 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 27fc005..fe237d3 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 596a781..0cd2f7e 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 596a781..0cd2f7e 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 059e889..5a3e337 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 62750f7..0df9e00 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 5b7fe9e..06114c6 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 b1bd38b..a72e4b0 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 a59921e..de37140 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 5249fbc..9b956b0 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 37f0cc1..440493f 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 a8b6eec..fc48cb5 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 2be7254..cba9fbd 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 02b24bb..e465b5b 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 c45a40b..396d435 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 d0c698b..ade7de7 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 2f3d38d..23dd734 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 8af2846..4eb722d 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 798c154..7cae451 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