Commit f72f23f9 authored by thomie's avatar thomie

Testsuite: run tests in <testdir>.run instead of /tmp

As discussed in Phab:D1187, this approach makes it a bit easier to
inspect the test directory while working on a new test.

The only tests that needed changes are the ones that refer to files in
ancestor directories. Those files are now copied directly into the test
directory.

validate still runs the tests in a temporary directory in /tmp, see
`Note [Running tests in /tmp]` in testsuite/driver/runtests.py.

Update submodule hpc.

Reviewed by: simonmar

Differential Revision: https://phabricator.haskell.org/D2333

GHC Trac Issues: #11980
parent e02beb18
......@@ -181,3 +181,6 @@ GIT_COMMIT_ID
.ghc
.bash_history
.gitconfig
# Should be equal to testdir_suffix from testsuite/driver/testlib.py.
*.run
Subproject commit d8b5381bd5d03a3a75f4a1b91f1ede6fe0fd0ce9
Subproject commit b52ab0cc013beb1440607a7e4521a45fd6e96ce8
......@@ -81,7 +81,6 @@ if (ghc_with_llvm == 1):
config.run_ways.append('optllvm')
config.in_tree_compiler = in_tree_compiler
config.cleanup = cleanup
config.way_flags = lambda name : {
'normal' : [],
......
......@@ -276,10 +276,24 @@ else:
# set stdout to unbuffered (is this the best way to do it?)
sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w", 0)
tempdir = tempfile.mkdtemp('', 'ghctest-')
if config.local:
tempdir = ''
else:
# See note [Running tests in /tmp]
tempdir = tempfile.mkdtemp('', 'ghctest-')
# opts.testdir should be quoted when used, to make sure the testsuite
# keeps working when it contains backward slashes, for example from
# using os.path.join. Windows native and mingw* python
# (/mingw64/bin/python) set `os.path.sep = '\\'`, while msys2 python
# (/bin/python, /usr/bin/python or /usr/local/bin/python) sets
# `os.path.sep = '/'`.
# To catch usage of unquoted opts.testdir early, insert some spaces into
# tempdir.
tempdir = os.path.join(tempdir, 'test spaces')
def cleanup_and_exit(exitcode):
if config.cleanup:
if config.cleanup and tempdir:
shutil.rmtree(tempdir, ignore_errors=True)
exit(exitcode)
......@@ -334,3 +348,35 @@ else:
summary(t, open(config.summary_file, 'w'))
cleanup_and_exit(0)
# Note [Running tests in /tmp]
#
# Use LOCAL=0 to run tests in /tmp, to catch tests that use files from
# the source directory without copying them to the test directory first.
#
# As an example, take a run_command test with a Makefile containing
# `$(TEST_HC) ../Foo.hs`. GHC will now create the output files Foo.o and
# Foo.hi in the source directory. There are 2 problems with this:
# * Output files in the source directory won't get cleaned up automatically.
# * Two tests might (over)write the same output file.
#
# Tests that only fail when run concurrently with other tests are the
# worst, so we try to catch them early by enabling LOCAL=0 in validate.
#
# Adding -outputdir='.' to TEST_HC_OPTS would help a bit, but it requires
# making changes to quite a few tests. The problem is that
# `$(TEST_HC) ../Foo.hs -outputdir=.` with Foo.hs containing
# `module Main where` does not produce Foo.o, as it would without
# -outputdir, but Main.o. See [1].
#
# Using -outputdir='.' is not foolproof anyway, since it does not change
# the destination of the final executable (Foo.exe).
#
# Another hardening method that could be tried is to `chmod -w` the
# source directory.
#
# By default we set LOCAL=1, because it makes it easier to inspect the
# test directory while working on a new test.
#
# [1]
# https://downloads.haskell.org/~ghc/8.0.1/docs/html/users_guide/separate_compilation.html#output-files
......@@ -274,6 +274,12 @@ class TestOptions:
self.compile_timeout_multiplier = 1.0
self.run_timeout_multiplier = 1.0
self.cleanup = True
# Sould we run tests in a local subdirectory (<testname>-run) or
# in temporary directory in /tmp? See Note [Running tests in /tmp].
self.local = True
# The default set of options
global default_testopts
default_testopts = TestOptions()
......
......@@ -546,25 +546,6 @@ def executeSetups(fs, name, opts):
# The current directory of tests
def newTestDir(tempdir, dir):
# opts.testdir should be quoted when used, to make sure the testsuite
# keeps working when it contains backward slashes, for example from
# using os.path.join. Windows native and mingw* python
# (/mingw64/bin/python) set `os.path.sep = '\\'`, while msys2 python
# (/bin/python, /usr/bin/python or /usr/local/bin/python) sets
# `os.path.sep = '/'`.
# To catch usage of unquoted opts.testdir early, insert some spaces into
# tempdir.
tempdir = os.path.join(tempdir, 'test spaces')
# Hack. A few tests depend on files in ancestor directories
# (e.g. extra_files(['../../../../libraries/base/dist-install/haddock.t']))
# Make sure tempdir is sufficiently "deep", such that copying/linking those
# files won't cause any problems.
#
# If you received a framework failure about adding an extra level:
# * add one extra '../' to the startswith('../../../../../') in do_test
# * add one more number here:
tempdir = os.path.join(tempdir, '1', '2', '3')
global thisdir_settings
# reset the options for this test directory
......@@ -572,10 +553,12 @@ def newTestDir(tempdir, dir):
return _newTestDir(name, opts, tempdir, dir)
thisdir_settings = settings
# Should be equal to entry in toplevel .gitignore.
testdir_suffix = '.run'
def _newTestDir(name, opts, tempdir, dir):
opts.srcdir = os.path.join(os.getcwd(), dir)
opts.testdir = os.path.join(tempdir, dir, name)
opts.testdir = os.path.join(tempdir, dir, name + testdir_suffix)
opts.compiler_always_flags = config.compiler_always_flags
# -----------------------------------------------------------------------------
......@@ -718,13 +701,10 @@ def test_common_work (name, opts, func, args):
# this seems to be necessary for only about 10% of all
# tests).
files = set((f for f in os.listdir(opts.srcdir)
if f.startswith(name)))
if f.startswith(name) and
not f.endswith(testdir_suffix)))
for filename in (opts.extra_files + extra_src_files.get(name, [])):
if filename.startswith('../../../../../../'):
framework_fail(name, 'whole-test',
'add extra level to testlib.py:newTestDir for: ' + filename)
elif filename.startswith('/'):
if filename.startswith('/'):
framework_fail(name, 'whole-test',
'no absolute paths in extra_files please: ' + filename)
......@@ -790,8 +770,18 @@ def do_test(name, way, func, args, files):
# would otherwise (accidentally) write to the same output file.
# It also makes it easier to keep the testsuite clean.
for filename in files:
src = in_srcdir(filename)
for extra_file in files:
src = in_srcdir(extra_file)
if extra_file.startswith('..'):
# In case the extra_file is a file in an ancestor
# directory (e.g. extra_files(['../shell.hs'])), make
# sure it is copied to the test directory
# (testdir/shell.hs), instead of ending up somewhere
# else in the tree (testdir/../shell.hs)
filename = os.path.basename(extra_file)
else:
filename = extra_file
assert not '..' in filename # no funny stuff (foo/../../bar)
dst = in_testdir(filename)
if os.path.isfile(src):
......@@ -821,7 +811,7 @@ def do_test(name, way, func, args, files):
pass
else:
framework_fail(name, way,
'extra_file does not exist: ' + filename)
'extra_file does not exist: ' + extra_file)
if not files:
# Always create the testdir, even when no files were copied
......
......@@ -192,11 +192,20 @@ RUNTEST_OPTS += --skip-perf-tests
endif
ifeq "$(CLEANUP)" "0"
RUNTEST_OPTS += -e cleanup=False
RUNTEST_OPTS += -e config.cleanup=False
else ifeq "$(CLEANUP)" "NO"
RUNTEST_OPTS += -e cleanup=False
RUNTEST_OPTS += -e config.cleanup=False
else
RUNTEST_OPTS += -e cleanup=True
RUNTEST_OPTS += -e config.cleanup=True
endif
ifeq "$(LOCAL)" "0"
# See Note [Running tests in /tmp].
RUNTEST_OPTS += -e config.local=False
else ifeq "$(LOCAL)" "NO"
RUNTEST_OPTS += -e config.local=False
else
RUNTEST_OPTS += -e config.local=True
endif
RUNTEST_OPTS += \
......
......@@ -35,9 +35,7 @@ test('print031', normal, ghci_script, ['print031.script'])
test('print032', normal, ghci_script, ['print032.script'])
test('print033', normal, ghci_script, ['print033.script'])
test('print034', normal, ghci_script, ['print034.script'])
test('print035',
[extra_clean(['../Unboxed.hi', '../Unboxed.o'])],
ghci_script, ['print035.script'])
test('print035', normal, ghci_script, ['print035.script'])
test('print036', expect_broken(9046), ghci_script, ['print036.script'])
test('break001', normal, ghci_script, ['break001.script'])
......
:l ../Test2
:l Test2
:b 3
:b 5
f (1 :: Integer)
......
Breakpoint 0 activated at ../Test2.hs:3:7-9
Breakpoint 1 activated at ../Test2.hs:5:7
Stopped in Test2.f, ../Test2.hs:3:7-9
Breakpoint 0 activated at Test2.hs:3:7-9
Breakpoint 1 activated at Test2.hs:5:7
Stopped in Test2.f, Test2.hs:3:7-9
_result :: Integer = _
x :: Integer = 1
Stopped in Test2.g, ../Test2.hs:5:7
Stopped in Test2.g, Test2.hs:5:7
_result :: Integer = _
y :: Integer = 1
y :: Integer = 1
......
-- can't set breakpoints on non-interpreted things:
:b Data.List.map
:l ../Test2.hs
:l Test2.hs
:b Data.List.map
Breakpoint 0 activated at ../Test3.hs:2:18-31
Stopped in Main.mymap, ../Test3.hs:2:18-31
Breakpoint 0 activated at Test3.hs:2:18-31
Stopped in Main.mymap, Test3.hs:2:18-31
_result :: [a] = _
f :: t -> a = _
x :: t = _
......
:l ../Test4.hs
:l Test4.hs
:b f
seq (f (+(1::Int)) "abc") ()
-- We can subvert the Unknown machinery this was and pass the string
......
:l ../QSort
:l QSort
:st qsort [1::Integer,2]
:step
seq left ()
......
Stopped in QSort.qsort, ../QSort.hs:5:16-51
Stopped in QSort.qsort, QSort.hs:5:16-51
_result :: [Integer] = _
a :: Integer = 1
left :: [Integer] = _
right :: [Integer] = _
Stopped in QSort.qsort, ../QSort.hs:5:17-26
Stopped in QSort.qsort, QSort.hs:5:17-26
_result :: [a] = _
left :: [a] = _
()
......
:l ../Test3.hs
:l Test3.hs
:st mymap (+1) [1::Integer,2,3]
:show bindings
f x -- should fail, unknown return type
......
Stopped in Main.mymap, ../Test3.hs:2:18-31
Stopped in Main.mymap, Test3.hs:2:18-31
_result :: [a] = _
f :: Integer -> a = _
x :: Integer = 1
......
:l ../Test3
:l Test3
:b 1
mymap id []
-- second load, should discard the breakpoints without blowing up
:l ../Test3.hs
:l Test3.hs
Breakpoint 0 activated at ../Test3.hs:1:14-15
Stopped in Main.mymap, ../Test3.hs:1:14-15
Breakpoint 0 activated at Test3.hs:1:14-15
Stopped in Main.mymap, Test3.hs:1:14-15
_result :: [a] = _
:l ../Test6.hs
:l Test6.hs
:b 5
main
-- stopped now
:l ../Test6.hs
:l Test6.hs
main
-- should not break
Breakpoint 0 activated at ../Test6.hs:5:8-11
Stopped in Main.main, ../Test6.hs:5:8-11
Breakpoint 0 activated at Test6.hs:5:8-11
Stopped in Main.main, Test6.hs:5:8-11
_result :: a = _
*** Exception: Prelude.head: empty list
:l ../Test6.hs
:l Test6.hs
:b 5
main
:abandon
......
Breakpoint 0 activated at ../Test6.hs:5:8-11
Stopped in Main.main, ../Test6.hs:5:8-11
Breakpoint 0 activated at Test6.hs:5:8-11
Stopped in Main.main, Test6.hs:5:8-11
_result :: a = _
Stopped in Main.main, ../Test6.hs:5:8-11
Stopped in Main.main, Test6.hs:5:8-11
_result :: a = _
......@@ -3,7 +3,7 @@ error "foo"
:set -fbreak-on-exception
error "foo"
:abandon
:l ../Test7.hs
:l Test7.hs
:tr main
:hist
:back
......
......@@ -5,15 +5,15 @@ Stopped in <exception thrown>, <unknown>
_exception :: e = _
Stopped in <exception thrown>, <unknown>
_exception :: e = _
-1 : main (../Test7.hs:2:18-28)
-2 : main (../Test7.hs:2:8-29)
-1 : main (Test7.hs:2:18-28)
-2 : main (Test7.hs:2:8-29)
<end of history>
Logged breakpoint at ../Test7.hs:2:18-28
Logged breakpoint at Test7.hs:2:18-28
_result :: a
Logged breakpoint at ../Test7.hs:2:8-29
Logged breakpoint at Test7.hs:2:8-29
_result :: IO a
no more logged breakpoints
Logged breakpoint at ../Test7.hs:2:18-28
Logged breakpoint at Test7.hs:2:18-28
_result :: a
Stopped at <unknown>
_exception :: e
......@@ -22,28 +22,28 @@ _exception = SomeException
(ErrorCallWithLocation
"foo"
"CallStack (from HasCallStack):
error, called at ../Test7.hs:2:18 in main:Main")
error, called at Test7.hs:2:18 in main:Main")
_result :: a = _
_exception :: SomeException = SomeException
(ErrorCallWithLocation
"foo"
"CallStack (from HasCallStack):
error, called at ../Test7.hs:2:18 in main:Main")
error, called at Test7.hs:2:18 in main:Main")
*** Exception: foo
CallStack (from HasCallStack):
error, called at ../Test7.hs:2:18 in main:Main
error, called at Test7.hs:2:18 in main:Main
Stopped in <exception thrown>, <unknown>
_exception :: e = SomeException
(ErrorCallWithLocation
"foo"
"CallStack (from HasCallStack):
error, called at ../Test7.hs:2:18 in main:Main")
error, called at Test7.hs:2:18 in main:Main")
Stopped in <exception thrown>, <unknown>
_exception :: e = SomeException
(ErrorCallWithLocation
"foo"
"CallStack (from HasCallStack):
error, called at ../Test7.hs:2:18 in main:Main")
error, called at Test7.hs:2:18 in main:Main")
*** Exception: foo
CallStack (from HasCallStack):
error, called at ../Test7.hs:2:18 in main:Main
error, called at Test7.hs:2:18 in main:Main
:l ../QSort.hs
:l QSort.hs
:set -fbreak-on-exception
:trace qsort ("abc" ++ undefined)
:back
......
"Stopped in <exception thrown>, <unknown>
_exception :: e = _
Logged breakpoint at ../QSort.hs:6:24-38
Logged breakpoint at QSort.hs:6:24-38
_result :: [Char]
a :: Char
as :: [Char]
......
......@@ -2,7 +2,7 @@
-- Maybe we should not want to put in scope the things binded in the mdo scope, to avoid silliness.
:set -XRecursiveDo
:l ../mdo.hs
:l mdo.hs
:st l2dll "hello world"
:st
:st
Stopped in Main.l2dll, ../mdo.hs:(30,16)-(32,27)
Stopped in Main.l2dll, mdo.hs:(30,16)-(32,27)
_result :: IO (N Char) = _
x :: Char = 'h'
xs :: [Char] = _
Stopped in Main.l2dll, ../mdo.hs:30:30-42
Stopped in Main.l2dll, mdo.hs:30:30-42
_result :: IO (N Char) = _
f :: N Char = _
l :: N Char = _
x :: Char = 'h'
Stopped in Main.newNode, ../mdo.hs:(8,17)-(9,42)
Stopped in Main.newNode, mdo.hs:(8,17)-(9,42)
_result :: IO (N Char) = _
b :: N Char = _
c :: Char = 'h'
......
-- Test for #1505
:load ../Test2.hs
:load Test2.hs
:break Test2
:l ../QSort
:l QSort
:break qsort
qsort [3::Integer,2,1]
:i a
Breakpoint 0 activated at ../QSort.hs:4:12-13
Breakpoint 1 activated at ../QSort.hs:5:16-51
Stopped in QSort.qsort, ../QSort.hs:5:16-51
Breakpoint 0 activated at QSort.hs:4:12-13
Breakpoint 1 activated at QSort.hs:5:16-51
Stopped in QSort.qsort, QSort.hs:5:16-51
_result :: [Integer] = _
a :: Integer = 3
left :: [Integer] = _
......
:set -fprint-explicit-foralls
:l ../QSort
:l QSort
:delete 1
-- Illegal: empty breakpoint list
......
-- :abandon stops a debugging session
:l ../QSort
:l QSort
:break QSort 5
run
:abandon
......
Breakpoint 0 activated at ../QSort.hs:5:16-51
Stopped in QSort.qsort, ../QSort.hs:5:16-51
Breakpoint 0 activated at QSort.hs:5:16-51
Stopped in QSort.qsort, QSort.hs:5:16-51
_result :: [Integer] = _
a :: Integer = 8
left :: [Integer] = _
......
-- Instrumentation of mdo notation
:set -XRecursiveDo
:l ../mdo.hs
:l mdo.hs
:break Main 13
:break Main 12
:break Main 11
......
Breakpoint 0 activated at ../mdo.hs:13:16-30
Breakpoint 1 activated at ../mdo.hs:12:16-30
Breakpoint 2 activated at ../mdo.hs:11:16-30
Breakpoint 3 activated at ../mdo.hs:14:16-30
Breakpoint 0 activated at mdo.hs:13:16-30
Breakpoint 1 activated at mdo.hs:12:16-30
Breakpoint 2 activated at mdo.hs:11:16-30
Breakpoint 3 activated at mdo.hs:14:16-30
:l ../getargs.hs
:l getargs.hs
:set args 42
:step main
:step
Stopped in Main.main, ../getargs.hs:3:8-24
Stopped in Main.main, getargs.hs:3:8-24
_result :: IO () = _
["42"]
:l ../Test3.hs
:l Test3.hs
-- set a break on the [] case in map
:b 1
-- trace an execution
......
Breakpoint 0 activated at ../Test3.hs:1:14-15
[2,3Stopped in Main.mymap, ../Test3.hs:1:14-15
Breakpoint 0 activated at Test3.hs:1:14-15
[2,3Stopped in Main.mymap, Test3.hs:1:14-15
_result :: [a] = _
-1 : mymap (../Test3.hs:2:22-31)
-2 : mymap (../Test3.hs:2:18-20)
-3 : mymap (../Test3.hs:2:18-31)
-4 : mymap (../Test3.hs:2:22-31)
-5 : mymap (../Test3.hs:2:18-20)
-6 : mymap (../Test3.hs:2:18-31)
-1 : mymap (Test3.hs:2:22-31)
-2 : mymap (Test3.hs:2:18-20)
-3 : mymap (Test3.hs:2:18-31)
-4 : mymap (Test3.hs:2:22-31)
-5 : mymap (Test3.hs:2:18-20)
-6 : mymap (Test3.hs:2:18-31)
<end of history>
Logged breakpoint at ../Test3.hs:2:22-31
Logged breakpoint at Test3.hs:2:22-31
_result :: [a]
f :: t -> a
xs :: [t]
xs :: [t] = []
f :: t -> a = _
_result :: [a] = _
Logged breakpoint at ../Test3.hs:2:18-20
Logged breakpoint at Test3.hs:2:18-20
_result :: a
f :: Integer -> a
x :: Integer
......@@ -24,10 +24,10 @@ x :: Integer = 2
f :: Integer -> a = _
_result :: a = _
_result = 3
Logged breakpoint at ../Test3.hs:2:18-31
Logged breakpoint at Test3.hs:2:18-31
_result :: [a]
f :: Integer -> a
x :: Integer
xs :: [Integer]
Logged breakpoint at ../Test3.hs:2:18-20
Logged breakpoint at Test3.hs:2:18-20
_result :: a
......@@ -4,7 +4,7 @@
-- can't list a compiled module
:list Data.List.map
-- can't list a compiled module
:l ../Test3.hs
:l Test3.hs
:list mymap
:list main
:list 4
......
......@@ -11,7 +11,7 @@ let i = Just (10::Integer)
case i of Just j -> Control.Exception.evaluate j
:p i
:l ../Test.hs
:l Test.hs
let s = S1 'a' 'b' 'c'
s
......
-- Simple Recovery of types - opaque types
:set -XExistentialQuantification -XDeriveDataTypeable -XGeneralizedNewtypeDeriving
:l ../Test
:l Test
let t = O (map Just [[1,1],[2,2]])
:p t
-- should have bound _t1 now
......
-- Recovery of types, polymorphic bindings inside a bkpt
:l ../QSort
:l QSort