mirror of
https://github.com/mrdomino/hsnock.git
synced 2024-09-17 16:58:00 +03:00
58 lines
1.8 KiB
Haskell
58 lines
1.8 KiB
Haskell
import Control.Applicative
|
|
import qualified Control.Exception as C
|
|
import Language.Nock5K
|
|
import Test.Framework
|
|
import Test.Framework.Providers.HUnit
|
|
import Test.Framework.Providers.QuickCheck2
|
|
import Test.HUnit
|
|
import Test.QuickCheck
|
|
import Text.ParserCombinators.Parsec (parse)
|
|
import Text.Printf
|
|
|
|
instance Arbitrary Noun where
|
|
arbitrary = choose (0, 32) >>= arbD
|
|
where
|
|
arbD :: Int -> Gen Noun
|
|
arbD 0 = (Atom . abs) <$> arbitrary
|
|
arbD n = do coin <- arbitrary
|
|
if coin
|
|
then arbD 0
|
|
else (:-) <$> arbD (n - 1) <*> arbD (n - 1)
|
|
|
|
pn n = case parse noun "" n of Right n -> n
|
|
|
|
prop_parse_show n = n == (pn . show) n
|
|
|
|
prop_dec a' = nock (Atom (a + 1) :- dec) == (Right $ Atom a)
|
|
where
|
|
ds = "[8 [1 0] 8 [1 6 [5 [0 7] 4 0 6] [0 6] 9 2 [0 2] [4 0 6] 0 7] 9 2 0 1]"
|
|
dec = pn ds
|
|
a = abs a'
|
|
|
|
prop_6_is_if a' b = nock (ifs $ Atom 0) == Right (Atom (a + 1)) && nock (ifs $ Atom 1) == Right b
|
|
where
|
|
ifs c = Atom a :- Atom 6 :- (Atom 1 :- c) :- (Atom 4 :- Atom 0 :- Atom 1) :- (Atom 1 :- b)
|
|
a = abs a'
|
|
|
|
prop_fas_induct a' b = fas (a + a) b == fasmn 2 a b && fas (a + a + 1) b == fasmn 3 a b
|
|
where fas c d = nock $ d :- Atom c
|
|
fasmn m n c = do x <- fas n c
|
|
fas m x
|
|
a = abs a'
|
|
|
|
test_hint_crash = assert $ nock bad == Left "/a"
|
|
where bad = pn "[42 10 [0 0 2] 0 1]"
|
|
|
|
test_eval_strict = assert $ nock bad == Left "/a"
|
|
where bad = pn "[0 2 [0 2] 1 1 42]"
|
|
|
|
tests = [ testProperty "parse.show" prop_parse_show
|
|
, testProperty "decrement" prop_dec
|
|
, testProperty "6_is_if" prop_6_is_if
|
|
, testProperty "fas_induct" prop_fas_induct
|
|
, testCase "10_hint_crash" test_hint_crash
|
|
, testCase "eval_strict" test_eval_strict
|
|
]
|
|
|
|
main = defaultMain tests
|