diff --git a/tests/Makefile b/tests/Makefile index c0de71e..c757352 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -8,10 +8,18 @@ depends/quox: lib mkdir -p depends ln -sf ../../build/ttc depends/quox -.PHONY: test -test: depends/quox +.PHONY: build-tests +build-tests: depends/quox idris2 --build tests.ipkg - build/exec/quox-tests + +.PHONY: test +test: build-tests + build/exec/quox-tests -V 14 + +.PHONY: prove +prove: build-tests + prove build/exec/quox-tests + .PHONY: clean clean: diff --git a/tests/Options.idr b/tests/Options.idr new file mode 100644 index 0000000..5336560 --- /dev/null +++ b/tests/Options.idr @@ -0,0 +1,40 @@ +module Options + +import Data.String +import System +import System.Console.GetOpt + + +public export +record Options where + constructor Opts + tapVersion : String + +defaultOpts = Opts {tapVersion = "13"} + +OptMod = Options -> Options + +opts : List (OptDescr OptMod) +opts = [ + MkOpt ['V'] ["version"] + (ReqArg (\v => the OptMod {tapVersion := v}) "VERSION") + "TAP version to output (13 or 14, default 13)" +] +-- [todo] get rid of "the OptMod" when type inference is better, maybe + +makeOpts : List OptMod -> Options +makeOpts = foldl (flip ($)) defaultOpts + + +getArgs1 : IO (List String) +getArgs1 = + case !getArgs of + _ :: args => pure args + [] => die "expecting getArgs to start with exe name" + +export +getTestOpts : IO Options +getTestOpts = + case getOpt Permute opts !getArgs1 of + MkResult opts [] [] [] => pure $ makeOpts opts + res => die $ unlines $ res.errors ++ [usageInfo "quox test suite" opts] diff --git a/tests/TAP.idr b/tests/TAP.idr index 17acddf..5316ce2 100644 --- a/tests/TAP.idr +++ b/tests/TAP.idr @@ -116,6 +116,31 @@ export %inline header : List a -> String header tests = "1..\{show $ length tests}" +makePrefix : SnocList String -> String +makePrefix [<] = "" +makePrefix (xs :< x) = foldr (\a, b => "\{a}/\{b}") x xs + +withPrefix : SnocList String -> TestBase -> Test +withPrefix pfx b = One $ {label := "[\{makePrefix pfx}] \{b.label}"} b + +mutual + export + flattenWith : SnocList String -> List Test -> List Test + flattenWith pfx = concatMap (flatten1With pfx) + + export + flatten1With : SnocList String -> Test -> List Test + flatten1With pfx (One t) = [withPrefix pfx t] + flatten1With pfx (Group x ts) = flattenWith (pfx :< x) ts + +export +flatten : List Test -> List Test +flatten = flattenWith [<] + +export +flatten1 : Test -> List Test +flatten1 = flatten1With [<] + private Runner : Type -> Type @@ -174,9 +199,17 @@ mutual export -run : List Test -> IO ExitCode -run tests = do - putStrLn "TAP version 14" +run : (ver : Nat) -> List Test -> IO ExitCode +run ver tests = do + putStrLn "TAP version \{show ver}" pure $ if !(runReaderT 0 $ runList tests) then ExitSuccess else ExitFailure 70 + +export +main : List Test -> IO () +main tests = exitWith !(run 14 tests) + +export +mainFlat : List Test -> IO () +mainFlat tests = exitWith !(run 13 $ flatten tests) diff --git a/tests/Tests.idr b/tests/Tests.idr index 393c11a..783968a 100644 --- a/tests/Tests.idr +++ b/tests/Tests.idr @@ -1,11 +1,18 @@ module Tests -import Tests.Equal - +import Options import TAP - +import Tests.Lexer +import Tests.Equal import System -export main : IO Int -main = exitWith =<< run - [Equal.tests] + +allTests = [Equal.tests] + +main = do + opts <- getTestOpts + go <- case opts.tapVersion of + "13" => pure TAP.mainFlat + "14" => pure TAP.main + _ => die "unrecognised TAP version; use 13 or 14" + go allTests