Skip to content

Commit

Permalink
tests: improve expectFailForPaths (#46)
Browse files Browse the repository at this point in the history
* Move `expectFailForPaths` from Test/Parsing.hs to Test/Util.hs
* Move `parseAndCheck` from Test/Util.hs to Test/Checking.hs
* expectFailForPaths now checks that paths actually exist...
* ...so remove a couple that didn't!
  • Loading branch information
acl-cqc authored Oct 29, 2024
1 parent 96cb8bc commit cea653c
Show file tree
Hide file tree
Showing 6 changed files with 36 additions and 30 deletions.
22 changes: 17 additions & 5 deletions brat/test/Test/Checking.hs
Original file line number Diff line number Diff line change
@@ -1,19 +1,31 @@
module Test.Checking (getCheckingTests, expectedCheckingFails) where
module Test.Checking (parseAndCheck, getCheckingTests, expectedCheckingFails) where

import Test.Parsing (expectedParsingFails, expectFailForPaths)
import Test.Util (parseAndCheck)
import Brat.Load
import Brat.Naming (root)
import Test.Parsing (expectedParsingFails)
import Test.Util (expectFailForPaths)

import Control.Monad.Except
import System.FilePath
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Silver

expectedCheckingFails = map ("examples" </>) ["nested-abstractors.brat"
,"karlheinz_alias.brat"
,"hea.brat"
]

parseAndCheckXF :: FilePath -> TestTree
parseAndCheckXF :: [FilePath] -> [TestTree]
parseAndCheckXF = expectFailForPaths (expectedParsingFails ++ expectedCheckingFails) (parseAndCheck [])

getCheckingTests :: IO TestTree
getCheckingTests = testGroup "checking" . fmap parseAndCheckXF <$> findByExtension [".brat"] "examples"
getCheckingTests = testGroup "checking" . parseAndCheckXF <$> findByExtension [".brat"] "examples"

parseAndCheck :: [FilePath] -> FilePath -> TestTree
parseAndCheck libDirs file = testCase (show file) $ do
env <- runExceptT $ loadFilename root libDirs file
case env of
Left err -> assertFailure (show err)
Right (venv, nouns, holes, _, _) ->
((length venv) + (length nouns) + (length holes) > 0) @? "Should produce something"
10 changes: 3 additions & 7 deletions brat/test/Test/Compile/Hugr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,8 @@ module Test.Compile.Hugr where

import Brat.Compiler (compileFile, CompilingHoles(..))
import Test.Checking (expectedCheckingFails)
import Test.Parsing (expectedParsingFails, expectFailForPaths)
import Test.Parsing (expectedParsingFails)
import Test.Util (expectFailForPaths)

import qualified Data.ByteString.Lazy as BS
import System.Directory (createDirectoryIfMissing)
Expand Down Expand Up @@ -34,12 +35,7 @@ nonCompilingExamples = (expectedCheckingFails ++ expectedParsingFails ++
,"let"
,"patterns"
,"qft"
,"test"
,"fanout" -- Contains Selectors
-- Conjecture: These examples don't compile because number patterns in type
-- signatures causes `kindCheck` to call `abstract`, creating "Selector"
-- nodes, which we don't attempt to compile because we want to get rid of them
,"vec-pats"
-- Victims of #13
,"arith"
,"cqcconf"
Expand Down Expand Up @@ -67,6 +63,6 @@ setupCompilationTests = do
examples <- findByExtension [".brat"] examplesPrefix
createDirectoryIfMissing False outputDir
let compileTests = compileToOutput <$> tests
let examplesTests = testGroup "examples" $ expectFailForPaths nonCompilingExamples compileToOutput <$> examples
let examplesTests = testGroup "examples" $ expectFailForPaths nonCompilingExamples compileToOutput examples

pure $ testGroup "compilation" (examplesTests:compileTests)
4 changes: 2 additions & 2 deletions brat/test/Test/Failure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ import System.IO.Silently
import Data.Text (pack)

import Brat.Compiler
import Test.Parsing (expectFailForPaths)
import Test.Util (expectFailForPaths)

goldenTest file = goldenVsAction (takeBaseName file) (file <.> "golden") (runGetStderr file $ compileAndPrintFile [] file) pack

Expand All @@ -31,7 +31,7 @@ getBindingTests :: IO TestTree
getBindingTests = testGroup "binding" . fmap goldenTest <$> findByExtension [".brat"] "test/golden/binding"

getErrorTests :: IO TestTree
getErrorTests = testGroup "error" . fmap (expectFailForPaths ["test/golden/error/unreachablebranch.brat"] goldenTest) <$> findByExtension [".brat"] "test/golden/error"
getErrorTests = testGroup "error" . expectFailForPaths ["test/golden/error/unreachablebranch.brat"] goldenTest <$> findByExtension [".brat"] "test/golden/error"

runGetStderr :: String -> IO () -> IO String
runGetStderr name action = do
Expand Down
2 changes: 1 addition & 1 deletion brat/test/Test/Libs.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
module Test.Libs where

import Test.Util
import Test.Checking (parseAndCheck)

import Test.Tasty

Expand Down
9 changes: 3 additions & 6 deletions brat/test/Test/Parsing.hs
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
module Test.Parsing (getParsingTests, expectedParsingFails, expectFailForPaths) where
module Test.Parsing (getParsingTests, expectedParsingFails) where

import Brat.Load

import System.FilePath
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Silver
import Test.Tasty.ExpectedFailure
import Test.Util (expectFailForPaths)

testParse :: FilePath -> TestTree
testParse file = testCase (show file) $ do
Expand All @@ -19,10 +19,7 @@ expectedParsingFails = map ("examples" </>) [
"karlheinz.brat",
"thin.brat"]

expectFailForPaths :: [FilePath] -> (FilePath -> TestTree) -> FilePath -> TestTree
expectFailForPaths xf f path = (if path `elem` xf then expectFail else id) $ f path

parseXF = expectFailForPaths expectedParsingFails testParse

getParsingTests :: IO TestTree
getParsingTests = testGroup "parsing" . fmap parseXF <$> findByExtension [".brat"] "examples"
getParsingTests = testGroup "parsing" . parseXF <$> findByExtension [".brat"] "examples"
19 changes: 10 additions & 9 deletions brat/test/Test/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,12 @@ import Brat.Checker.Monad
import Brat.Checker.Types (initStore, emptyEnv)
import Brat.Error
import Brat.FC
import Brat.Load
import Brat.Naming

import Control.Monad.Except
import qualified Data.Set as S
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.ExpectedFailure

runEmpty m = run emptyEnv initStore root m

Expand All @@ -19,10 +19,11 @@ assertChecking m = case runEmpty $ localFC (FC (Pos 0 0) (Pos 0 0)) m of
Right _ -> pure ()
Left err -> assertFailure (showError err)

parseAndCheck :: [FilePath] -> FilePath -> TestTree
parseAndCheck libDirs file = testCase (show file) $ do
env <- runExceptT $ loadFilename root libDirs file
case env of
Left err -> assertFailure (show err)
Right (venv, nouns, holes, _, _) ->
((length venv) + (length nouns) + (length holes) > 0) @? "Should produce something"
expectFailForPaths :: [FilePath] -> (FilePath -> TestTree) -> [FilePath] -> [TestTree]
expectFailForPaths xf makeTest paths = if S.null not_found then tests else
error $ "Tried to XFAIL non-existent tests " ++ show not_found
where
f :: FilePath -> ([TestTree], S.Set FilePath) -> ([TestTree], S.Set FilePath)
f path (ts, remaining_xfs) = let newTest = (if S.member path remaining_xfs then expectFail else id) $ makeTest path
in (newTest:ts, S.delete path remaining_xfs)
(tests, not_found) = foldr f ([], S.fromList xf) paths

0 comments on commit cea653c

Please sign in to comment.