f24f665047
`dhall lint` would fail on the following expression:
```
let replicate = https://prelude.dhall-lang.org/List/replicate
in let Config = { name : Text, age : Natural }
in let Configs = List Config
in replicate 10 Text "!"
```
... because the code (incorrectly) assumed that simplifying an inner
`let` binding would preserve at least one `let` binding. However, when the
outer `let` (beginning with `let replicate`) is simplified the inner `let`
(beginning with `let Config`) simplifies down to just `replicate 10 Text "!"`
which has no `let` binding at all, leading to a pattern match failure.
This change fixes that by extending the code to correctly handle that case
with an exhaustive pattern match.
62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Dhall.Test.Lint where
|
|
|
|
import Data.Monoid (mempty, (<>))
|
|
import Data.Text (Text)
|
|
import Test.Tasty (TestTree)
|
|
|
|
import qualified Control.Exception
|
|
import qualified Data.Text
|
|
import qualified Data.Text.IO
|
|
import qualified Dhall.Core
|
|
import qualified Dhall.Import
|
|
import qualified Dhall.Lint
|
|
import qualified Dhall.Parser
|
|
import qualified Test.Tasty
|
|
import qualified Test.Tasty.HUnit
|
|
|
|
tests :: TestTree
|
|
tests =
|
|
Test.Tasty.testGroup "format tests"
|
|
[ should
|
|
"correctly handle multi-let expressions"
|
|
"success/multilet"
|
|
, should
|
|
"not fail when an inner expression removes all `let` bindings"
|
|
"success/regression0"
|
|
]
|
|
|
|
should :: Text -> Text -> TestTree
|
|
should name basename =
|
|
Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do
|
|
let inputFile =
|
|
Data.Text.unpack ("./tests/lint/" <> basename <> "A.dhall")
|
|
let outputFile =
|
|
Data.Text.unpack ("./tests/lint/" <> basename <> "B.dhall")
|
|
|
|
inputText <- Data.Text.IO.readFile inputFile
|
|
|
|
parsedInput <- case Dhall.Parser.exprFromText mempty inputText of
|
|
Left exception -> Control.Exception.throwIO exception
|
|
Right expression -> return expression
|
|
|
|
let lintedInput = Dhall.Lint.lint parsedInput
|
|
|
|
actualExpression <- Dhall.Import.load lintedInput
|
|
|
|
outputText <- Data.Text.IO.readFile outputFile
|
|
|
|
parsedOutput <- case Dhall.Parser.exprFromText mempty outputText of
|
|
Left exception -> Control.Exception.throwIO exception
|
|
Right expression -> return expression
|
|
|
|
resolvedOutput <- Dhall.Import.load parsedOutput
|
|
|
|
let expectedExpression = Dhall.Core.denote resolvedOutput
|
|
|
|
let message =
|
|
"The linted expression did not match the expected output"
|
|
|
|
Test.Tasty.HUnit.assertEqual message expectedExpression actualExpression
|