Commit c9cb517c authored by rrt's avatar rrt
Browse files

[project @ 2001-09-07 13:00:51 by rrt]

Test-suite titivation
		      ---------------------

This commit achieves several glorious goals and adds many frivolous
features:

    * Makes the test driver work on Windows (use bash for system calls)
    * Adds -Di386_unknown_mingw32 to CPP_OPTS so that Win-specific code is
      compiled properly
    * Adds the ability to have platform-specific test results (by setting
      the new $platform variable to config.mk's TARGETPLATFORM)
    * Fixes several tests to work on Windows, mostly by adding platform-
      specific result files.
    * Pipes all stderr files through normalise_errmsg, which itself is
      improved to handle .exe at the end of filenames, and backslashes.
    * Allows stdout output to be piped through normalise_errmsg; useful in
      the rare cases where output includes filenames.
    * Comprehensively breaks the testsuite on all other platforms (with any
      luck)
    * Splundig vur thrig, earthlets!
parent 0ecc9e31
......@@ -8,6 +8,8 @@
-- global variables:
$stdin = ""
$expect = "pass"
$normalise_errmsg = False
$normalise_output = False
---------------------------------------------------------------
--- UTILITY FNs ---
......@@ -91,45 +93,6 @@ def simple_build_prog_WRK ( $_main, $_extra_args )
}
---------------------------------------------------------------
--- RUNNING, AND ASSESSING RUN RESULTS ---
---------------------------------------------------------------
-- Check that the run.stdout file matches at least one spec'd stdout.
def check_stdout_ok()
{
$r_stdout = qualify("run.stdout")
$s_stdout = qualify("stdout")
if not ( exists($s_stdout) )
then if ((contents $r_stdout) == "")
then return True
else say_fail_because_nonempty($r_stdout)
return False
fi
fi
return same($s_stdout, $r_stdout)
}
-- If there's any spec'd stderr files, check that the run.stderr matches it.
-- Check that the run.stdout file matches at least one spec'd stdout.
def check_stderr_ok()
{
$r_stderr = qualify("run.stderr")
$s_stderr = qualify("stderr")
if not ( exists($s_stderr) )
then if ((contents $r_stderr) == "")
then return True
else say_fail_because_output_produced($r_stdout)
return False
fi
fi
return same($s_stderr, $r_stderr)
}
---------------------------------------------------------------
--- CONDUCTING A COMPLETE TEST ---
---------------------------------------------------------------
......
......@@ -59,6 +59,16 @@ def qualify ( $_filename_frag )
fi
}
-- "foo" -> qualify("foo-platform") if it exists, or qualify("foo") otherwise
def platform_qualify ( $_filename_frag )
{
$name = qualify($_filename_frag)
if exists($name ++ "-" ++ $platform)
then return $name ++ "-" ++ $platform
else return $name
fi
}
def testnameWith ( $_filename_frag )
{
if $_filename_frag == ""
......@@ -106,6 +116,22 @@ def same ( $_file1, $_file2 )
return $same
}
-- returns True if both files are identical when normalised (unpathified)
def same_normalised ( $_file1, $_file2 )
{
if defined $verbose
then print "vanilla-test: comparing " ++ $_file1
++ " and " ++ $_file2
fi
$cts1 = normalise_errmsg(contents($_file1))
$cts2 = normalise_errmsg(contents($_file2))
$same = $cts1 == $cts2
if not($same) then
say_fail_because_noteq($_file1, $_file2)
fi
return $same
}
-- Give hints as to why a test is failing.
def say_fail_because_noteq ( $filename1, $filename2 )
{
......@@ -191,3 +217,47 @@ def simple_run_pgm( $extra_args, $exit_code )
return $test_passed
}
-- Check that the run.stdout file matches either the .stdout-TARGETPLATFORM
-- (if it exists) or the .stdout otherwise.
def check_stdout_ok()
{
$r_stdout = qualify("run.stdout")
$s_stdout = platform_qualify("stdout")
if not ( exists($s_stdout) )
then if ((contents $r_stdout) == "")
then return True
else say_fail_because_nonempty($r_stdout)
return False
fi
fi
if $normalise_output
then return same_normalised($s_stdout, $r_stdout)
else return same($s_stdout, $r_stdout)
fi
}
-- Check that the run.stderr matches either the .stderr-TARGETPLATFORM
-- (if it exists) or the .stderr otherwise. Normalise the stderr if
-- $normalise_errmsg is set
def check_stderr_ok()
{
$r_stderr = qualify("run.stderr")
$s_stderr = platform_qualify("stderr")
if not ( exists($s_stderr) )
then if ((contents $r_stderr) == "")
then return True
else say_fail_because_nonempty($r_stderr)
return False
fi
fi
-- if $normalise_errmsg
-- then
return same_normalised($s_stderr, $r_stderr)
-- else return same($s_stderr, $r_stderr)
-- fi
}
......@@ -7,10 +7,13 @@
-- global variables:
$stdin = ""
$expect = "pass"
$normalise_errmsg = False
$normalise_output = False
---------------------------------------------------------------
-- Define the following things on the command line:
--
-- $platform TARGETPLATFORM from config.mk
-- $verbose print command lines
-- $accept accept any changed output
......@@ -69,48 +72,12 @@ def simple_build_Main_WRK ( $_extra_args, $compile_only )
then " -c "
else " -o " ++ $testname ++ " ")
++ $srcname ++ " >" ++ $errname ++ " 2>&1"
print $cmd
$res = runCmd($cmd)
return $res
}
-- Check that the run.stdout file matches at least one spec'd stdout.
def check_stdout_ok()
{
$r_stdout = qualify("run.stdout")
$s_stdout = qualify("stdout")
if not ( exists($s_stdout) )
then if ((contents $r_stdout) == "")
then return True
else say_fail_because_nonempty($r_stdout)
return False
fi
fi
return same($s_stdout, $r_stdout)
}
-- If there's any spec'd stderr files, check that the run.stderr matches it.
-- Check that the run.stdout file matches at least one spec'd stdout.
def check_stderr_ok()
{
$r_stderr = qualify("run.stderr")
$s_stderr = qualify("stderr")
if not ( exists($s_stderr) )
then if ((contents $r_stderr) == "")
then return True
else say_fail_because_nonempty($r_stderr)
return False
fi
fi
return same($s_stderr, $r_stderr)
}
---------------------------------------------------------------
--- CONDUCTING A COMPLETE TEST ---
---------------------------------------------------------------
......@@ -157,7 +124,7 @@ def vanilla-compok-test-actions ( $extra_compile_args )
-- If there's an expected .stderr, presumably containing
-- warnings, ensure the compiler produced the same.
$actual_stderr = qualify("comp.stderr")
$expected_stderr = qualify("stderr")
$expected_stderr = platform_qualify("stderr")
if exists($expected_stderr)
then $stderr_a = normalise_errmsg(contents($actual_stderr))
$stderr_e = normalise_errmsg(contents($expected_stderr))
......@@ -187,7 +154,7 @@ def vanilla-compok-test-actions ( $extra_compile_args )
def vanilla-compfail-test-actions ( $extra_compile_args )
{
pretest_cleanup()
$expected_stderr = qualify("stderr")
$expected_stderr = platform_qualify("stderr")
-- Sanity check
if not(exists($expected_stderr))
......
......@@ -29,9 +29,7 @@ die :: String -> IO a
die s = do officialMsg s; exitWith (ExitFailure 1)
my_system s
= do -- putStrLn ("***" ++ s)
exit_code <- system s
-- putStrLn "ok"
= do exit_code <- system s
return exit_code
isLeft (Left _) = True
......
......@@ -18,6 +18,8 @@
# ghastly hack, because the driver requires that $tool be an absolute path name.
GHC_INPLACE_ABS = $(FPTOOLS_TOP_ABS)/ghc/compiler/ghc-inplace
EXTRA_HC_OPTS += -D$(HostPlatform_CPP)
# ideally TargetPlatform_CPP, but that doesn't exist; they're always the same anyway
RUNTESTS = $(TOP)/driver/runtests
RUNTEST_OPTS = --config=$(CONFIG) tool=$(GHC_INPLACE_ABS) extra_hc_flags="$(EXTRA_HC_OPTS)" $(EXTRA_RUNTEST_OPTS)
CONFIG = $(TOP)/config/msrc/cam-02-unx.T
......@@ -28,11 +30,11 @@ TEST =
all :: test
test:
$(RUNTESTS) $(RUNTEST_OPTS) $(TEST) $(TESTS)
$(RUNTESTS) $(RUNTEST_OPTS) platform=$(TARGETPLATFORM) $(TEST) $(TESTS)
verbose:
$(RUNTESTS) $(RUNTEST_OPTS) verbose= $(TEST) $(TESTS)
$(RUNTESTS) $(RUNTEST_OPTS) platform=$(TARGETPLATFORM) verbose= $(TEST) $(TESTS)
accept:
$(RUNTESTS) $(RUNTEST_OPTS) accept= verbose= $(TEST) $(TESTS)
$(RUNTESTS) $(RUNTEST_OPTS) platform=$(TARGETPLATFORM) verbose= accept= $(TEST) $(TESTS)
......@@ -41,7 +41,8 @@ test "cg034" { vtr("", "", "") }
test "cg035" { vtr("-package lang -fglasgow-exts", "", "") }
test "cg036" { vtr("", "", "") }
test "cg037" { vtr("", "", "") }
test "cg038" { vtr("", "", "") }
test "cg038" { if $platform=="i386-unknown-mingw32" then $expect="fail" fi
vtr("", "", "") }
test "cg039" { vtr("", "", "") }
test "cg040" { vtr("", "", "") }
test "cg042" { vtr("-package lang -fglasgow-exts", "", "") }
......
include ($confdir ++ "/../vanilla-test.T")
-- Args to vt are: extra compile flags
-- extra run flags
-- expected process return value, if not zero
-- Args to vtr are: extra compile flags
-- extra run flags
-- expected process return value, if not zero
-- whether to normalise (depathify) stderr output
def myvtr ( $args_c, $args_r, $ret_res )
{
......@@ -29,14 +30,8 @@ test "conc016" { myvtr("", "", "") }
test "conc017" { myvtr("", "", "") }
test "conc018" { myvtr("", "", "") }
test "conc019" { myvtr("", "", "") }
--# conc020 *should* work on mingw32
test "conc020" { skip when $os == "mingw32"
myvtr("", "", "") }
test "conc021" { skip when $os == "mingw32"
myvtr("", "", "250") }
test "conc020" { myvtr("", "", "") }
test "conc021" { $normalise_errmsg = True myvtr("", "", "250") }
test "conc022" { myvtr("", "", "") }
test "conc023" { myvtr("", "", "") }
test "conc024" { myvtr("", "", "") }
......
-- !!! testing hGetLine
import IO
#if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
......@@ -14,9 +14,9 @@ main = do
h <- openFile "hGetLine001.hs" ReadMode
# if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
# endif
#endif
hSetBuffering h NoBuffering
loop h
......
-- !!! testing hGetLine
import IO
#if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
......@@ -14,100 +14,10 @@ main = do
h <- openFile "hGetLine001.hs" ReadMode
# if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
# endif
hSetBuffering h NoBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h LineBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
-- !!! testing hGetLine
import IO
#if defined(__MINGW32__)
import PrelHandle(hSetBinaryMode)
#endif
-- one version of 'cat'
main = do
let loop h = do b <- hIsEOF h
if b then return ()
else do l <- hGetLine h; putStrLn l; loop h
loop stdin
h <- openFile "hGetLine001.hs" ReadMode
# if defined(__MINGW32__)
hSetBinaryMode h True
# endif
hSetBuffering h NoBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h LineBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
-- !!! testing hGetLine
import IO
#if defined(__MINGW32__)
import PrelHandle(hSetBinaryMode)
#endif
-- one version of 'cat'
main = do
let loop h = do b <- hIsEOF h
if b then return ()
else do l <- hGetLine h; putStrLn l; loop h
loop stdin
h <- openFile "hGetLine001.hs" ReadMode
# if defined(__MINGW32__)
hSetBinaryMode h True
# endif
hSetBuffering h NoBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h LineBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
-- !!! testing hGetLine
import IO
#if defined(__MINGW32__)
import PrelHandle(hSetBinaryMode)
#endif
-- one version of 'cat'
main = do
let loop h = do b <- hIsEOF h
if b then return ()
else do l <- hGetLine h; putStrLn l; loop h
loop stdin
h <- openFile "hGetLine001.hs" ReadMode
# if defined(__MINGW32__)
hSetBinaryMode h True
# endif
hSetBuffering h NoBuffering
loop h
......@@ -118,3 +28,93 @@ main = do
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
-- !!! testing hGetLine
import IO
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
-- one version of 'cat'
main = do
let loop h = do b <- hIsEOF h
if b then return ()
else do l <- hGetLine h; putStrLn l; loop h
loop stdin
h <- openFile "hGetLine001.hs" ReadMode
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
#endif
hSetBuffering h NoBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h LineBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
-- !!! testing hGetLine
import IO
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
-- one version of 'cat'
main = do
let loop h = do b <- hIsEOF h
if b then return ()
else do l <- hGetLine h; putStrLn l; loop h
loop stdin
h <- openFile "hGetLine001.hs" ReadMode
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
#endif
hSetBuffering h NoBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h LineBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
-- !!! testing hGetLine
import IO
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
-- one version of 'cat'
main = do
let loop h = do b <- hIsEOF h
if b then return ()
else do l <- hGetLine h; putStrLn l; loop h
loop stdin
h <- openFile "hGetLine001.hs" ReadMode
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
#endif
hSetBuffering h NoBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h LineBuffering
loop h
hSeek h AbsoluteSeek 0
hSetBuffering h (BlockBuffering (Just 83))
loop h
......@@ -5,21 +5,21 @@ module Main(main) where
import IO
import Monad
import Directory (removeFile, doesFileExist)
#if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
main = do
hIn <- openFile "hGetPosn001.in" ReadMode
# if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode hIn True
# endif
#endif
f <- doesFileExist "hGetPosn001.out"
when f (removeFile "hGetPosn001.out")
hOut <- openFile "hGetPosn001.out" ReadWriteMode
# if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode hOut True
# endif
#endif
bof <- hGetPosn hIn
copy hIn hOut
hSetPosn bof
......
-- !!! test hIsEOF in various buffering situations
import IO
#if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
main = do
h <- openFile "hIsEOF002.hs" ReadMode
# if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
# endif
#endif
hSetBuffering h NoBuffering
hSeek h SeekFromEnd 0
hIsEOF h >>= print
......@@ -44,9 +44,9 @@ main = do
hClose h
h <- openFile "hIsEOF002.out" ReadWriteMode
# if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
# endif
#endif
hSetBuffering h NoBuffering
hSeek h SeekFromEnd 0
hIsEOF h >>= print
......
......@@ -4,13 +4,13 @@
-- but in GHC it returns True (known bug).
import IO
#if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
import PrelHandle(hSetBinaryMode)
#endif
main = do
h <- openFile "hReady001.hs" ReadMode
#if defined(__MINGW32__)
#ifdef i386_unknown_mingw32
hSetBinaryMode h True
#endif
hSeek h SeekFromEnd 0
......
-- !!! Test seeking
import IO
#if defined(__MINGW32__)
import PrelHandle(hSetBinaryMode)
#endif
main = do
h <- openFile "hSeek001.in" ReadMode
# if defined(__MINGW32__)
hSetBinaryMode h True
# endif
True <- hIsSeekable h
hSeek h SeekFromEnd (-1)