rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

some refactoring in tests

Browse source
This commit is contained in:
rhiannon morris 2024-05-28 18:39:21 +02:00
parent 2bfe3250cf
commit 3ab8669404
1 changed files with 24 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
tests/Tests/FromPTerm.idr
View file

@ -16,10 +16,13 @@ import Derive.Prelude
%hide TParser.Failure %hide TParser.Failure
%hide TParser.ExpectedFail %hide TParser.ExpectedFail
PError = Parser.Error
FPError = FromParser.Error
public export public export
data Failure = data Failure =
ParseError Parser.Error ParseError PError
| FromParser FromParser.Error | FromParser FPError
| WrongResult String | WrongResult String
| ExpectedFail String | ExpectedFail String
@ -39,42 +42,33 @@ ToInfo Failure where
parameters {c : Bool} {auto _ : Show b} parameters {c : Bool} {auto _ : Show b}
(grm : FileName -> Grammar c a) (grm : FileName -> Grammar c a)
(fromP : a -> Either FromParser.Error b) (fromP : a -> Either FPError b)
(inp : String) (inp : String)
parameters {default (ltrim inp) label : String} parsesWith : String -> (b -> Bool) -> Test
parsesWith : (b -> Bool) -> Test parsesWith label p = test label $ do
parsesWith p = test label $ do
pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
res <- mapFst FromParser $ fromP pres res <- mapFst FromParser $ fromP pres
unless (p res) $ Left $ WrongResult $ show res unless (p res) $ Left $ WrongResult $ show res
parses : Test
parses = parsesWith $ const True
%macro %macro
parseMatch : TTImp -> Elab Test parseMatch : {default (ltrim inp) label : String} -> TTImp -> Elab Test
parseMatch pat = parseMatch {label} pat =
parsesWith <$> check `(\case ~(pat) => True; _ => False) parsesWith label <$> check `(\case ~(pat) => True; _ => False)
parsesAs : Eq b => b -> Test parseFails : {default "\{ltrim inp} # fails" label : String} -> Test
parsesAs exp = parsesWith (== exp) parseFails {label} = test label $ do
parameters {default "\{ltrim inp} # fails" label : String}
parseFails : Test
parseFails = test label $ do
pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
runFromParser : {default empty defs : Definitions} -> runFromParser : Definitions -> Eff FromParserPure a -> Either FPError a
Eff FromParserPure a -> Either FromParser.Error a runFromParser defs = map val . fromParserPure [<] 0 defs initStack
runFromParser = map val . fromParserPure [<] 0 defs initStack
export export
tests : Test tests : Test
tests = "PTerm → Term" :- [ tests = "PTerm → Term" :- [
"dimensions" :- "dimensions" :-
let fromPDim = runFromParser . fromPDimWith [< "𝑖", "𝑗"] let fromPDim = runFromParser empty . fromPDimWith [< "𝑖", "𝑗"]
in [ in [
note "dim ctx: [𝑖, 𝑗]", note "dim ctx: [𝑖, 𝑗]",
parseMatch dim fromPDim "𝑖" `(B (VS VZ) _), parseMatch dim fromPDim "𝑖" `(B (VS VZ) _),
@ -87,7 +81,7 @@ tests = "PTerm → Term" :- [
"terms" :- "terms" :-
let defs = fromList [("f", mkDef GAny (^NAT) (^Zero))] let defs = fromList [("f", mkDef GAny (^NAT) (^Zero))]
-- doesn't have to be well typed yet, just well scoped -- doesn't have to be well typed yet, just well scoped
fromPTerm = runFromParser {defs} . fromPTerm = runFromParser defs .
fromPTermWith [< "𝑖", "𝑗"] [< "A", "x", "y", "z"] fromPTermWith [< "𝑖", "𝑗"] [< "A", "x", "y", "z"]
in [ in [
note "dim ctx: [𝑖, 𝑗]; term ctx: [A, x, y, z]", note "dim ctx: [𝑖, 𝑗]; term ctx: [A, x, y, z]",