doctest-parallel-0.1: test/MainSpec.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}

module MainSpec (main, spec) where

import           Test.Hspec
import           Test.HUnit (assertEqual, Assertion)

import qualified Test.DocTest as DocTest
import           Test.DocTest.Helpers (extractSpecificCabalLibrary, findCabalPackage)
import           Test.DocTest.Internal.Options
import           Test.DocTest.Internal.Runner
import           System.IO.Silently
import           System.IO

-- | Construct a doctest specific 'Assertion'.
doctest :: HasCallStack => [ModuleName] -> Summary -> Assertion
doctest = doctestWithOpts defaultConfig

doctestWithOpts :: HasCallStack => Config -> [ModuleName] -> Summary -> Assertion
doctestWithOpts config modNames expected = do
  pkg <- findCabalPackage "doctest-parallel"
  lib <- extractSpecificCabalLibrary (Just "spectests-modules") pkg
  actual <-
    hSilence [stderr] $
      DocTest.main lib config{cfgModules=modNames}
  assertEqual (show modNames) expected actual

cases :: Int -> Summary
cases n = Summary n n 0 0

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "doctest" $ do
    it "testSimple" $
      doctest ["TestSimple.Fib"]
        (cases 1)

    it "it-variable" $ do
      doctestWithOpts (defaultConfig{cfgPreserveIt=True}) ["It.Foo"]
        (cases 5)

    it "it-variable in $setup" $ do
      doctestWithOpts (defaultConfig{cfgPreserveIt=True}) ["It.Setup"]
        (cases 2)

    it "failing" $ do
      doctest ["Failing.Foo"]
        (cases 1) {sFailures = 1}

    it "skips subsequent examples from the same group if an example fails" $
      doctest ["FailingMultiple.Foo"]
        (cases 4) {sTried = 2, sFailures = 1}

    it "testImport" $ do
      doctest ["TestImport.ModuleA"]
        (cases 2)

    it "testCommentLocation" $ do
      doctest ["TestCommentLocation.Foo"]
        (cases 11)

    it "testPutStr" $ do
      doctest ["TestPutStr.Fib"]
        (cases 3)

    it "fails on multi-line expressions, introduced with :{" $ do
      doctest ["TestFailOnMultiline.Fib"]
        (cases 2) {sErrors = 2}

    it "testBlankline" $ do
      doctest ["TestBlankline.Fib"]
        (cases 1)

    it "examples from the same Haddock comment share the same scope" $ do
      doctest ["TestCombinedExample.Fib"]
        (cases 4)

    it "testDocumentationForArguments" $ do
      doctest ["TestDocumentationForArguments.Fib"]
        (cases 1)

    it "template-haskell" $ do
      doctest ["TemplateHaskell.Foo"]
        (cases 2)

    it "handles source files with CRLF line endings" $ do
      doctest ["DosLineEndings.Fib"]
        (cases 1)

    it "runs $setup before each test group" $ do
      doctest ["Setup.Foo"]
        (cases 1)

    it "skips subsequent tests from a module, if $setup fails" $ do
      doctest ["SetupSkipOnFailure.Foo"]
        -- TODO: Introduce "skipped"
        (cases 2) {sTried = 0, sFailures = 0}

    it "works with additional object files" $ do
      doctest ["WithCbits.Bar"]
        (cases 1)

    it "ignores trailing whitespace when matching test output" $ do
      doctest ["TrailingWhitespace.Foo"]
        (cases 1)

  describe "doctest as a runner for QuickCheck properties" $ do
    it "runs a boolean property" $ do
      doctest ["PropertyBool.Foo"]
        (cases 1)

    it "runs an explicitly quantified property" $ do
      doctest ["PropertyQuantified.Foo"]
        (cases 1)

    it "runs an implicitly quantified property" $ do
      doctest ["PropertyImplicitlyQuantified.Foo"]
        (cases 1)

    it "reports a failing property" $ do
      doctest ["PropertyFailing.Foo"]
        (cases 1) {sFailures = 1}

    it "runs a boolean property with an explicit type signature" $ do
      doctest ["PropertyBoolWithTypeSignature.Foo"]
        (cases 1)

    it "runs $setup before each property" $ do
      doctest ["PropertySetup.Foo"]
        (cases 1)

  describe "doctest (module isolation)" $ do
    it "should fail due to module isolation" $ do
      doctestWithOpts defaultConfig ["ModuleIsolation.TestA", "ModuleIsolation.TestB"]
        (cases 2) {sFailures = 1}

  describe "doctest (regression tests)" $ do
    it "bugfixOutputToStdErr" $ do
      doctest ["BugfixOutputToStdErr.Fib"]
        (cases 2)

    it "bugfixImportHierarchical" $ do
      doctest ["BugfixImportHierarchical.ModuleA", "BugfixImportHierarchical.ModuleB"]
        (cases 4)

    it "bugfixMultipleModules" $ do
      doctest ["BugfixMultipleModules.ModuleA", "BugfixMultipleModules.ModuleB"]
        -- TODO: Introduce "skipped"
        (cases 6) {sTried = 5, sFailures = 1}

    it "doesn't clash with user bindings of stdout/stderr" $ do
      doctest ["LocalStderrBinding.A"]
        (cases 1)

    it "doesn't get confused by doctests using System.IO imports" $ do
      doctest ["SystemIoImported.A"]
        (cases 2)