ehmry/dhall-haskell
ehmry
/
dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use `tasty-expected-failure` (#1250) 

* Use `tasty-expected-failure`

... to exercise tests that we currently skip

Fixes https://github.com/dhall-lang/dhall-haskell/issues/1245

* Fix bounds syntax for `tasty-expected-failure`

... as caught by @sjakobi

Co-Authored-By: Simon Jakobi <simon.jakobi@gmail.com>

* Fix GHC 8.6 build failure

`tasty-expected-failure` needs to be bumped to include revision 1, which
supports GHC 8.6

* Fix build failure for older `tasty-hunit` versions

`tasty-hunit-0.9.2` and older have the wrong type for `assertFailure`

* Fix `stack` build for LTS 6

... and sort the list of `extra-deps`
This commit is contained in:
Gabriel Gonzalez 2019-08-29 22:31:19 -05:00 committed by mergify[bot]
parent e687b11fc2
commit 4445eee871
8 changed files with 204 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
dhall/dhall.cabal
View File

@ -603,7 +603,8 @@ Test-Suite tasty
spoon < 0.4 ,
recursion-schemes >= 5.0.1 && < 6.0 ,
tasty >= 0.11.2 && < 1.3 ,
tasty-hunit >= 0.9.2 && < 0.11,
tasty-expected-failure < 0.12,
tasty-hunit >= 0.10 && < 0.11,
tasty-quickcheck >= 0.9.2 && < 0.11,
text >= 0.11.1.0 && < 1.3 ,
transformers ,

18
dhall/tests/Dhall/Test/Normalization.hs
View File

@ -10,7 +10,6 @@ import Prelude hiding (FilePath)
import Test.Tasty (TestTree)
import Turtle (FilePath, (</>))
import qualified Control.Monad as Monad
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Dhall.Context as Context
@ -43,16 +42,7 @@ getTests = do
Test.Util.discover pattern alphaNormalizationTest
(Turtle.lstree "./dhall-lang/tests/alpha-normalization/success/")
let unitTestFiles = do
path <- Turtle.lstree (normalizationDirectory </> "unit/")
let skip = [ normalizationDirectory </> "unit/RecursiveRecordMergeWithinFieldSelection3A.dhall"
, normalizationDirectory </> "unit/RightBiasedMergeWithinFieldSelection3A.dhall"
]
Monad.guard (path `notElem` skip)
return path
let unitTestFiles = Turtle.lstree (normalizationDirectory </> "unit/")
unitTests <- Test.Util.discover pattern unitTest unitTestFiles
@ -148,9 +138,13 @@ alphaNormalizationTest prefix = do
-}
unitTest :: Text -> TestTree
unitTest prefix = do
let skip = [ normalizationDirectory </> "unit/RecursiveRecordMergeWithinFieldSelection3"
, normalizationDirectory </> "unit/RightBiasedMergeWithinFieldSelection3"
]
let prefixString = Text.unpack prefix
Tasty.HUnit.testCase prefixString $ do
Test.Util.testCase prefix skip $ do
let actualPath = prefixString <> "A.dhall"
let expectedPath = prefixString <> "B.dhall"

158
dhall/tests/Dhall/Test/Parser.hs
View File

@ -35,29 +35,74 @@ binaryDecodeDirectory = "./dhall-lang/tests/binary-decode"
getTests :: IO TestTree
getTests = do
let successFiles = do
path <- Turtle.lstree (parseDirectory </> "success")
let skip =
-- This is a bug created by a parsing performance
-- improvement
[ parseDirectory </> "success/unit/MergeParenAnnotationA.dhall"
-- https://github.com/dhall-lang/dhall-haskell/issues/1185
, parseDirectory </> "success/letA.dhall"
, parseDirectory </> "success/unit/LetNestedA.dhall"
]
Monad.guard (path `notElem` skip)
return path
let successFiles = Turtle.lstree (parseDirectory </> "success")
successTests <- do
Test.Util.discover (Turtle.chars <* "A.dhall") shouldParse successFiles
let failureFiles = do
path <- Turtle.lstree (parseDirectory </> "failure")
let failureFiles = Turtle.lstree (parseDirectory </> "failure")
failureTests <- do
Test.Util.discover (Turtle.chars <> ".dhall") shouldNotParse failureFiles
let binaryDecodeSuccessFiles =
Turtle.lstree (binaryDecodeDirectory </> "success")
binaryDecodeSuccessTests <- do
Test.Util.discover (Turtle.chars <* "A.dhallb") shouldDecode binaryDecodeSuccessFiles
let binaryDecodeFailureFiles = Turtle.lstree (binaryDecodeDirectory </> "failure")
binaryDecodeFailureTests <- do
Test.Util.discover (Turtle.chars <* ".dhallb") shouldNotDecode binaryDecodeFailureFiles
let testTree =
Tasty.testGroup "parser tests"
[ successTests
, failureTests
, binaryDecodeSuccessTests
, binaryDecodeFailureTests
]
return testTree
shouldParse :: Text -> TestTree
shouldParse path = do
let skip =
-- This is a bug created by a parsing performance
-- improvement
[ parseDirectory </> "success/unit/MergeParenAnnotation"
-- https://github.com/dhall-lang/dhall-haskell/issues/1185
, parseDirectory </> "success/let"
, parseDirectory </> "success/unit/LetNested"
]
let pathString = Text.unpack path
Test.Util.testCase path skip $ do
text <- Text.IO.readFile (pathString <> "A.dhall")
encoded <- ByteString.Lazy.readFile (pathString <> "B.dhallb")
expression <- Core.throws (Parser.exprFromText mempty text)
let term = Binary.encodeExpression expression
let bytes = Serialise.serialise term
Monad.unless (encoded == bytes) $ do
("", expected) <- Core.throws (CBOR.deserialiseFromBytes CBOR.decodeTerm encoded)
let message = "The expected CBOR representation doesn't match the actual one\n"
++ "expected: " ++ show expected ++ "\n but got: " ++ show term
++ "\n expr: " ++ show expression
Tasty.HUnit.assertFailure message
shouldNotParse :: Text -> TestTree
shouldNotParse path = do
let skip =
[ -- These two unexpected successes are due to not correctly
-- requiring non-empty whitespace after the `:` in a type
@ -90,76 +135,15 @@ getTests = do
-- as a type-checking failure instead of a parse failure,
-- but this might be fixable.
, parseDirectory </> "failure/unit/ListLitEmptyAnnotation.dhall"
-- The same performance improvements also broke the
-- precedence of parsing empty list literals
, parseDirectory </> "failure/unit/ListLitEmptyPrecedence.dhall"
]
Monad.guard (path `notElem` skip)
return path
failureTests <- do
Test.Util.discover (Turtle.chars <> ".dhall") shouldNotParse failureFiles
let binaryDecodeSuccessFiles =
Turtle.lstree (binaryDecodeDirectory </> "success")
binaryDecodeSuccessTests <- do
Test.Util.discover (Turtle.chars <* "A.dhallb") shouldDecode binaryDecodeSuccessFiles
let binaryDecodeFailureFiles = do
path <- Turtle.lstree (binaryDecodeDirectory </> "failure")
let skip = []
Monad.guard (path `notElem` skip)
return path
binaryDecodeFailureTests <- do
Test.Util.discover (Turtle.chars <* ".dhallb") shouldNotDecode binaryDecodeFailureFiles
let testTree =
Tasty.testGroup "parser tests"
[ successTests
, failureTests
, binaryDecodeSuccessTests
, binaryDecodeFailureTests
]
return testTree
shouldParse :: Text -> TestTree
shouldParse path = do
let pathString = Text.unpack path
Tasty.HUnit.testCase pathString $ do
text <- Text.IO.readFile (pathString <> "A.dhall")
encoded <- ByteString.Lazy.readFile (pathString <> "B.dhallb")
expression <- Core.throws (Parser.exprFromText mempty text)
let term = Binary.encodeExpression expression
let bytes = Serialise.serialise term
Monad.unless (encoded == bytes) $ do
("", expected) <- Core.throws (CBOR.deserialiseFromBytes CBOR.decodeTerm encoded)
let message = "The expected CBOR representation doesn't match the actual one\n"
++ "expected: " ++ show expected ++ "\n but got: " ++ show term
++ "\n expr: " ++ show expression
Tasty.HUnit.assertFailure message
shouldNotParse :: Text -> TestTree
shouldNotParse path = do
let pathString = Text.unpack path
Tasty.HUnit.testCase pathString (do
Test.Util.testCase path skip (do
bytes <- ByteString.readFile pathString
case Text.Encoding.decodeUtf8' bytes of
@ -167,13 +151,15 @@ shouldNotParse path = do
Right text -> do
case Parser.exprFromText mempty text of
Left _ -> return ()
Right _ -> fail "Unexpected successful parser" )
Right _ -> Tasty.HUnit.assertFailure "Unexpected successful parse" )
shouldDecode :: Text -> TestTree
shouldDecode pathText = do
let skip = []
let pathString = Text.unpack pathText
Tasty.HUnit.testCase pathString (do
Test.Util.testCase pathText skip (do
bytes <- ByteString.Lazy.readFile (pathString <> "A.dhallb")
term <- Core.throws (Serialise.deserialiseOrFail bytes)
@ -194,13 +180,15 @@ shouldDecode pathText = do
shouldNotDecode :: Text -> TestTree
shouldNotDecode pathText = do
let skip = []
let pathString = Text.unpack pathText
Tasty.HUnit.testCase pathString (do
Test.Util.testCase pathText skip (do
bytes <- ByteString.Lazy.readFile (pathString <> ".dhallb")
term <- Core.throws (Serialise.deserialiseOrFail bytes)
case Binary.decodeExpression term :: Either Binary.DecodingFailure (Expr X Import) of
Left _ -> return ()
Right _ -> fail "Unexpected successful decode" )
Right _ -> Tasty.HUnit.assertFailure "Unexpected successful decode" )

63
dhall/tests/Dhall/Test/TypeCheck.hs
View File

@ -10,7 +10,6 @@ import Test.Tasty (TestTree)
import Turtle (FilePath, (</>))
import qualified Control.Exception as Exception
import qualified Control.Monad as Monad
import qualified Data.Text as Text
import qualified Dhall.Core as Core
import qualified Dhall.Parser as Parser
@ -25,33 +24,11 @@ typecheckDirectory = "./dhall-lang/tests/typecheck"
getTests :: IO TestTree
getTests = do
let successTestFiles = do
path <- Turtle.lstree (typecheckDirectory </> "success")
let skip = [ typecheckDirectory </> "success/preferMixedRecordsA.dhall"
, typecheckDirectory </> "success/preferMixedRecordsSameFieldA.dhall"
, typecheckDirectory </> "success/preludeA.dhall" -- fixed in dhall-lang/dhall-lang#708
, typecheckDirectory </> "success/RecordTypeMixedKindsA.dhall"
, typecheckDirectory </> "success/simple/combineMixedRecordsA.dhall"
, typecheckDirectory </> "success/simple/RecordMixedKinds2A.dhall"
, typecheckDirectory </> "success/simple/RecordMixedKindsA.dhall"
, typecheckDirectory </> "success/simple/RecursiveRecordMergeMixedKindsA.dhall"
, typecheckDirectory </> "success/simple/RightBiasedRecordMergeMixedKindsA.dhall"
]
Monad.guard (path `notElem` skip)
return path
let successTestFiles = Turtle.lstree (typecheckDirectory </> "success")
successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest successTestFiles
let failureTestFiles = do
path <- Turtle.lstree (typecheckDirectory </> "failure")
let skip = [ typecheckDirectory </> "failure/unit/MergeEmptyNeedsDirectAnnotation1.dhall"
]
Monad.guard (path `notElem` skip)
return path
let failureTestFiles = Turtle.lstree (typecheckDirectory </> "failure")
failureTests <- Test.Util.discover (Turtle.chars <> ".dhall") failureTest failureTestFiles
@ -63,26 +40,48 @@ getTests = do
return testTree
successTest :: Text -> TestTree
successTest prefix =
Tasty.HUnit.testCase (Text.unpack prefix) $ do
successTest prefix = do
let skip = [ typecheckDirectory </> "success/preferMixedRecords"
, typecheckDirectory </> "success/preferMixedRecordsSameField"
, typecheckDirectory </> "success/prelude" -- fixed in dhall-lang/dhall-lang#708
, typecheckDirectory </> "success/RecordTypeMixedKinds"
, typecheckDirectory </> "success/simple/combineMixedRecords"
, typecheckDirectory </> "success/simple/RecordMixedKinds2"
, typecheckDirectory </> "success/simple/RecordMixedKinds"
, typecheckDirectory </> "success/simple/RecursiveRecordMergeMixedKinds"
, typecheckDirectory </> "success/simple/RightBiasedRecordMergeMixedKinds"
]
Test.Util.testCase prefix skip $ do
let actualCode = Test.Util.toDhallPath (prefix <> "A.dhall")
let expectedCode = Test.Util.toDhallPath (prefix <> "B.dhall")
actualExpr <- Core.throws (Parser.exprFromText mempty actualCode)
actualExpr <- Core.throws (Parser.exprFromText mempty actualCode )
expectedExpr <- Core.throws (Parser.exprFromText mempty expectedCode)
let annotatedExpr = Core.Annot actualExpr expectedExpr
resolvedExpr <- Test.Util.load annotatedExpr
tryResolvedExpr <- Exception.try (Test.Util.load annotatedExpr)
resolvedExpr <- case tryResolvedExpr of
Left exception -> Tasty.HUnit.assertFailure (show (exception :: SomeException))
Right resolvedExpr -> return resolvedExpr
case TypeCheck.typeOf resolvedExpr of
Left exception -> Tasty.HUnit.assertFailure (show exception)
Right _ -> return ()
{-
_ <- Core.throws (TypeCheck.typeOf resolvedExpr)
-}
return ()
failureTest :: Text -> TestTree
failureTest path = do
Tasty.HUnit.testCase (Text.unpack path) $ do
let skip = [ typecheckDirectory </> "failure/unit/MergeEmptyNeedsDirectAnnotation1.dhall"
]
Test.Util.testCase path skip $ do
let dhallPath = Test.Util.toDhallPath path
expression <- Core.throws (Parser.exprFromText mempty dhallPath)
@ -98,5 +97,5 @@ failureTest path = do
typeChecked <- Exception.handle handler io
if typeChecked
then fail (Text.unpack path <> " should not have type-checked")
then Tasty.HUnit.assertFailure (Text.unpack path <> " should not have type-checked")
else return ()

34
dhall/tests/Dhall/Test/TypeInference.hs
View File

@ -8,7 +8,6 @@ import Prelude hiding (FilePath)
import Test.Tasty (TestTree)
import Turtle (FilePath, (</>))
import qualified Control.Monad as Monad
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Dhall.Core as Core
@ -25,22 +24,7 @@ typeInferenceDirectory = "./dhall-lang/tests/type-inference"
getTests :: IO TestTree
getTests = do
let successTestFiles = do
path <- Turtle.lstree (typeInferenceDirectory </> "success")
let skip = [ -- We correctly infer the expected type @NaN ≡ NaN@ here,
-- but the comparison between the inferred and the expected type
-- fails due to `Expr`'s 'Eq' instance, which inherits the
-- @NaN /= NaN@ inequality from 'Double'.
typeInferenceDirectory </> "success/unit/AssertNaNA.dhall"
, typeInferenceDirectory </> "success/unit/RecursiveRecordMergeBoolTypeA.dhall"
, typeInferenceDirectory </> "success/simple/RecordTypeMixedKinds2A.dhall"
, typeInferenceDirectory </> "success/simple/RecordTypeMixedKinds3A.dhall"
]
Monad.guard (path `notElem` skip)
return path
let successTestFiles = Turtle.lstree (typeInferenceDirectory </> "success")
successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest successTestFiles
@ -52,12 +36,24 @@ getTests = do
successTest :: Text -> TestTree
successTest prefix = do
Tasty.HUnit.testCase (Text.unpack prefix) $ do
let skip = [ -- We correctly infer the expected type @NaN ≡ NaN@ here,
-- but the comparison between the inferred and the expected type
-- fails due to `Expr`'s 'Eq' instance, which inherits the
-- @NaN /= NaN@ inequality from 'Double'.
typeInferenceDirectory </> "success/unit/AssertNaN"
, typeInferenceDirectory </> "success/unit/RecursiveRecordMergeBoolType"
, typeInferenceDirectory </> "success/simple/RecordTypeMixedKinds2"
, typeInferenceDirectory </> "success/simple/RecordTypeMixedKinds3"
]
Test.Util.testCase prefix skip $ do
value <- expr "A.dhall"
expectedType <- expr "B.dhall"
inferredType <- Core.throws (TypeCheck.typeOf value)
inferredType <- case TypeCheck.typeOf value of
Left exception -> Tasty.HUnit.assertFailure (show exception)
Right inferredType -> return inferredType
let message = "The inferred type did not match the expected type"

9
dhall/tests/Dhall/Test/Util.hs
View File

@ -16,6 +16,7 @@ module Dhall.Test.Util
, assertTypeChecks
, assertDoesntTypeCheck
, discover
, Dhall.Test.Util.testCase
, toDhallPath
) where
@ -44,6 +45,7 @@ import qualified Dhall.Parser
import qualified Dhall.TypeCheck
import qualified Control.Monad.Trans.State.Strict as State
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.ExpectedFailure as Tasty.ExpectedFailure
import qualified Turtle
#ifndef WITH_HTTP
@ -200,6 +202,13 @@ discover pattern buildTest paths = do
return (Tasty.testGroup "discover" tests)
testCase :: Text -> [ FilePath ] -> Assertion -> TestTree
testCase prefix skip assertion =
if prefix `elem` map (Turtle.format fp) skip
then Tasty.ExpectedFailure.expectFail test
else test
where
test = Test.Tasty.HUnit.testCase (Text.unpack prefix) assertion
{-| Path names on Windows are not valid Dhall paths due to using backslashes
instead of forwardslashes to separate path components. This utility fixes

12
nix/tasty-expected-failure.nix Normal file
View File

@ -0,0 +1,12 @@
{ mkDerivation, base, stdenv, tagged, tasty }:
mkDerivation {
pname = "tasty-expected-failure";
version = "0.11.1.1";
sha256 = "519a5c0d2ef9dd60355479f11ca47423133364f20ad3151f3c8b105313405ac4";
revision = "1";
editedCabalFile = "1b3fn7d3zwhhwm3gp8cmmsdcrvn9dhshd665xrx1mk6cmy4m8k16";
libraryHaskellDepends = [ base tagged tasty ];
homepage = "http://github.com/nomeata/tasty-expected-failure";
description = "Mark tasty tests as failure expected";
license = stdenv.lib.licenses.mit;
}

129
stack-lts-6.yaml
View File

@ -3,86 +3,87 @@ packages:
- dhall
- dhall-bash
extra-deps:
- ansi-terminal-0.9.1
- either-5
- ansi-wl-pprint-0.6.8.2
- cryptonite-0.24
- formatting-6.3.2
- megaparsec-7.0.3
- parser-combinators-1.0.0
- optparse-generic-1.3.0
- optparse-applicative-0.14.3.0
- Cabal-2.4.1.0
- Only-0.1
- memory-0.14.14
- basement-0.0.6
- prettyprinter-1.2.0.1
- prettyprinter-ansi-terminal-1.1.1.2
- directory-1.3.4.0
- foundation-0.0.19
- process-1.6.2.0
- repline-0.2.1.0
- haskeline-0.7.4.2
- QuickCheck-2.13.2
- StateVar-1.2
- Win32-2.6.2.0
- aeson-1.4.4.0
- th-abstraction-0.3.1.0
- cborg-0.2.1.0
- serialise-0.2.1.0
- shell-escape-0.2.0
- cborg-json-0.2.1.0
- dotgen-0.4.2
- aeson-pretty-0.8.7
- transformers-compat-0.6.4
- ansi-terminal-0.9.1
- ansi-wl-pprint-0.6.8.2
- attoparsec-0.13.2.2
- base-compat-0.10.5
- base-orphans-0.8.1
- basement-0.0.6
- cabal-doctest-1.0.6
- case-insensitive-1.2.1.0
- cborg-0.2.1.0
- cborg-json-0.2.1.0
- contravariant-1.5.2
- cryptonite-0.24
- directory-1.3.4.0
- dlist-0.8.0.6
- dotgen-0.4.2
- either-5
- exceptions-0.8.3
- foldl-1.4.5
- formatting-6.3.2
- foundation-0.0.19
- hashable-1.2.7.0
- haskeline-0.7.4.2
- integer-logarithms-1.0.3
- megaparsec-7.0.3
- memory-0.14.14
- mintty-0.1.2
- mmorph-1.1.3
- monad-control-1.0.2.3
- resourcet-1.1.11
- turtle-1.5.14
- unliftio-core-0.1.2.0
- yaml-0.10.4.0
- recursion-schemes-5.1.3
- cabal-doctest-1.0.6
- QuickCheck-2.13.2
- tasty-quickcheck-0.10.1
- tasty-1.2.3
- splitmix-0.0.2
- semigroupoids-5.3.2
- base-orphans-0.8.1
- tagged-0.8.6
- Cabal-2.4.1.0
- optparse-applicative-0.14.3.0
- optparse-generic-1.3.0
- parsec-3.1.13.0
- text-1.2.3.1
- parser-combinators-1.0.0
- prettyprinter-1.2.0.1
- prettyprinter-ansi-terminal-1.1.1.2
- primitive-0.6.3.0
- process-1.6.2.0
- profunctors-5.4
- wcwidth-0.0.2
- foldl-1.4.5
- quickcheck-instances-0.3.22
- base-compat-0.10.5
- hashable-1.2.7.0
- semigroups-0.18.5
- time-compat-1.9.2.2
- vector-builder-0.3.7.2
- case-insensitive-1.2.1.0
- recursion-schemes-5.1.3
- repline-0.2.1.0
- resourcet-1.1.11
- scientific-0.3.6.2
- semigroupoids-5.3.2
- semigroups-0.18.5
- serialise-0.2.1.0
- shell-escape-0.2.0
- splitmix-0.0.2
- system-fileio-0.3.16.4
- tagged-0.8.6
- tasty-1.2.3
- tasty-hunit-0.10.0.2@sha256:8e8bd5807cec650f5aebc5ada07b57620c863e69145e65249651c1b48d97bd70
- tasty-quickcheck-0.10.1
- text-1.2.3.1
- th-abstraction-0.3.1.0
- th-lift-0.8.0.1
- th-lift-instances-0.1.13
- time-1.8.0.4
- time-compat-1.9.2.2
- tls-1.4.1
- transformers-compat-0.6.4
- turtle-1.5.14
- unix-2.7.2.2
- unix-compat-0.5.1
- unliftio-core-0.1.2.0
- unordered-containers-0.2.10.0
- uuid-types-1.0.3
- contravariant-1.5.2
- dlist-0.8.0.6
- primitive-0.6.3.0
- vector-0.12.0.3
- StateVar-1.2
- integer-logarithms-1.0.3
- attoparsec-0.13.2.2
- tls-1.4.1
- vector-builder-0.3.7.2
- wcwidth-0.0.2
- x509-1.7.5
- x509-validation-1.6.11
- x509-store-1.6.7
- x509-system-1.6.6
- mintty-0.1.2
- Win32-2.6.2.0
- unix-compat-0.5.1
- system-fileio-0.3.16.4
- time-1.8.0.4
- th-lift-instances-0.1.13
- th-lift-0.8.0.1
- unix-2.7.2.2
- x509-validation-1.6.11
- yaml-0.10.4.0
flags:
transformers-compat:
four: true