/usr/share/doc/libghc-test-framework-doc/html/src/Test-Framework-Runners-Core.html is in libghc-test-framework-doc 0.8.1.1-7.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>Test/Framework/Runners/Core.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Runners</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-conid'>RunTest</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>RunningTest</span><span class='hs-layout'>,</span> <span class='hs-conid'>SomeImproving</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>FinishedTest</span><span class='hs-layout'>,</span> <span class='hs-varid'>runTests</span><span class='hs-layout'>,</span>
<a name="line-3"></a> <span class='hs-conid'>TestRunner</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>runTestTree</span>
<a name="line-4"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Improving</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Options</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Runners</span><span class='hs-varop'>.</span><span class='hs-conid'>Options</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Runners</span><span class='hs-varop'>.</span><span class='hs-conid'>TestPattern</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Runners</span><span class='hs-varop'>.</span><span class='hs-conid'>ThreadPool</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Seed</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Framework</span><span class='hs-varop'>.</span><span class='hs-conid'>Utilities</span>
<a name="line-14"></a>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span><span class='hs-varop'>.</span><span class='hs-conid'>MVar</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Exception</span> <span class='hs-layout'>(</span><span class='hs-varid'>mask</span><span class='hs-layout'>,</span> <span class='hs-varid'>finally</span><span class='hs-layout'>,</span> <span class='hs-varid'>onException</span><span class='hs-layout'>)</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Monoid</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Typeable</span>
<a name="line-21"></a>
<a name="line-22"></a>
<a name="line-23"></a><a name="RunTest"></a><span class='hs-comment'>-- | A test that has been executed or is in the process of execution</span>
<a name="line-24"></a><a name="RunTest"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>RunTest</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RunTest</span> <span class='hs-conid'>TestName</span> <span class='hs-conid'>TestTypeName</span> <span class='hs-varid'>a</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RunTestGroup</span> <span class='hs-conid'>TestName</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>RunTest</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<a name="line-26"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="SomeImproving"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>SomeImproving</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>forall</span> <span class='hs-varid'>i</span> <span class='hs-varid'>r</span><span class='hs-varop'>.</span> <span class='hs-conid'>TestResultlike</span> <span class='hs-varid'>i</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>SomeImproving</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span> <span class='hs-conop'>:~></span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-29"></a><a name="RunningTest"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>RunningTest</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RunTest</span> <span class='hs-conid'>SomeImproving</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="FinishedTest"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>FinishedTest</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RunTest</span> <span class='hs-layout'>(</span><span class='hs-conid'>String</span><span class='hs-layout'>,</span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span>
<a name="line-32"></a>
<a name="line-33"></a><a name="runTests"></a><span class='hs-definition'>runTests</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CompleteRunnerOptions</span> <span class='hs-comment'>-- ^ Top-level runner options</span>
<a name="line-34"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Test</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Tests to run</span>
<a name="line-35"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>RunningTest</span><span class='hs-keyglyph'>]</span>
<a name="line-36"></a><span class='hs-definition'>runTests</span> <span class='hs-varid'>ropts</span> <span class='hs-varid'>tests</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-37"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>test_patterns</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unK</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ropt_test_patterns</span> <span class='hs-varid'>ropts</span>
<a name="line-38"></a> <span class='hs-varid'>test_options</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unK</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ropt_test_options</span> <span class='hs-varid'>ropts</span>
<a name="line-39"></a> <span class='hs-layout'>(</span><span class='hs-varid'>run_tests</span><span class='hs-layout'>,</span> <span class='hs-varid'>actions</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runTests'</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>runTestTree</span> <span class='hs-varid'>test_options</span> <span class='hs-varid'>test_patterns</span><span class='hs-layout'>)</span> <span class='hs-varid'>tests</span>
<a name="line-40"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>executeOnPool</span> <span class='hs-layout'>(</span><span class='hs-varid'>unK</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ropt_threads</span> <span class='hs-varid'>ropts</span><span class='hs-layout'>)</span> <span class='hs-varid'>actions</span>
<a name="line-41"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>run_tests</span>
<a name="line-42"></a>
<a name="line-43"></a><a name="TestOptions"></a><span class='hs-comment'>-- | 'TestRunner' class simplifies folding a 'Test'. You need to specify</span>
<a name="line-44"></a><a name="TestOptions"></a><span class='hs-comment'>-- the important semantic actions by instantiating this class, and</span>
<a name="line-45"></a><a name="TestOptions"></a><span class='hs-comment'>-- 'runTestTree' will take care of recursion and test filtering.</span>
<a name="line-46"></a><a name="TestOptions"></a><span class='hs-keyword'>class</span> <span class='hs-conid'>TestRunner</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>where</span>
<a name="line-47"></a> <span class='hs-comment'>-- | How to handle a single test</span>
<a name="line-48"></a> <span class='hs-varid'>runSimpleTest</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Testlike</span> <span class='hs-varid'>i</span> <span class='hs-varid'>r</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span> <span class='hs-conid'>Typeable</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>TestOptions</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TestName</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-49"></a> <span class='hs-comment'>-- | How to skip a test that doesn't satisfy the pattern</span>
<a name="line-50"></a> <span class='hs-varid'>skipTest</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>b</span>
<a name="line-51"></a> <span class='hs-comment'>-- | How to handle an IO test (created with 'buildTestBracketed')</span>
<a name="line-52"></a> <span class='hs-varid'>runIOTest</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-53"></a> <span class='hs-comment'>-- | How to run a test group</span>
<a name="line-54"></a> <span class='hs-varid'>runGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TestName</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>b</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-55"></a>
<a name="line-56"></a><a name="runTestTree"></a><span class='hs-comment'>-- | Run the test tree using a 'TestRunner'</span>
<a name="line-57"></a><span class='hs-definition'>runTestTree</span>
<a name="line-58"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TestRunner</span> <span class='hs-varid'>b</span>
<a name="line-59"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>TestOptions</span>
<a name="line-60"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TestPattern</span><span class='hs-keyglyph'>]</span>
<a name="line-61"></a> <span class='hs-comment'>-- ^ skip the tests that do not match any of these patterns, unless</span>
<a name="line-62"></a> <span class='hs-comment'>-- the list is empty</span>
<a name="line-63"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Test</span>
<a name="line-64"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-65"></a><span class='hs-definition'>runTestTree</span> <span class='hs-varid'>initialOpts</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>topTest</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>initialOpts</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>topTest</span>
<a name="line-66"></a> <span class='hs-keyword'>where</span>
<a name="line-67"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>path</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>t</span> <span class='hs-keyword'>of</span>
<a name="line-68"></a> <span class='hs-conid'>Test</span> <span class='hs-varid'>name</span> <span class='hs-varid'>testlike</span> <span class='hs-keyglyph'>-></span>
<a name="line-69"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>pats</span> <span class='hs-varop'>||</span> <span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-varop'>`testPatternMatches`</span> <span class='hs-layout'>(</span><span class='hs-varid'>path</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>name</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>pats</span>
<a name="line-70"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>runSimpleTest</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>name</span> <span class='hs-varid'>testlike</span>
<a name="line-71"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>skipTest</span>
<a name="line-72"></a> <span class='hs-conid'>TestGroup</span> <span class='hs-varid'>name</span> <span class='hs-varid'>tests</span> <span class='hs-keyglyph'>-></span>
<a name="line-73"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>path'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>path</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>name</span><span class='hs-keyglyph'>]</span>
<a name="line-74"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>runGroup</span> <span class='hs-varid'>name</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>path'</span><span class='hs-layout'>)</span> <span class='hs-varid'>tests</span>
<a name="line-75"></a> <span class='hs-conid'>PlusTestOptions</span> <span class='hs-varid'>extra_topts</span> <span class='hs-varid'>test</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>opts</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>extra_topts</span><span class='hs-layout'>)</span> <span class='hs-varid'>path</span> <span class='hs-varid'>test</span>
<a name="line-76"></a> <span class='hs-conid'>BuildTestBracketed</span> <span class='hs-varid'>build</span> <span class='hs-keyglyph'>-></span>
<a name="line-77"></a> <span class='hs-varid'>runIOTest</span> <span class='hs-varop'>$</span> <span class='hs-varid'>onLeft</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>path</span><span class='hs-layout'>)</span> <span class='hs-varop'>`fmap`</span> <span class='hs-varid'>build</span>
<a name="line-78"></a>
<a name="line-79"></a><a name="StdRunner"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>StdRunner</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StdRunner</span> <span class='hs-layout'>{</span> <span class='hs-varid'>run</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>RunningTest</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>IO</span> <span class='hs-conid'>()</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-80"></a>
<a name="line-81"></a><a name="instance%20TestRunner%20StdRunner"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>TestRunner</span> <span class='hs-conid'>StdRunner</span> <span class='hs-keyword'>where</span>
<a name="line-82"></a> <span class='hs-varid'>runSimpleTest</span> <span class='hs-varid'>topts</span> <span class='hs-varid'>name</span> <span class='hs-varid'>testlike</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StdRunner</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-83"></a> <span class='hs-layout'>(</span><span class='hs-varid'>result</span><span class='hs-layout'>,</span> <span class='hs-varid'>action</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runTest</span> <span class='hs-layout'>(</span><span class='hs-varid'>completeTestOptions</span> <span class='hs-varid'>topts</span><span class='hs-layout'>)</span> <span class='hs-varid'>testlike</span>
<a name="line-84"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>RunTest</span> <span class='hs-varid'>name</span> <span class='hs-layout'>(</span><span class='hs-varid'>testTypeName</span> <span class='hs-varid'>testlike</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>SomeImproving</span> <span class='hs-varid'>result</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>action</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-85"></a>
<a name="line-86"></a> <span class='hs-varid'>skipTest</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StdRunner</span> <span class='hs-varop'>$</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-87"></a>
<a name="line-88"></a> <span class='hs-varid'>runGroup</span> <span class='hs-varid'>name</span> <span class='hs-varid'>tests</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StdRunner</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-89"></a> <span class='hs-layout'>(</span><span class='hs-varid'>results</span><span class='hs-layout'>,</span> <span class='hs-varid'>actions</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runTests'</span> <span class='hs-varid'>tests</span>
<a name="line-90"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>results</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>RunTestGroup</span> <span class='hs-varid'>name</span> <span class='hs-varid'>results</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>actions</span><span class='hs-layout'>)</span>
<a name="line-91"></a>
<a name="line-92"></a> <span class='hs-varid'>runIOTest</span> <span class='hs-varid'>ioTest</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StdRunner</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mask</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>restore</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ioTest</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-conid'>StdRunner</span> <span class='hs-varid'>test</span><span class='hs-layout'>,</span> <span class='hs-varid'>cleanup</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-93"></a> <span class='hs-varid'>mb_res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>restore</span> <span class='hs-varid'>test</span> <span class='hs-varop'>`onException`</span> <span class='hs-varid'>cleanup</span>
<a name="line-94"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_res</span> <span class='hs-keyword'>of</span>
<a name="line-95"></a> <span class='hs-comment'>-- No sub-tests: perform the cleanup NOW</span>
<a name="line-96"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>cleanup</span> <span class='hs-varop'>>></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-97"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>run_test</span><span class='hs-layout'>,</span> <span class='hs-varid'>actions</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-98"></a> <span class='hs-comment'>-- Sub-tests: perform the cleanup as soon as each of them have completed</span>
<a name="line-99"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mvars</span><span class='hs-layout'>,</span> <span class='hs-varid'>actions'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>liftM</span> <span class='hs-varid'>unzip</span> <span class='hs-varop'>$</span> <span class='hs-varid'>forM</span> <span class='hs-varid'>actions</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>action</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-100"></a> <span class='hs-varid'>mvar</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newEmptyMVar</span>
<a name="line-101"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mvar</span><span class='hs-layout'>,</span> <span class='hs-varid'>action</span> <span class='hs-varop'>`finally`</span> <span class='hs-varid'>putMVar</span> <span class='hs-varid'>mvar</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-102"></a> <span class='hs-comment'>-- NB: the takeMVar action MUST be last in the list because the returned actions are</span>
<a name="line-103"></a> <span class='hs-comment'>-- scheduled left-to-right, and we want all the actions we depend on to be scheduled</span>
<a name="line-104"></a> <span class='hs-comment'>-- before we wait for them to complete, or we might deadlock.</span>
<a name="line-105"></a> <span class='hs-comment'>--</span>
<a name="line-106"></a> <span class='hs-comment'>-- FIXME: this is a bit of a hack because it uses one pool thread just waiting</span>
<a name="line-107"></a> <span class='hs-comment'>-- for some other pool threads to complete! Switch to parallel-io?</span>
<a name="line-108"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>run_test</span><span class='hs-layout'>,</span> <span class='hs-varid'>actions'</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>cleanup</span> <span class='hs-varop'>>></span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>takeMVar</span> <span class='hs-varid'>mvars</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-109"></a>
<a name="line-110"></a><a name="runTests'"></a><span class='hs-definition'>runTests'</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>StdRunner</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>RunningTest</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>IO</span> <span class='hs-conid'>()</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-111"></a><span class='hs-definition'>runTests'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>onRight</span> <span class='hs-varid'>concat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unzip</span> <span class='hs-varop'>.</span> <span class='hs-varid'>catMaybes</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>run</span>
<a name="line-112"></a>
<a name="line-113"></a><a name="completeTestOptions"></a><span class='hs-definition'>completeTestOptions</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TestOptions</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CompleteTestOptions</span>
<a name="line-114"></a><span class='hs-definition'>completeTestOptions</span> <span class='hs-varid'>to</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TestOptions</span> <span class='hs-layout'>{</span>
<a name="line-115"></a> <span class='hs-varid'>topt_seed</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>K</span> <span class='hs-varop'>$</span> <span class='hs-varid'>topt_seed</span> <span class='hs-varid'>to</span> <span class='hs-varop'>`orElse`</span> <span class='hs-conid'>RandomSeed</span><span class='hs-layout'>,</span>
<a name="line-116"></a> <span class='hs-varid'>topt_maximum_generated_tests</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>K</span> <span class='hs-varop'>$</span> <span class='hs-varid'>topt_maximum_generated_tests</span> <span class='hs-varid'>to</span> <span class='hs-varop'>`orElse`</span> <span class='hs-num'>100</span><span class='hs-layout'>,</span>
<a name="line-117"></a> <span class='hs-varid'>topt_maximum_unsuitable_generated_tests</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>K</span> <span class='hs-varop'>$</span> <span class='hs-varid'>topt_maximum_unsuitable_generated_tests</span> <span class='hs-varid'>to</span> <span class='hs-varop'>`orElse`</span> <span class='hs-num'>1000</span><span class='hs-layout'>,</span>
<a name="line-118"></a> <span class='hs-varid'>topt_maximum_test_size</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>K</span> <span class='hs-varop'>$</span> <span class='hs-varid'>topt_maximum_test_size</span> <span class='hs-varid'>to</span> <span class='hs-varop'>`orElse`</span> <span class='hs-num'>100</span><span class='hs-layout'>,</span>
<a name="line-119"></a> <span class='hs-varid'>topt_maximum_test_depth</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>K</span> <span class='hs-varop'>$</span> <span class='hs-varid'>topt_maximum_test_depth</span> <span class='hs-varid'>to</span> <span class='hs-varop'>`orElse`</span> <span class='hs-num'>5</span><span class='hs-layout'>,</span>
<a name="line-120"></a> <span class='hs-varid'>topt_timeout</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>K</span> <span class='hs-varop'>$</span> <span class='hs-varid'>topt_timeout</span> <span class='hs-varid'>to</span> <span class='hs-varop'>`orElse`</span> <span class='hs-conid'>Nothing</span>
<a name="line-121"></a> <span class='hs-layout'>}</span>
</pre></body>
</html>
|