Compare commits
7 commits
d28366c90b
...
66c96cb3c4
Author | SHA1 | Date | |
---|---|---|---|
66c96cb3c4 | |||
a690ca1277 | |||
d062f79176 | |||
d74b056e11 | |||
bcd4544692 | |||
7629404097 | |||
64fe3a5a0f |
4 changed files with 44 additions and 18 deletions
14
quox.ipkg
14
quox.ipkg
|
@ -15,6 +15,20 @@ modules =
|
||||||
Quox.Pretty,
|
Quox.Pretty,
|
||||||
|
|
||||||
Quox.Syntax,
|
Quox.Syntax,
|
||||||
|
Quox.Syntax.Dim,
|
||||||
|
Quox.Syntax.DimEq,
|
||||||
|
Quox.Syntax.Qty,
|
||||||
|
Quox.Syntax.Shift,
|
||||||
|
Quox.Syntax.Subst,
|
||||||
|
Quox.Syntax.Term,
|
||||||
|
Quox.Syntax.Term.Base,
|
||||||
|
Quox.Syntax.Term.Pretty,
|
||||||
|
Quox.Syntax.Term.Reduce,
|
||||||
|
Quox.Syntax.Term.Split,
|
||||||
|
Quox.Syntax.Term.Subst,
|
||||||
|
Quox.Syntax.Universe,
|
||||||
|
Quox.Syntax.Var,
|
||||||
|
|
||||||
Quox.Context,
|
Quox.Context,
|
||||||
Quox.Equal,
|
Quox.Equal,
|
||||||
Quox.Name,
|
Quox.Name,
|
||||||
|
|
|
@ -10,6 +10,8 @@ import Quox.Error
|
||||||
public export
|
public export
|
||||||
data Mode = Equal | Sub
|
data Mode = Equal | Sub
|
||||||
|
|
||||||
|
export %inline Show Mode where show Equal = "Equal"; show Sub = "Sub"
|
||||||
|
|
||||||
public export
|
public export
|
||||||
data Error
|
data Error
|
||||||
= ClashT Mode (Term d n) (Term d n)
|
= ClashT Mode (Term d n) (Term d n)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Quox.Error
|
module Quox.Error
|
||||||
|
|
||||||
import Data.List.Elem
|
import public Data.List.Elem
|
||||||
|
|
||||||
import public Control.Monad.Identity
|
import public Control.Monad.Identity
|
||||||
import Control.Monad.Trans
|
import Control.Monad.Trans
|
||||||
|
|
|
@ -6,8 +6,10 @@ import Data.String
|
||||||
import Data.List.Elem
|
import Data.List.Elem
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import System
|
||||||
|
|
||||||
public export Info : Type
|
public export
|
||||||
|
Info : Type
|
||||||
Info = List (String, String)
|
Info = List (String, String)
|
||||||
|
|
||||||
private
|
private
|
||||||
|
@ -20,13 +22,19 @@ record TestBase where
|
||||||
run : IO Result
|
run : IO Result
|
||||||
|
|
||||||
|
|
||||||
|
private
|
||||||
|
toLines1 : (String, String) -> List String
|
||||||
|
toLines1 (k, v) =
|
||||||
|
let vs = lines v in
|
||||||
|
if length vs == 1
|
||||||
|
then ["\{k}: \{v}"]
|
||||||
|
else "\{k}: |" :: map (indent 2) vs
|
||||||
|
|
||||||
private
|
private
|
||||||
toLines : Info -> List String
|
toLines : Info -> List String
|
||||||
toLines [] = []
|
toLines [] = []
|
||||||
toLines xs =
|
toLines xs = "---" :: concatMap toLines1 xs <+> ["..."]
|
||||||
"---" ::
|
|
||||||
concatMap (\(k, v) => "\{k}: |" :: map (indent 2) (lines v)) xs
|
|
||||||
<+> ["..."]
|
|
||||||
|
|
||||||
public export interface ToInfo e where toInfo : e -> Info
|
public export interface ToInfo e where toInfo : e -> Info
|
||||||
|
|
||||||
|
@ -35,7 +43,7 @@ All ToInfo es => ToInfo (OneOf es) where
|
||||||
toInfo (One Here value) = toInfo value
|
toInfo (One Here value) = toInfo value
|
||||||
toInfo (One (There x) value) = toInfo (One x value)
|
toInfo (One (There x) value) = toInfo (One x value)
|
||||||
|
|
||||||
export ToInfo () where toInfo () = []
|
export %inline ToInfo () where toInfo () = []
|
||||||
|
|
||||||
export
|
export
|
||||||
data Test = One TestBase | Group String (List Test)
|
data Test = One TestBase | Group String (List Test)
|
||||||
|
@ -76,7 +84,7 @@ export %inline
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
export
|
export %inline
|
||||||
header : List a -> String
|
header : List a -> String
|
||||||
header tests = "1..\{show $ length tests}"
|
header tests = "1..\{show $ length tests}"
|
||||||
|
|
||||||
|
@ -85,15 +93,15 @@ private
|
||||||
Runner : Type -> Type
|
Runner : Type -> Type
|
||||||
Runner = ReaderT Nat IO
|
Runner = ReaderT Nat IO
|
||||||
|
|
||||||
private
|
private %inline
|
||||||
putIndentLines : List String -> Runner ()
|
putIndentLines : List String -> Runner ()
|
||||||
putIndentLines xs = traverse_ (putStrLn . indent !ask) xs
|
putIndentLines xs = traverse_ (putStrLn . indent !ask) xs
|
||||||
|
|
||||||
private
|
private %inline
|
||||||
isOk : Bool -> String
|
isOk : Bool -> String
|
||||||
isOk b = if b then "ok" else "not ok"
|
isOk b = if b then "ok" else "not ok"
|
||||||
|
|
||||||
private
|
private %inline
|
||||||
toBool : Result -> Bool
|
toBool : Result -> Bool
|
||||||
toBool (Tried ok _) = ok
|
toBool (Tried ok _) = ok
|
||||||
toBool _ = True
|
toBool _ = True
|
||||||
|
@ -111,12 +119,12 @@ run1' : (Nat, TestBase) -> Runner Bool
|
||||||
run1' (index, test) = do
|
run1' (index, test) = do
|
||||||
res <- liftIO test.run
|
res <- liftIO test.run
|
||||||
case res of
|
case res of
|
||||||
Tried ok info => putIndentLines $
|
Tried ok info => do
|
||||||
"\{isOk ok} \{show index} - \{test.label}" ::
|
putIndentLines ["\{isOk ok} \{show index} - \{test.label}"]
|
||||||
toLines info
|
local (plus 2) $ putIndentLines $ toLines info
|
||||||
Skip reason => putIndentLines $
|
Skip reason => putIndentLines
|
||||||
["ok \{show index} - \{test.label} # skip \{reason}"]
|
["ok \{show index} - \{test.label} # skip \{reason}"]
|
||||||
Todo reason => putIndentLines $
|
Todo reason => putIndentLines
|
||||||
["ok \{show index} - \{test.label} # todo \{reason}"]
|
["ok \{show index} - \{test.label} # todo \{reason}"]
|
||||||
pure $ toBool res
|
pure $ toBool res
|
||||||
|
|
||||||
|
@ -138,7 +146,9 @@ mutual
|
||||||
|
|
||||||
|
|
||||||
export
|
export
|
||||||
run : List Test -> IO ()
|
run : List Test -> IO ExitCode
|
||||||
run tests = do
|
run tests = do
|
||||||
putStrLn "TAP version 14"
|
putStrLn "TAP version 14"
|
||||||
ignore $ runReaderT 0 $ runList tests
|
pure $ if !(runReaderT 0 $ runList tests)
|
||||||
|
then ExitSuccess
|
||||||
|
else ExitFailure 70
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue