diff --git a/dhall/dhall-lang b/dhall/dhall-lang index 9203c77..e07ae49 160000 --- a/dhall/dhall-lang +++ b/dhall/dhall-lang @@ -1 +1 @@ -Subproject commit 9203c77bfa8f96b3bc9a26016da94d27537d13b9 +Subproject commit e07ae490ae720f1108c5143c2934879c9660f9a0 diff --git a/dhall/dhall.cabal b/dhall/dhall.cabal index c06b7f3..e9d0f82 100644 --- a/dhall/dhall.cabal +++ b/dhall/dhall.cabal @@ -232,8 +232,7 @@ Extra-Source-Files: dhall-lang/tests/normalization/success/simplifications/*.dhall dhall-lang/tests/parser/failure/*.dhall dhall-lang/tests/parser/success/*.dhall - dhall-lang/tests/binary/success/*.dhall - dhall-lang/tests/binary/success/*.dhallb + dhall-lang/tests/parser/success/*.dhallb dhall-lang/tests/typecheck/failure/*.dhall dhall-lang/tests/typecheck/success/*.dhall dhall-lang/tests/typecheck/success/prelude/Bool/and/*.dhall @@ -466,7 +465,6 @@ Test-Suite tasty Main-Is: Dhall/Test/Main.hs GHC-Options: -Wall Other-Modules: - Dhall.Test.Binary Dhall.Test.Dhall Dhall.Test.Format Dhall.Test.Import @@ -481,6 +479,7 @@ Test-Suite tasty Build-Depends: base >= 4 && < 5 , bytestring < 0.11, + cborg >= 0.2.0.0 && < 0.3 , containers , deepseq >= 1.2.0.1 && < 1.5 , dhall , diff --git a/dhall/tests/Dhall/Test/Binary.hs b/dhall/tests/Dhall/Test/Binary.hs deleted file mode 100644 index a42f6bb..0000000 --- a/dhall/tests/Dhall/Test/Binary.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Dhall.Test.Binary where - -import Data.Text (Text) -import Test.Tasty (TestTree) - -import qualified Codec.Serialise -import qualified Control.Exception -import qualified Data.ByteString.Lazy -import qualified Data.Text -import qualified Data.Text.IO -import qualified Dhall.Binary -import qualified Dhall.Parser -import qualified Test.Tasty -import qualified Test.Tasty.HUnit - -tests :: TestTree -tests = - Test.Tasty.testGroup "binary format tests" - [ shouldMatch - "binary encoding of Double values" - "./dhall-lang/tests/binary/success/double" - ] - -shouldMatch :: Text -> FilePath -> TestTree -shouldMatch name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do - text <- Data.Text.IO.readFile (path <> "A.dhall") - encoded <- Data.ByteString.Lazy.readFile (path <> "B.dhallb") - - expression <- case Dhall.Parser.exprFromText mempty text of - Left e -> Control.Exception.throwIO e - Right a -> pure a - - let term = Dhall.Binary.encode expression - bytes = Codec.Serialise.serialise term - - case encoded == bytes of - True -> return () - _ -> error "Binary representation doesn't match" diff --git a/dhall/tests/Dhall/Test/Main.hs b/dhall/tests/Dhall/Test/Main.hs index 17ac856..8365342 100644 --- a/dhall/tests/Dhall/Test/Main.hs +++ b/dhall/tests/Dhall/Test/Main.hs @@ -2,7 +2,6 @@ module Main where import Test.Tasty (TestTree) -import qualified Dhall.Test.Binary import qualified Dhall.Test.Dhall import qualified Dhall.Test.Format import qualified Dhall.Test.Import @@ -26,7 +25,6 @@ allTests = Test.Tasty.testGroup "Dhall Tests" [ Dhall.Test.Normalization.tests , Dhall.Test.Parser.tests - , Dhall.Test.Binary.tests , Dhall.Test.Regression.tests , Dhall.Test.Tutorial.tests , Dhall.Test.Format.tests diff --git a/dhall/tests/Dhall/Test/Parser.hs b/dhall/tests/Dhall/Test/Parser.hs index d27bafa..e4b6006 100644 --- a/dhall/tests/Dhall/Test/Parser.hs +++ b/dhall/tests/Dhall/Test/Parser.hs @@ -2,12 +2,15 @@ module Dhall.Test.Parser where -import Data.Text (Text) -import Test.Tasty (TestTree) +import Data.Text (Text) +import Test.Tasty (TestTree) +import qualified Codec.Serialise import qualified Control.Exception +import qualified Data.ByteString.Lazy import qualified Data.Text import qualified Data.Text.IO +import qualified Dhall.Binary import qualified Dhall.Parser import qualified Test.Tasty import qualified Test.Tasty.HUnit @@ -167,11 +170,19 @@ tests = ] shouldParse :: Text -> FilePath -> TestTree -shouldParse name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) (do - text <- Data.Text.IO.readFile (path <> "A.dhall") - case Dhall.Parser.exprFromText mempty text of - Left err -> Control.Exception.throwIO err - Right _ -> return () ) +shouldParse name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do + text <- Data.Text.IO.readFile (path <> "A.dhall") + encoded <- Data.ByteString.Lazy.readFile (path <> "B.dhallb") + + expression <- case Dhall.Parser.exprFromText mempty text of + Left e -> Control.Exception.throwIO e + Right a -> pure a + + let term = Dhall.Binary.encode expression + bytes = Codec.Serialise.serialise term + + let message = "The expected CBOR representation doesn't match the actual one" + Test.Tasty.HUnit.assertEqual message encoded bytes shouldNotParse :: Text -> FilePath -> TestTree shouldNotParse name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) (do