Skip to content

Commit

Permalink
prototype works
Browse files Browse the repository at this point in the history
  • Loading branch information
sakari committed Jun 15, 2011
0 parents commit 4ec93af
Show file tree
Hide file tree
Showing 7 changed files with 156 additions and 0 deletions.
4 changes: 4 additions & 0 deletions .gitignore
@@ -0,0 +1,4 @@
*.o
*.hi
*~
dist/
30 changes: 30 additions & 0 deletions 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.
2 changes: 2 additions & 0 deletions Setup.hs
@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain
63 changes: 63 additions & 0 deletions 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]
<BLANKLINE>
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)
34 changes: 34 additions & 0 deletions 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
6 changes: 6 additions & 0 deletions 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
17 changes: 17 additions & 0 deletions 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

0 comments on commit 4ec93af

Please sign in to comment.