DocTest 0.1.1 → 0.2.0

raw patch · 24 files changed

+7/−535 lines, 24 files

Files

DocTest.cabal +1/−28
src/Main.hs +6/−1
tests/Main.hs +0/−73
tests/TestInterpreter.hs +0/−92
tests/Util.hs +0/−73
tests/bugfixImportHierarchical/ModuleA.hs +0/−6
tests/bugfixImportHierarchical/ModuleB.hs +0/−12
tests/bugfixMultipleModules/ModuleA.hs +0/−6
tests/bugfixMultipleModules/ModuleB.hs +0/−20
tests/bugfixMultipleStatements/Fib.hs +0/−13
tests/bugfixOutputToStdErr/Fib.hs +0/−11
tests/bugfixWorkingDirectory/Fib.hs +0/−10
tests/bugfixWorkingDirectory/description +0/−10
tests/bugfixWorkingDirectory/examples/Fib.hs +0/−16
tests/run.sh +0/−10
tests/run_interpreter_tests.sh +0/−4
tests/runtests.bat +0/−1
tests/runtests.sh +0/−16
tests/selftest.sh +0/−12
tests/testCommentLocation/Foo.hs +0/−75
tests/testFailOnMultiline/Fib.hs +0/−13
tests/testImport/ModuleA.hs +0/−6
tests/testImport/ModuleB.hs +0/−12
tests/testPutStr/Fib.hs +0/−15

DocTest.cabal view

@@ -1,5 +1,5 @@ name:                DocTest-version:             0.1.1+version:             0.2.0 stability:           experimental synopsis:            Test interactive Haskell examples description:         DocTest checks examples in source code comments.@@ -15,33 +15,6 @@ maintainer:          simon.hengel@wiktory.org build-type:          Simple cabal-version:       >= 1.6--extra-source-files:-    DocTest.cabal-    LICENSE-    Setup.lhs-    tests/run.sh-    tests/TestInterpreter.hs-    tests/runtests.sh-    tests/Main.hs-    tests/bugfixMultipleStatements/Fib.hs-    tests/testImport/ModuleB.hs-    tests/testImport/ModuleA.hs-    tests/run_interpreter_tests.sh-    tests/bugfixMultipleModules/ModuleB.hs-    tests/bugfixMultipleModules/ModuleA.hs-    tests/selftest.sh-    tests/testCommentLocation/Foo.hs-    tests/runtests.bat-    tests/bugfixOutputToStdErr/Fib.hs-    tests/testFailOnMultiline/Fib.hs-    tests/testPutStr/Fib.hs-    tests/bugfixWorkingDirectory/examples/Fib.hs-    tests/bugfixWorkingDirectory/description-    tests/bugfixWorkingDirectory/Fib.hs-    tests/bugfixImportHierarchical/ModuleB.hs-    tests/bugfixImportHierarchical/ModuleA.hs-    tests/Util.hs  source-repository head     type:            git

src/Main.hs view

@@ -42,4 +42,9 @@         exampleResult $ lines result'       where         exampleExpression = expression x-        exampleResult     = result x+        exampleResult     = map subBlankLines $ result x++        -- interpret lines that only contain the string "<BLANKLINE>" as an+        -- empty line+        subBlankLines "<BLANKLINE>" = ""+        subBlankLines line          = line

− tests/Main.hs

@@ -1,73 +0,0 @@-module Main where--import System.Directory (canonicalizePath)-import System.Environment (getArgs)-import Test.HUnit (Test(TestList), runTestTT)-import Util--main :: IO ()-main = do-  -- get path to doctest binary-  [bin] <- getArgs-  bin' <- canonicalizePath bin-  _ <- runTestTT $ tests $ doctestTestCase bin'-  return ();-  where-    tests doctest = TestList [--    -- Tests-    -- =====--    --  * testImport-        doctest "testImport" ["ModuleA.hs"]-        (cases 2)-      , doctest ".." ["--optghc=-itests/testImport", "tests/testImport/ModuleA.hs"]-        (cases 2)--    --  * testCommentLocation-      , doctest "." ["testCommentLocation/Foo.hs"]-        (cases 11)--    -- * testPutStr-      , doctest "testPutStr" ["Fib.hs"]-        (cases 2)--    -- * testFailOnMultiline-      , doctest "testFailOnMultiline" ["Fib.hs"]-        (cases 2) {errors = 2}--    -- Bugfix tests-    -- ============--    --  * bugfixWorkingDirectory-      , doctest "bugfixWorkingDirectory" ["Fib.hs"]-        (cases 1)-      , doctest "bugfixWorkingDirectory" ["examples/Fib.hs"]-        (cases 2)--    -- * bugfixOutputToStdErr-      , doctest "bugfixOutputToStdErr" ["Fib.hs"]-        (cases 1)--    -- * bugfixMultipleStatements-      , doctest "bugfixMultipleStatements" ["Fib.hs"]-        (cases 1)--    -- * bugfixImportHierarchical-      , doctest "bugfixImportHierarchical" ["ModuleA.hs", "ModuleB.hs"]-        (cases 2)--    -- * bugfixMultipleModules-      , doctest "bugfixMultipleModules" ["ModuleA.hs"]-        (cases 3)--    -- Open bugs-    -- =========--    {--    -- * bugFoo-      , doctest "bugFoo" ["Foo.hs"]-        (cases 3) {errors = 0, failures = 1}-        -- expected: (cases 3)-    -}-      ]

− tests/TestInterpreter.hs

@@ -1,92 +0,0 @@-module Main where--import Test.HUnit-import Interpreter--data InterpreterTest =-  InterpreterTest-    String        -- name-    [Interaction] -- interactions--data Interaction =-  Interaction-    String    -- expression-    String    -- result--ghci = Interaction--tests :: [InterpreterTest]-tests = [-    InterpreterTest "testLocalDeclaration" [-      ghci "let x = 10"-      []-    , ghci "x"-      "10\n"-  ]-  , InterpreterTest "testAddition" [-      ghci "23 + 42"-      "65\n"-    , ghci "putStrLn \"foo\" >> putStrLn \"bar\""-      "foo\n\-      \bar\n"-  ]-  , InterpreterTest "testImport" [-      ghci "import Data.Maybe"-      ""-    , ghci "fromJust $ Just 20"-      "20\n"-  ]-  , InterpreterTest "testNotInScope" [-      ghci "foo"-      "\n\-      \<interactive>:1:0: Not in scope: `foo'\n"-  ]-  , InterpreterTest "testStdOutErr" [-      ghci "import System.IO"-      ""-    , ghci "hPutStrLn stdout \"foo\""-      "foo\n"-    , ghci "hPutStrLn stderr \"bar\""-      "bar\n"-  ]-  , InterpreterTest "testShowUnicode" [-      ghci "\"λ\""-      "\"\\955\"\n"-  ]-  , InterpreterTest "testOutputUnicode" [-      ghci "putStrLn \"λ\""-      "λ\n"-  ]-  , InterpreterTest "testSystemExit" [-      ghci "import System.Exit"-      ""-    , ghci "exitWith $ ExitFailure 10"-      "*** Exception: ExitFailure 10\n"-  ]-  , InterpreterTest "testPutEmptyLine" [-      ghci "putStrLn \"\""-      "\n"-  ]-  , InterpreterTest "testPutStr" [-      ghci "putStr \"foo\""-      "foo"-  ]-  ]--main :: IO ()-main = do-  _ <- runTestTT $ TestList $ map testFromInterpreterTest tests-  return ();--testFromInterpreterTest :: InterpreterTest -> Test-testFromInterpreterTest (InterpreterTest name expressions) =-  TestLabel name $ TestCase $ assertionFromInteractions expressions-  where-    assertionFromInteractions :: [Interaction] -> Assertion-    assertionFromInteractions l = do-      withInterpreter [] $ \repl -> mapM_ (assertionFromInteraction repl) l-      where-        assertionFromInteraction :: Interpreter -> Interaction -> Assertion-        assertionFromInteraction repl (Interaction expression result') = do-          result <- eval repl expression-          assertEqual expression result' result

− tests/Util.hs

@@ -1,73 +0,0 @@-module Util (-    doctestTestCase-  , Util.cases-  , errors-  , failures-  ) where--import System.Directory (getCurrentDirectory, setCurrentDirectory)-import System.Exit (ExitCode(ExitSuccess))-import System.Process (readProcessWithExitCode)-import qualified Test.HUnit as HU-import Test.HUnit (assertEqual, Counts(..), Test(TestCase), Assertion,-                   showCounts)-import Data.Char (isSpace)--cases :: Int -> Counts-cases n = Counts {-    HU.cases = n-  , tried    = n-  , errors   = 0-  , failures = 0-  }----- | Construct a doctest specific 'TestCase'.-doctestTestCase :: FilePath -- ^ absolute path to `doctest` binary-                -> FilePath -- ^ current directory of forked `doctest` process-                -> [String] -- ^ args, given to doctest-                -> Counts   -- ^ expected test result-                -> Test-doctestTestCase doctest dir args counts = TestCase $ doctestAssert doctest dir args counts----- | Construct a doctest specific 'Assertion'.-doctestAssert :: FilePath   -- ^ absolute path to `doctest` binary-              -> FilePath   -- ^ current directory of forked `doctest` process-              -> [String]   -- ^ args, given to `doctest`-              -> Counts     -- ^ expected test result-              -> Assertion-doctestAssert doctest workingDir args counts = do-  out <- runDoctest doctest workingDir args-  assertEqual label (showCounts counts) (last . lines $ out)-  where-    label = workingDir ++ " " ++ show args----- | Fork and run a `doctest` process.-runDoctest :: FilePath      -- ^ absolute path to `doctest` binary-           -> FilePath      -- ^ current directory of forked `doctest` process-           -> [String]      -- ^ args, given to `doctest`-           -> IO String     -- ^ final result, as printed by `doctest`-runDoctest doctest workingDir args = do-  cwd <- getCurrentDirectory-  setCurrentDirectory workingDir-  (exit, out, err) <- readProcessWithExitCode doctest args ""-  setCurrentDirectory cwd-  case exit of-    ExitSuccess -> return $ lastLine err-    _           ->-      error $ mayCat "STDERR:" (strip err) ++ mayCat "STDOUT:" (strip out)-      where-        mayCat x y = if null y then "" else unlines ["", x, y]-  where-    lastLine = reverse . takeWhile (/= '\r') . reverse---- | Remove leading and trailing whitespace from given string.------ Example:------ >>> strip "   \tfoo\nbar  \t\n "--- "foo\nbar"-strip :: String -> String-strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse

− tests/bugfixImportHierarchical/ModuleA.hs

@@ -1,6 +0,0 @@--- |--- >>> fib 10--- 55-module ModuleA where--import Foo.ModuleB

− tests/bugfixImportHierarchical/ModuleB.hs

@@ -1,12 +0,0 @@-module Foo.ModuleB (fib) where----- |--- >>> fib 10--- 55--- >>> fib 5--- 5-fib :: Integer -> Integer-fib 0 = 0-fib 1 = 1-fib n = fib (n - 1) + fib (n - 2)

− tests/bugfixMultipleModules/ModuleA.hs

@@ -1,6 +0,0 @@--- |--- >>> fib 10--- 55-module ModuleA where--import ModuleB

− tests/bugfixMultipleModules/ModuleB.hs

@@ -1,20 +0,0 @@-module ModuleB (fib) where----- |--- >>> fib 10--- 55--- >>> fib 5--- 5-fib :: Integer -> Integer-fib = foo---- |--- >>> foo 10--- 55--- >>> foo 5--- 5-foo :: Integer -> Integer-foo 0 = 0-foo 1 = 1-foo n = foo (n - 1) + foo (n - 2)

− tests/bugfixMultipleStatements/Fib.hs

@@ -1,13 +0,0 @@-module Fib where--import System---- | Calculate Fibonacci number of given 'Num'.------ >>> let x = 10--- >>> x--- 10-fib :: (Num t, Num t1) => t -> t1-fib _ = undefined--bar = 10

− tests/bugfixOutputToStdErr/Fib.hs

@@ -1,11 +0,0 @@-module Fib where--import System---- | Calculate Fibonacci number of given 'Num'.------ >>> import System.IO--- >>> hPutStrLn stderr "foobar"--- foobar-fib :: (Num t, Num t1) => t -> t1-fib _ = undefined

− tests/bugfixWorkingDirectory/Fib.hs

@@ -1,10 +0,0 @@-module Fib where---- | Calculate Fibonacci number of given 'Num'.------ >>> bar--- 10-fib :: (Num t, Num t1) => t -> t1-fib _ = undefined--bar = 10

− tests/bugfixWorkingDirectory/description

@@ -1,10 +0,0 @@-Put the following files in the current working directory:--    ./Fib.hs-    ./examples/Fib.hs--Now run:--    doctest examples/Fib.hs--Erroneously `./Fib.hs` will be tested instead of `examples/Fib.hs`.

− tests/bugfixWorkingDirectory/examples/Fib.hs

@@ -1,16 +0,0 @@-module Fib where----- | Calculate Fibonacci number of given 'Num'.------ Examples:------    >>> fib 10---    55------    >>> fib 5---    5-fib :: (Num t, Num t1) => t -> t1-fib 0 = 0-fib 1 = 1-fib n = fib (n - 1) + fib (n - 2)

− tests/run.sh

@@ -1,10 +0,0 @@-#!/bin/bash--set -o nounset-set -o errexit--cd "`dirname $0`"--./run_interpreter_tests.sh-./runtests.sh-./selftest.sh

− tests/run_interpreter_tests.sh

@@ -1,4 +0,0 @@-#!/bin/bash--cd "`dirname $0`"-runhaskell -i../src TestInterpreter.hs

− tests/runtests.bat

@@ -1,1 +0,0 @@-runhaskell -hide-all-packages -packagebase -packageHUnit -packageprocess -packagedirectory Main.hs ../dist/build/doctest/doctest

− tests/runtests.sh

@@ -1,16 +0,0 @@-#!/bin/bash--cd "`dirname $0`"--DOCTEST="${1:-"../dist/build/doctest/doctest"}"--if [ -x "$DOCTEST" ]; then-    runhaskell -hide-all-packages \-               -packagebase \-               -packageHUnit \-               -packageprocess \-               -packagedirectory \-                Main.hs "$DOCTEST"-else-    echo "$DOCTEST is not executable!"-fi

− tests/selftest.sh

@@ -1,12 +0,0 @@-#!/bin/bash--cd "`dirname $0`"--DOCTEST="${1:-"../dist/build/doctest/doctest"}"--if [ -x "$DOCTEST" ]; then-    SRCDIR="../src"-    "$DOCTEST" --optghc=-packageghc --optghc=-i$SRCDIR $SRCDIR/Main.hs-else-    echo "$DOCTEST is not executable!"-fi

− tests/testCommentLocation/Foo.hs

@@ -1,75 +0,0 @@--- |--- Examples in various locations...------ Some random text.  Some random text.  Some random text.  Some random text.--- Some random text.  Some random text.  Some random text.  Some random text.--- Some random text.------ >>> let x = 10------ Some random text.  Some random text.  Some random text.  Some random text.--- Some random text.  Some random text.  Some random text.  Some random text.--- Some random text.---------   >>> baz---   "foobar"--module Foo (-  -- | Some documentation not attached to a particular Haskell entity-  ---  -- >>> test 10-  -- *** Exception: Prelude.undefined-  test,--  -- |-  -- >>> fib 10-  -- 55-  fib,--  -- |-  -- >>> bar-  -- "bar"-  bar-  ) where----- | My test------ >>> test 20--- *** Exception: Prelude.undefined-test :: Integer -> Integer-test = undefined---- |--- >>> foo--- "foo"--{- |-    Example:--     >>> fib 10-     55--}---- | Calculate Fibonacci number of given `n`.-fib :: Integer  -- ^ given `n`-                ---                -- >>> fib 10-                -- 55--    -> Integer  -- ^ Fibonacci of given `n`-                ---                -- >>> baz-                -- "foobar"-fib 0 = 0-fib 1 = 1-fib n = fib (n - 1) + fib (n - 2)--- ^ Example:------   >>> fib 5---   5--foo = "foo"-bar = "bar"-baz = foo ++ bar

− tests/testFailOnMultiline/Fib.hs

@@ -1,13 +0,0 @@-module Fib where--import System---- | Calculate Fibonacci number of given 'Num'.------ The following interactions cause `doctest' to fail with an error:------ >>> :{------ >>>       :{-fib :: (Num t, Num t1) => t -> t1-fib _ = undefined

− tests/testImport/ModuleA.hs

@@ -1,6 +0,0 @@--- |--- >>> fib 10--- 55-module ModuleA where--import ModuleB

− tests/testImport/ModuleB.hs

@@ -1,12 +0,0 @@-module ModuleB (fib) where----- |--- >>> fib 10--- 55--- >>> fib 5--- 5-fib :: Integer -> Integer-fib 0 = 0-fib 1 = 1-fib n = fib (n - 1) + fib (n - 2)

− tests/testPutStr/Fib.hs

@@ -1,15 +0,0 @@-module Fib where--import System---- | Calculate Fibonacci number of given 'Num'.------ >>> putStrLn "foo"--- foo--- >>> putStr "bar"--- bar------ >>> putStrLn "baz"--- baz-fib :: (Num t, Num t1) => t -> t1-fib _ = undefined