diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..cfa18ce --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.o +*.hi +*~ +dist/ diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..8f0689a --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Sakari Jokinen + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sakari Jokinen nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Test/Framework/DocTest.hs b/src/Test/Framework/DocTest.hs new file mode 100644 index 0000000..b2c397a --- /dev/null +++ b/src/Test/Framework/DocTest.hs @@ -0,0 +1,63 @@ +{-| Wrapper for running DocTests with Test.Framework + +First we get the doctests wrapped in 'Test.Framework.Test' using +'frameDocTestsFrom'. The first argument to 'frameDocTestsFrom' should be the root module +i.e., a module that includes all the other modules. + +>>> doctests <- frameDocTestsFrom "tests/Test.hs" ["-itests"] + +After getting the doctests we can execute the doctests using the +'defaultMain' or 'defaultMainWithOpts' functions. + +>>> defaultMainWithOpts [doctests] defaultOptions +DocTest: + print "abc": [Failed] +Failed: expression `print "abc"' +expected: ["\"fail\""] + but got: ["\"abc\""] + print bar: [OK] + + Test Cases Total + Passed 1 1 + Failed 1 1 + Total 2 2 +*** Exception: ExitFailure 1 + +Above we used 'defaultMainWithOpts' for running the tests so that we +can specify that we want plain output as coloride output is not very +readable: + +>>> print $ ropt_plain_output defaultOptions +Just True + +-} + +module Test.Framework.DocTest (frameDocTestsFrom) where + +import Documentation.Haddock +import qualified DocTest +import Test.Framework +import Test.Framework.Providers.HUnit + +defaultOptions = RunnerOptions { ropt_threads = Nothing + , ropt_test_options = Nothing + , ropt_test_patterns = Nothing + , ropt_xml_output = Nothing + , ropt_plain_output = Just True + , ropt_hide_successes = Nothing + } + +-- | Note that 'frameDocTestsFrom' can be called only once per process execution + +frameDocTestsFrom::FilePath -> [String] -> IO Test +frameDocTestsFrom rootPath options = do + tests <- DocTest.getDocTests [Flag_Verbosity "0", Flag_NoWarnings] [rootPath] + return $ toTestFrameworkGroup (rootPath:options) tests + +toTestFrameworkTest :: [String] -> DocTest.DocTest -> Test +toTestFrameworkTest options test = testCase testName $ DocTest.withInterpreter options $ flip DocTest.toAssertion test + where + testName = DocTest.expression $ head $ DocTest.interactions test + +toTestFrameworkGroup :: [String] -> [DocTest.DocTest] -> Test +toTestFrameworkGroup options = mutuallyExclusive . testGroup "DocTest" . map (toTestFrameworkTest options) \ No newline at end of file diff --git a/test-framework-doctest.cabal b/test-framework-doctest.cabal new file mode 100644 index 0000000..f6a24dc --- /dev/null +++ b/test-framework-doctest.cabal @@ -0,0 +1,34 @@ +Name: test-framework-doctest +Version: 0.1 +Synopsis: Test.Framework wrapper for DocTest +Description: Test.Framework wrapper for DocTest +License: BSD3 +License-file: LICENSE +Author: Sakari Jokinen +Maintainer: sakariij@gmail.com +Category: Testing +Build-type: Simple +Cabal-version: >=1.10 + +test-suite doctest + main-is: Main.hs + default-language: Haskell98 + type: exitcode-stdio-1.0 + hs-source-dirs: src, tests + build-depends: + base >= 4, + test-framework, + test-framework-hunit, + DocTest, + haddock + +Library + Hs-source-dirs: src + default-language: Haskell98 + Exposed-modules: Test.Framework.DocTest + Build-depends: + base, + DocTest, + test-framework, + test-framework-hunit, + haddock \ No newline at end of file diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 index 0000000..4def3e9 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Test.Framework.DocTest +import Test.Framework + +main = frameDocTestsFrom "src/Test/Framework/DocTest.hs" [] >>= defaultMain . return \ No newline at end of file diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 index 0000000..4e2d27b --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,17 @@ +{-| Module for testing the doctests + +>>> print "abc" +"fail" + +-} + +module Test where + +-- | Succeeding example +-- +-- >>> print bar +-- 1 + +bar::Int +bar = 1 +