diff --git a/tests/TAP.idr b/tests/TAP.idr index 647f229..7d97c90 100644 --- a/tests/TAP.idr +++ b/tests/TAP.idr @@ -51,7 +51,17 @@ export Show a => ToInfo (List (String, a)) where toInfo = map (map show) export -data Test = One TestBase | Group String (List Test) +data Test += One TestBase +| Group String (List Test) +| Note String + + +export +isRealTest : Test -> Bool +isRealTest (One _) = True +isRealTest (Group _ _) = True +isRealTest (Note _) = False private @@ -89,6 +99,7 @@ export skipWith : Test -> String -> Test skipWith (One t) reason = makeSkip t.label reason skipWith (Group l _) reason = makeSkip l reason +skipWith (Note n) _ = Note n export skip : Test -> Test @@ -113,11 +124,17 @@ bailOut = One $ MakeTest "bail out" $ do putStrLn "Bail out!" exitFailure +export +note : String -> Test +note = Note + export -header : List a -> String -header tests = "1..\{show $ length tests}" +header : List Test -> String +header tests = + let count = length $ filter isRealTest tests in + "1..\{show count}" private makePrefix : SnocList String -> String @@ -138,6 +155,7 @@ mutual flatten1With : SnocList String -> Test -> List Test flatten1With pfx (One t) = [withPrefix pfx t] flatten1With pfx (Group x ts) = flattenWith (pfx :< x) ts + flatten1With pfx (Note n) = [Note n] export flatten : List Test -> List Test @@ -174,11 +192,13 @@ toBool _ = True private -numbered : List a -> List (Nat, a) -numbered = go 1 where +numbered : (a -> Bool) -> List a -> List (Nat, a) +numbered p = go 1 where go : Nat -> List a -> List (Nat, a) go _ [] = [] - go i (x :: xs) = (i, x) :: go (S i) xs + go i (x :: xs) = + if p x then (i, x) :: go (S i) xs + else (0, x) :: go i xs private @@ -230,12 +250,16 @@ mutual res <- local {indent $= plus 4} $ runList tests putOk res index label pure res + run' (_, Note note) = do + putIndentLines [!(col Magenta "# ") ++ note] + pure True private runList : List Test -> Runner Bool runList tests = do putColor Cyan $ header tests - all id <$> traverse (\t => run' (assert_smaller tests t)) (numbered tests) + let tests' = numbered isRealTest tests + all id <$> traverse (\t => run' (assert_smaller tests t)) tests' mutual @@ -254,6 +278,7 @@ mutual case filterMatch (Just pat) tests of [] => Nothing res => Just $ Group label res + filterMatch1 pat note@(Note _) = Just note export