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