diff --git a/.known-issues b/.known-issues new file mode 100644 index 00000000..71cb2c9c --- /dev/null +++ b/.known-issues @@ -0,0 +1,8 @@ +frontend/tests/cases/positive/indexed/infer-kinds.gr #299 +frontend/tests/cases/positive/security/level_pos3.gr #314 +frontend/tests/cases/rewrite/split-in-box.gr #313 +frontend/tests/cases/synthesis/graded-base/list/drop.gr #281 +frontend/tests/cases/synthesis/graded-base/misc/either.gr #281 +examples/effects_nondet.gr #312 +examples/effects_state.gr #312 +frontend/tests/cases/positive/effect-handlers/effects_state.gr #312 diff --git a/granule.cabal b/granule.cabal index cb917d46..0cb15444 100644 --- a/granule.cabal +++ b/granule.cabal @@ -277,6 +277,7 @@ test-suite gr-golden , strict , tasty , tasty-golden + , tasty-expected-failure -- Executables -- diff --git a/interpreter/tests/Golden.hs b/interpreter/tests/Golden.hs index fc8f7f8a..3fd398a8 100644 --- a/interpreter/tests/Golden.hs +++ b/interpreter/tests/Golden.hs @@ -3,11 +3,15 @@ import Control.Monad (unless) import Data.Algorithm.Diff (getGroupedDiff) import Data.Algorithm.DiffOutput (ppDiff) import Data.List (sort, isInfixOf) +import qualified Data.Map as M +import Data.Maybe (mapMaybe) import Data.Functor((<&>)) import Test.Tasty (defaultMain, TestTree, testGroup) +import Test.Tasty.ExpectedFailure (expectFailBecause) import Test.Tasty.Golden (goldenVsFile) import qualified Test.Tasty.Golden as G import Test.Tasty.Golden.Advanced (goldenTest) +import Test.Tasty.Runners (TestTree(..)) import System.Directory (renameFile, doesFileExist) import System.Exit (ExitCode) import System.FilePath (dropExtension, pathSeparator) @@ -33,6 +37,15 @@ main = do putStrLn $ "\nExcluding directories: " ++ show (lines excludesData) ++ "\n" return $ Right $ IncludeAll (foldr Exclude Nil (lines excludesData)) else return $ Right (IncludeAll Nil) + + knownIssuesQuery <- doesFileExist ".known-issues" + knownIssues <- + if knownIssuesQuery + then do + issuesData <- readFile ".known-issues" + return $ parseKnownIssues issuesData + else return M.empty + case configE of Left error -> do putStrLn $ "Error in test arguments: " <> error @@ -42,8 +55,9 @@ main = do rewrite <- goldenTestsRewrite config synthesis <- goldenTestsSynthesis config + let tests = testGroup "Golden tests" [negative, positive, rewrite, synthesis] catch - (defaultMain $ testGroup "Golden tests" [negative, positive, rewrite, synthesis]) + (defaultMain $ wrapKnownIssues knownIssues tests) (\(e :: ExitCode) -> do -- Move all of the backup files back to their original place. backupFiles <- findByExtension config [".bak"] "frontend/tests/cases/rewrite" @@ -53,6 +67,24 @@ main = do mapM_ (\backup -> renameFile backup (dropExtension backup)) backupFiles throwIO e ) + where + parseKnownIssues :: String -> M.Map FilePath String + parseKnownIssues content = + M.fromList (mapMaybe parseLine (lines content)) + where + parseLine line = case words line of + [path, issue] -> Just (path, issue) + _ -> Nothing + + wrapKnownIssues :: M.Map FilePath String -> TestTree -> TestTree + wrapKnownIssues issues tree = case tree of + SingleTest name test -> + case M.lookup name issues of + Just issue -> expectFailBecause issue tree + Nothing -> tree + TestGroup name trees -> + TestGroup name (map (wrapKnownIssues issues) trees) + _ -> tree -- we don't use the other constructors -- Applies a configuration to list of filepaths applyConfig :: Config -> [FilePath] -> [FilePath] @@ -259,4 +291,4 @@ runTestsAndCleanUp tests = do when (null contents) (removeFile outfile) throwIO e) --} \ No newline at end of file +-}