<!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://www.cs.york.ac.uk/fp/darcs/hscolour/ --> <title>src/Darcs/Test.lhs</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /> </head> <body> % Copyright (C) 2002-2005 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \begin{code} <pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>Test</span> <span class='hs-layout'>(</span> <span class='hs-varid'>get_test</span><span class='hs-layout'>,</span> <a name="line-2"></a> <span class='hs-varid'>run_posthook</span><span class='hs-layout'>,</span> <span class='hs-varid'>run_prehook</span> <span class='hs-layout'>)</span> <a name="line-3"></a><span class='hs-keyword'>where</span> <a name="line-4"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>RepoPath</span> <span class='hs-layout'>(</span> <span class='hs-conid'>AbsolutePath</span> <span class='hs-layout'>)</span> <a name="line-5"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-layout'>(</span> <span class='hs-varid'>withCurrentDirectory</span> <span class='hs-layout'>)</span> <a name="line-6"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Exit</span> <span class='hs-layout'>(</span> <span class='hs-conid'>ExitCode</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span> <a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Cmd</span> <span class='hs-layout'>(</span> <span class='hs-varid'>system</span> <span class='hs-layout'>)</span> <a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <span class='hs-layout'>(</span> <span class='hs-varid'>when</span> <span class='hs-layout'>)</span> <a name="line-9"></a> <a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>Arguments</span> <span class='hs-layout'>(</span> <span class='hs-conid'>DarcsFlag</span><span class='hs-layout'>(</span> <span class='hs-conid'>Quiet</span><span class='hs-layout'>,</span> <a name="line-11"></a> <span class='hs-conid'>AskPosthook</span><span class='hs-layout'>,</span> <span class='hs-conid'>AskPrehook</span> <span class='hs-layout'>)</span><span class='hs-layout'>,</span> <a name="line-12"></a> <span class='hs-varid'>getPosthookCmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>getPrehookCmd</span> <span class='hs-layout'>)</span> <a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>Repository</span><span class='hs-varop'>.</span><span class='hs-conid'>Prefs</span> <span class='hs-layout'>(</span> <span class='hs-varid'>getPrefval</span> <span class='hs-layout'>)</span> <a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-layout'>(</span> <span class='hs-varid'>askUser</span> <span class='hs-layout'>)</span> <a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span> <span class='hs-layout'>(</span> <span class='hs-varid'>hPutStrLn</span><span class='hs-layout'>,</span> <span class='hs-varid'>stderr</span> <span class='hs-layout'>)</span> </pre>\end{code} If you like, you can configure your repository to be able to run a test suite of some sort. You can do this by using ``setpref'' to set the ``test'' value to be a command to run, e.g. \begin{verbatim} % darcs setpref test "sh configure && make && make test" \end{verbatim} Or, if you want to define a test specific to one copy of the repository, you could do this by editing the file \verb!_darcs/prefs/prefs!. \begin{options} --leave-test-directory, --remove-test-directory \end{options} Normally darcs deletes the directory in which the test was run afterwards. Sometimes (especially when the test fails) you'd prefer to be able to be able to examine the test directory after the test is run. You can do this by specifying the \verb!--leave-test-directory! flag. Alas, there is no way to make darcs leave the test directory only if the test fails. The opposite of \verb!--leave-test-directory! is \verb!--remove-test-directory!, which could come in handy if you choose to make \verb!--leave-test-directory! the default (see section~\ref{defaults}). \begin{code} <pre><a name="line-1"></a><a name="get_test"></a><span class='hs-definition'>get_test</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DarcsFlag</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-conid'>IO</span> <span class='hs-conid'>ExitCode</span><span class='hs-layout'>)</span> <a name="line-2"></a><span class='hs-definition'>get_test</span> <span class='hs-varid'>opts</span> <span class='hs-keyglyph'>=</span> <a name="line-3"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>putInfo</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Quiet</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>opts</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>putStr</span> <span class='hs-varid'>s</span> <a name="line-4"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>do</span> <a name="line-5"></a> <span class='hs-varid'>testline</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getPrefval</span> <span class='hs-str'>"test"</span> <a name="line-6"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <a name="line-7"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>testline</span> <span class='hs-keyword'>of</span> <a name="line-8"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>ExitSuccess</span> <a name="line-9"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>testcode</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <a name="line-10"></a> <span class='hs-varid'>putInfo</span> <span class='hs-str'>"Running test...\n"</span> <a name="line-11"></a> <span class='hs-varid'>ec</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>system</span> <span class='hs-varid'>testcode</span> <a name="line-12"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>ec</span> <span class='hs-varop'>==</span> <span class='hs-conid'>ExitSuccess</span> <a name="line-13"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>putInfo</span> <span class='hs-str'>"Test ran successfully.\n"</span> <a name="line-14"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>putInfo</span> <span class='hs-str'>"Test failed!\n"</span> <a name="line-15"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>ec</span> <a name="line-16"></a> <a name="line-17"></a><a name="run_posthook"></a><span class='hs-definition'>run_posthook</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DarcsFlag</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsolutePath</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ExitCode</span> <a name="line-18"></a><span class='hs-definition'>run_posthook</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>repodir</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>ph</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get_posthook</span> <span class='hs-varid'>opts</span> <a name="line-19"></a> <span class='hs-varid'>withCurrentDirectory</span> <span class='hs-varid'>repodir</span> <span class='hs-varop'>$</span> <span class='hs-varid'>run_hook</span> <span class='hs-varid'>opts</span> <span class='hs-str'>"Posthook"</span> <span class='hs-varid'>ph</span> <a name="line-20"></a> <a name="line-21"></a><a name="get_posthook"></a><span class='hs-definition'>get_posthook</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DarcsFlag</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-conid'>Maybe</span> <span class='hs-conid'>String</span><span class='hs-layout'>)</span> <a name="line-22"></a><span class='hs-definition'>get_posthook</span> <span class='hs-varid'>opts</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>getPosthookCmd</span> <span class='hs-varid'>opts</span> <span class='hs-keyword'>of</span> <a name="line-23"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span> <a name="line-24"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>command</span> <span class='hs-keyglyph'>-></span> <a name="line-25"></a> <span class='hs-keyword'>if</span> <span class='hs-conid'>AskPosthook</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>opts</span> <a name="line-26"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>putStr</span> <span class='hs-layout'>(</span><span class='hs-str'>"\nThe following command is set to execute.\n"</span><span class='hs-varop'>++</span> <a name="line-27"></a> <span class='hs-str'>"Execute the following command now (yes or no)?\n"</span><span class='hs-varop'>++</span> <a name="line-28"></a> <span class='hs-varid'>command</span><span class='hs-varop'>++</span><span class='hs-str'>"\n"</span><span class='hs-layout'>)</span> <a name="line-29"></a> <span class='hs-varid'>yorn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>askUser</span> <span class='hs-str'>""</span> <a name="line-30"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>yorn</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>(</span><span class='hs-chr'>'y'</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>command</span> <a name="line-31"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>putStrLn</span> <span class='hs-str'>"Posthook cancelled..."</span> <a name="line-32"></a> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span> <a name="line-33"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>command</span> <a name="line-34"></a> <a name="line-35"></a><a name="run_prehook"></a><span class='hs-definition'>run_prehook</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DarcsFlag</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsolutePath</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ExitCode</span> <a name="line-36"></a><span class='hs-definition'>run_prehook</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>repodir</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>ph</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get_prehook</span> <span class='hs-varid'>opts</span> <a name="line-37"></a> <span class='hs-varid'>withCurrentDirectory</span> <span class='hs-varid'>repodir</span> <span class='hs-varop'>$</span> <span class='hs-varid'>run_hook</span> <span class='hs-varid'>opts</span> <span class='hs-str'>"Prehook"</span> <span class='hs-varid'>ph</span> <a name="line-38"></a> <a name="line-39"></a><a name="get_prehook"></a><span class='hs-definition'>get_prehook</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DarcsFlag</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-conid'>Maybe</span> <span class='hs-conid'>String</span><span class='hs-layout'>)</span> <a name="line-40"></a><span class='hs-definition'>get_prehook</span> <span class='hs-varid'>opts</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>getPrehookCmd</span> <span class='hs-varid'>opts</span> <span class='hs-keyword'>of</span> <a name="line-41"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span> <a name="line-42"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>command</span> <span class='hs-keyglyph'>-></span> <a name="line-43"></a> <span class='hs-keyword'>if</span> <span class='hs-conid'>AskPrehook</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>opts</span> <a name="line-44"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>putStr</span> <span class='hs-layout'>(</span><span class='hs-str'>"\nThe following command is set to execute.\n"</span><span class='hs-varop'>++</span> <a name="line-45"></a> <span class='hs-str'>"Execute the following command now (yes or no)?\n"</span><span class='hs-varop'>++</span> <a name="line-46"></a> <span class='hs-varid'>command</span><span class='hs-varop'>++</span><span class='hs-str'>"\n"</span><span class='hs-layout'>)</span> <a name="line-47"></a> <span class='hs-varid'>yorn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>askUser</span> <span class='hs-str'>""</span> <a name="line-48"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>yorn</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>(</span><span class='hs-chr'>'y'</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>command</span> <a name="line-49"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>putStrLn</span> <span class='hs-str'>"Prehook cancelled..."</span> <a name="line-50"></a> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span> <a name="line-51"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>command</span> <a name="line-52"></a> <a name="line-53"></a><a name="run_hook"></a><span class='hs-definition'>run_hook</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DarcsFlag</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ExitCode</span> <a name="line-54"></a><span class='hs-definition'>run_hook</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>ExitSuccess</span> <a name="line-55"></a><span class='hs-definition'>run_hook</span> <span class='hs-varid'>opts</span> <span class='hs-varid'>cname</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>command</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <a name="line-56"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>ec</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>system</span> <span class='hs-varid'>command</span> <a name="line-57"></a> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-conid'>Quiet</span> <span class='hs-varop'>`notElem`</span> <span class='hs-varid'>opts</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <a name="line-58"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>ec</span> <span class='hs-varop'>==</span> <span class='hs-conid'>ExitSuccess</span> <a name="line-59"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>putStrLn</span> <span class='hs-varop'>$</span> <span class='hs-varid'>cname</span><span class='hs-varop'>++</span><span class='hs-str'>" ran successfully."</span> <a name="line-60"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>hPutStrLn</span> <span class='hs-varid'>stderr</span> <span class='hs-varop'>$</span> <span class='hs-varid'>cname</span><span class='hs-varop'>++</span><span class='hs-str'>" failed!"</span> <a name="line-61"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>ec</span> </pre>\end{code} </body> </html>