Commit 8fe8aed2 authored by sewardj's avatar sewardj
Browse files

[project @ 2001-06-21 16:21:48 by sewardj]

Further adventures to do with approximate matching of compiler error
messages.  Use the new pipe facility in the test driver to normalise
error messages before comparison, by piping them through new program
normalise_errmsg.  This avoids various kinds of tiresome comparison
failures to do with capitalisation, whitespace changes, and path
names.
parent 9ea3922e
......@@ -46,6 +46,16 @@ def rm_nofail ( $_files )
$res = run $cmd
}
-- Generate unique temporary file names.
def normalise_errmsg ( $errmsg )
{
$unpathify = $confdir ++ "/../../utils/normalise_errmsg/normalise_errmsg"
$normd = $errmsg | $unpathify
return $normd
}
---------------------------------------------------------------
--- COMPILATION ---
......@@ -239,12 +249,58 @@ def vanilla-comp-test-actions ( $extra_compile_args )
{
pretest_cleanup()
$res = simple_build_Main_WRK ( $extra_compile_args, True )
if $res /= "0"
|| contents(qualify("comp.stderr")) /= ""
-- If the compiler barf'd, fail.
if $res /= "0" then return False fi
-- If there's an expected .stderr (presumably containing
-- warnings), ensure the compiler produced the same.
$expected_stderr = qualify("stderr")
$actual_stderr = qualify("comp.stderr")
if exists($expected_stderr) &&
contents($actual_stderr) /= contents($expected_stderr)
then return False
fi
-- There's no expected stderr, so just insist that the compiler
-- produced nothing on stderr.
if contents($actual_stderr) /= "" then return False fi
-- Must have succeeded.
return True
}
-- Compile with expected fail (should_fail) style test. Deemed to have
-- succeeded if the compiler returned nonzero AND testname.comp.stderr
-- equals testname.stderr.
def vanilla-compfail-test-actions ( $extra_compile_args )
{
pretest_cleanup()
$expected_stderr = qualify("stderr")
-- Sanity check
if not(exists($expected_stderr))
then framefail "should_fail: expected .stderr is missing"
fi
$res = simple_build_Main_WRK ( $extra_compile_args, True )
$stderr_a = normalise_errmsg(contents(qualify("comp.stderr")))
$stderr_e = normalise_errmsg(contents($expected_stderr))
if $stderr_e /= $stderr_a
then print ( "-- UNMATCHED ERROR MSGS: EXPECTED\n" ++ $stderr_e ++
"-- ACTUAL\n" ++ $stderr_a ++ "-- END\n" )
fi
if $res /= "0" && $stderr_e == $stderr_a
then
return False
else
return True
else
return False
fi
}
......@@ -282,6 +338,20 @@ def vtc ( $extra_compile_args )
fail when otherwise
}
-- Compile only, and expect failure (should_fail) style test
def vtf ( $extra_compile_args )
{
$test_passed
= vanilla-compfail-test-actions ( $extra_compile_args )
expect pass
pass when $test_passed
fail when otherwise
}
-----------------------------------------------------------------------
--- end vanilla-test.T ---
-----------------------------------------------------------------------
module Main
where
import Char
{-
Copy text from stdin to stdout. Normalise it to make
comparison of compiler error messages less troublesome.
-- Remove all whitespace lines
-- Merge all other whitespace into a single space.
-- Make all lowercase.
-- Look for file names and zap the directory part:
foo/var/xyzzy/somefile.ext --> somefile.ext
This progream is used by the test system (vanilla-test.T) to normalise
actual compilation error messages before comparing them against
expected messages.
-}
isFnChar = not . isSpace
isOther = not . isFnChar
unpathify []
= []
unpathify (c:cs)
| isFnChar c
= let cz = takeWhile isFnChar (c:cs)
in zap_path cz ++ unpathify (drop (length cz) (c:cs))
| otherwise
= let cz = takeWhile (not.isFnChar) (c:cs)
in cz ++ unpathify (drop (length cz) (c:cs))
zap_path
= reverse . takeWhile (/= '/') . reverse
main
= interact clean
clean str
= let
-- convert all non-\n whitespace to space
toSpace c = if isSpace c && c /= '\n' then ' ' else c
spaced = map toSpace str
-- collapse sequences of spaces into one
collapse [] = []
collapse (' ':' ':cs) = collapse (' ':cs)
collapse (c:cs) = c : collapse cs
collapsed = collapse spaced
-- lowercasify everything
lowered = map toLower collapsed
-- zap blank lines
unblanked
= (unlines . map (dropWhile isSpace)
. filter (not . (all isSpace)) . lines)
lowered
-- zap directory-parts in pathnames
unpathified = unpathify unblanked
in
unpathified
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment