Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added SmallCheck tests for pretty-printing and parsing combination. F…

…ixed pretty-printing bug
  • Loading branch information...
commit b25c864d2953290ca0590fc0604ca10f06f71f6a 1 parent b46b0e7
@sphynx authored
Showing with 45 additions and 11 deletions.
  1. +6 −8 fulluntyped/Pretty.hs
  2. +39 −3 fulluntyped/Tests.hs
View
14 fulluntyped/Pretty.hs
@@ -30,17 +30,15 @@ pretty = render . go maxDepth where
go d t = case t of
Abs v t1 ->
lambda <> text v <> dot <> go' t1
- App t1 t2@(App {}) ->
- go' t1 <+> parens (go' t2)
- App t1@(Abs {}) t2@(Abs {}) ->
+ App t1@(Abs {}) t2@(Var {}) -> --- abs var
+ parens (go' t1) <+> go' t2
+ App t1@(Abs {}) t2 -> -- abs _
parens (go' t1) <+> parens (go' t2)
- App t1@(Var {}) t2@(Abs {}) ->
+ App t1 t2@(App {}) -> -- _ app
go' t1 <+> parens (go' t2)
- App t1@(App {}) t2@(Abs {}) ->
+ App t1 t2@(Abs {}) -> --- var abs
go' t1 <+> parens (go' t2)
- App t1@(Abs {}) t2 ->
- parens (go' t1) <+> go' t2
- App t1 t2 ->
+ App t1 t2 -> --- _ _
go' t1 <+> go' t2
_ ->
-- this is here to please "-Wall"
View
42 fulluntyped/Tests.hs
@@ -9,21 +9,30 @@ To run tests try `make test`.
-}
+{-# LANGUAGE FlexibleInstances #-}
+
module Tests where
-import Test.Framework (defaultMain, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.SmallCheck
import Test.HUnit
+import Test.SmallCheck
+import Test.SmallCheck.Series
+
import Pretty
import Parser
+import Types
+import Interpreter hiding (main)
main :: IO ()
main = defaultMain tests
tests =
- [ testGroup "Pretty printing tests" prettyTests
+ [ testGroup "Pretty printing unit tests" prettyTests,
+ testGroup "Properties" smallCheckTests
]
prettyTests = map (uncurry mkTestCase)
@@ -43,6 +52,8 @@ prettyTests = map (uncurry mkTestCase)
, identical "(\\x.x y) z"
, identical "x (\\y.y)"
, identical "x y (\\y.y)"
+ , identical "x ((\\x.x) (x x))"
+
, ("(x)", "x")
, ("(x y)", "x y")
, ("(((x y)))", "x y")
@@ -59,3 +70,28 @@ prettyTests = map (uncurry mkTestCase)
mkTestCase inp exp =
testCase ("pretty-printing " ++ inp) $
pretty (parseExpr inp) @?= exp
+
+
+newtype VarName = VarName Name
+
+var :: VarName -> Term
+var (VarName v) = Var v
+
+abstr :: VarName -> Term -> Term
+abstr (VarName v) = Abs v
+
+instance Serial VarName where
+ series = const [VarName [c] | c <- "xy"]
+ coseries = undefined
+
+instance Serial (Expr Name) where
+ series = cons1 var
+ \/ cons2 abstr
+ \/ cons2 App
+ coseries = undefined
+
+smallCheckTests = [
+ withDepth 4 $ testProperty "(parse . pretty) should be id"
+ $ (\t -> parseExpr (pretty t) == t )
+
+ ]
Please sign in to comment.
Something went wrong with that request. Please try again.