Merge branch 'master' of http://darcs.haskell.org/testsuite
authorIan Lynagh <igloo@earth.li>
Tue, 18 Oct 2011 16:19:39 +0000 (17:19 +0100)
committerIan Lynagh <igloo@earth.li>
Tue, 18 Oct 2011 16:19:39 +0000 (17:19 +0100)
testsuite/driver/testglobals.py
testsuite/driver/testlib.py
testsuite/tests/concurrent/should_run/5558.hs [new file with mode: 0644]
testsuite/tests/concurrent/should_run/all.T
testsuite/tests/ghci/T5545.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/T5545.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T
testsuite/tests/th/Makefile
testsuite/tests/th/all.T

index bdd44a3..671d6e0 100644 (file)
@@ -216,8 +216,8 @@ class TestOptions:
        # Command to run for extra cleaning
        self.clean_cmd = None
 
-       # Prefix to put on the command before running it
-       self.cmd_prefix = ''
+       # Command wrapper: a function to apply to the command before running it
+       self.cmd_wrapper = None
 
        # Prefix to put on the command before compiling it
        self.compile_cmd_prefix = ''
index db929a1..319ed9d 100644 (file)
@@ -420,7 +420,15 @@ def cmd_prefix( prefix ):
     return lambda opts, p=prefix: _cmd_prefix(opts, prefix)
 
 def _cmd_prefix( opts, prefix ):
-    opts.cmd_prefix = prefix
+    opts.cmd_wrapper = lambda cmd, p=prefix: p + ' ' + cmd;
+
+# ----
+
+def cmd_wrapper( fun ):
+    return lambda opts, f=fun: _cmd_wrapper(opts, fun)
+
+def _cmd_wrapper( opts, fun ):
+    opts.cmd_wrapper = fun
 
 # ----
 
@@ -804,9 +812,6 @@ def ghci_script( name, way, script ):
           ' --interactive -v0 -ignore-dot-ghci ' + \
           join(flags,' ')
 
-    if getTestOpts().cmd_prefix != '':
-        cmd = getTestOpts().cmd_prefix + ' ' + cmd;
-
     getTestOpts().stdin = script
     return simple_run( name, way, cmd, getTestOpts().extra_run_opts )
 
@@ -893,8 +898,6 @@ def compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts ):
             return result
 
         cmd = './' + name;
-        if getTestOpts().cmd_prefix != '':
-            cmd = getTestOpts().cmd_prefix + ' ' + cmd;
 
         # we don't check the compiler's stderr for a compile-and-run test
         return simple_run( name, way, cmd, getTestOpts().extra_run_opts )
@@ -1067,13 +1070,17 @@ def simple_run( name, way, prog, args ):
         stdin_comes_from = ''
     else:
         stdin_comes_from = ' <' + use_stdin
-    cmd = 'cd ' + getTestOpts().testdir + ' && ' \
-       + prog + ' ' + args + ' '  \
+    cmd = prog + ' ' + args + ' '  \
         + my_rts_flags + ' '       \
         + stdin_comes_from         \
         + ' >' + run_stdout        \
         + ' 2>' + run_stderr
 
+    if getTestOpts().cmd_wrapper != None:
+        cmd = getTestOpts().cmd_wrapper(cmd);
+
+    cmd = 'cd ' + getTestOpts().testdir + ' && ' + cmd
+
     # run the command
     result = runCmdFor(name, cmd)
 
@@ -1124,11 +1131,6 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ):
     rm_no_fail(errname)
     rm_no_fail(name)
 
-    if getTestOpts().cmd_prefix == '':
-        cmd_prefix = ''
-    else:
-        cmd_prefix = getTestOpts().cmd_prefix + ' '
-
     if (top_mod == ''):
         srcname = add_hs_lhs_suffix(name)
     else:
@@ -1169,8 +1171,7 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ):
 
     script.close()
 
-    cmd = 'cd ' + getTestOpts().testdir + " && " + cmd_prefix + "'" \
-          + config.compiler + "' " \
+    cmd = "'" + config.compiler + "' " \
           + join(config.compiler_always_flags,' ') + ' ' \
           + srcname + ' ' \
           + join(config.way_flags[way],' ') + ' ' \
@@ -1178,6 +1179,11 @@ def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ):
           + getTestOpts().extra_hc_opts + ' ' \
           + '<' + scriptname +  ' 1>' + outname + ' 2>' + errname
 
+    if getTestOpts().cmd_wrapper != None:
+        cmd = getTestOpts().cmd_wrapper(cmd);
+
+    cmd = 'cd ' + getTestOpts().testdir + " && " + cmd
+
     result = runCmdFor(name, cmd)
 
     exit_code = result >> 8
diff --git a/testsuite/tests/concurrent/should_run/5558.hs b/testsuite/tests/concurrent/should_run/5558.hs
new file mode 100644 (file)
index 0000000..4197da6
--- /dev/null
@@ -0,0 +1,25 @@
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import System.IO.Unsafe
+
+main :: IO ()
+main = do
+     -- evaluate lock -- adding this line fixes the problem
+
+     fin1 <- newEmptyMVar
+     fin2 <- newEmptyMVar
+
+     forkIO $ ping >>= putMVar fin1
+     forkIO $ ping >>= putMVar fin2
+
+     takeMVar fin1
+     takeMVar fin2
+
+{-# NOINLINE lock #-}
+lock :: MVar ()
+lock = unsafePerformIO $ newMVar ()
+
+ping = do
+     () <- takeMVar lock
+     putMVar lock ()
index 0be9db4..15bcd49 100644 (file)
@@ -59,6 +59,12 @@ test('4811', normal, compile_and_run, [''])
 
 test('allowinterrupt001', normal, compile_and_run, [''])
 
+# try hard to provoke the error by running the test 100 times
+test('5558',
+     [ only_ways(['threaded2']),
+       cmd_wrapper(lambda c: 'for i in `seq 1 100`; do ' + c + '; done') ],
+     compile_and_run, [''])
+
 # -----------------------------------------------------------------------------
 # These tests we only do for a full run
 
@@ -199,4 +205,3 @@ test('conc067', ignore_output, compile_and_run, [''])
 # omit threaded2, the behaviour of this test is non-deterministic with more
 # than one CPU.
 test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, [''])
-
diff --git a/testsuite/tests/ghci/T5545.stdout b/testsuite/tests/ghci/T5545.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/ghci/scripts/T5545.script b/testsuite/tests/ghci/scripts/T5545.script
new file mode 100644 (file)
index 0000000..e82202d
--- /dev/null
@@ -0,0 +1,2 @@
+:module Prelude
+:i $!
index 0d7d184..72462d5 100644 (file)
@@ -103,3 +103,4 @@ test('T4832', normal, ghci_script, ['T4832.script'])
 test('T5045', normal, ghci_script, ['T5045.script'])
 test('T5130', normal, ghci_script, ['T5130.script'])
 test('T5417', normal, ghci_script, ['T5417.script'])
+test('T5545', normal, ghci_script, ['T5545.script'])
index dc60d5b..1e35cec 100644 (file)
@@ -12,8 +12,8 @@ T2386:
 HC_OPTS = -XTemplateHaskell -package template-haskell
 
 TH_spliceE5_prof::
-       $(RM) TH_spliceE5_prof*.o TH_spliceE5_prof*.hi TH_spliceE5_prof*.p_
+       $(RM) TH_spliceE5_prof*.o TH_spliceE5_prof*.hi TH_spliceE5_prof*.p.
        '$(TEST_HC)' $(TEST_HC_OPTS) $(HC_OPTS) --make -v0 TH_spliceE5_prof.hs -c
-       '$(TEST_HC)' $(TEST_HC_OPTS) $(HC_OPTS) --make -v0 TH_spliceE5_prof.hs -prof -auto-all -osuf p_o -o $@
+       '$(TEST_HC)' $(TEST_HC_OPTS) $(HC_OPTS) --make -v0 TH_spliceE5_prof.hs -prof -auto-all -osuf p.o -o $@
        ./$@
 
index 1adf313..a16f7c5 100644 (file)
@@ -43,14 +43,14 @@ test('TH_NestedSplices',
 
 # Testing profiling with TH is a bit tricky; we've already disabled
 # the prof way above, and also we want to add options specifically for
-# profiling (-osuf p_o) because this is necessary when mixing
+# profiling (-osuf p.o) because this is necessary when mixing
 # profiling w/ TH.  Furthermore we must have built the program the
 # normal way first, which is why the work is done by a Makefile rule.
 test('TH_spliceE5_prof',
      [req_profiling,
       omit_ways(['ghci']),
-      extra_clean(['TH_spliceE5_prof_Lib.p_o', 'TH_spliceE5_prof_Lib.hi',
-                   'TH_spliceE5_prof_Lib.o','TH_spliceE5_prof.p_o'])],
+      extra_clean(['TH_spliceE5_prof_Lib.p.o', 'TH_spliceE5_prof_Lib.hi',
+                   'TH_spliceE5_prof_Lib.o','TH_spliceE5_prof.p.o'])],
      run_command,
      ['$MAKE -s --no-print-directory TH_spliceE5_prof'])