sexpresso-1.0.0.2: test/SchemeR5RS_Unittests.hs
{-# LANGUAGE OverloadedStrings #-}
module SchemeR5RS_Unittests (
r5rsTestTree
)where
import Data.Void
import qualified Data.Text as T
import Data.Either
import Data.Bifunctor (first)
import Test.Tasty
import Test.Tasty.HUnit
import Text.Megaparsec
--import Text.Megaparsec.Char
import Data.SExpresso.SExpr
import Data.SExpresso.Parse
import Data.SExpresso.Language.SchemeR5RS as R5
type Parser = Parsec Void T.Text
pSExpr :: Parser [SExpr R5.SExprType R5.SchemeToken]
pSExpr = decode R5.sexpr
-- tparse parses the whole input
tparse :: Parser a -> T.Text -> Either String a
tparse p s = first errorBundlePretty $ parse (p <* eof) "" s
r5rsTestTree :: TestTree
r5rsTestTree = testGroup "Language/R5RS.hs" $ [
testGroup "whitespace" $ [
let s = " " in testCase (show s) $ tparse R5.whitespace s @?= Right (),
let s = "\t" in testCase (show s) $ tparse R5.whitespace s @?= Right (),
let s = "\n" in testCase (show s) $ tparse R5.whitespace s @?= Right (),
let s = "\r\n" in testCase (show s) $ tparse R5.whitespace s @?= Right (),
let s = "" in testCase (show s) $ (isLeft $ tparse R5.whitespace s) @? "Parsing must fail on empty input",
let s = "a" in testCase (show s) $ (isLeft $ tparse R5.whitespace s) @? "Parsing must fail on a",
let s = ";" in testCase (show s) $ (isLeft $ tparse R5.whitespace s) @? "Parsing must fail on ;"
],
testGroup "comment" $ [
let s = ";" in testCase (show s) $ tparse R5.comment s @?= Right (),
let s = ";hello world" in testCase (show s) $ tparse R5.comment s @?= Right (),
let s = ";hello\n" in testCase (show s) $ tparse R5.comment s @?= Right (),
let s = ";abcdef\r\n" in testCase (show s) $ tparse R5.comment s @?= Right (),
let s = "" in testCase (show s) $ (isLeft $ tparse R5.comment s) @? "Parsing must fail on empty input",
let s = "a" in testCase (show s) $ (isLeft $ tparse R5.comment s) @? "Parsing must fail on a",
let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.comment s) @? "Parsing must fail on #t"
],
testGroup "interTokenSpace" $ [
let s = ";" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = ";hello world" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = ";hello\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = ";abcdef\r\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = " " in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "\t" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "\r\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = " ;comment\n " in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "\t\n;comment \n " in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "\n\n\n\n\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "\r\n;Hello World" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
let s = "" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right ()
],
testGroup "interTokenSpace1" $ [
let s = ";" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = ";hello world" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = ";hello\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = ";abcdef\r\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = " " in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "\t" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "\r\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = " ;comment\n " in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "\t\n;comment \n " in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "\n\n\n\n\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "\r\n;Hello World" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
let s = "" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on empty input",
let s = "1234" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on 1234",
let s = "a" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on a",
let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on #t"
],
testGroup "character" $ [
let s = "#\\t" in testCase (show s) $ tparse R5.character s @?= Right 't',
let s = "#\\a" in testCase (show s) $ tparse R5.character s @?= Right 'a',
let s = "#\\space" in testCase (show s) $ tparse R5.character s @?= Right ' ',
let s = "#\\newline" in testCase (show s) $ tparse R5.character s @?= Right '\n',
let s = "#\\\n" in testCase (show s) $ tparse R5.character s @?= Right '\n',
let s = "#\\ " in testCase (show s) $ tparse R5.character s @?= Right ' ',
let s = "#\\\t" in testCase (show s) $ tparse R5.character s @?= Right '\t',
let s = "" in testCase (show s) $ (isLeft $ tparse R5.character s) @? "Parsing must fail on empty input",
let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.character s) @? "Parsing must fail on #t",
let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.character s) @? "Parsing must fail on #f"
],
testGroup "boolean" $ [
let s = "#t" in testCase (show s) $ tparse R5.boolean s @?= Right True,
let s = "#f" in testCase (show s) $ tparse R5.boolean s @?= Right False,
let s = "" in testCase (show s) $ (isLeft $ tparse R5.boolean s) @? "Parsing must fail on empty input",
let s = "t" in testCase (show s) $ (isLeft $ tparse R5.boolean s) @? "Parsing must fail on t",
let s = "f" in testCase (show s) $ (isLeft $ tparse R5.boolean s) @? "Parsing must fail on f"
],
testGroup "identifier" $ [
let s = "foo" in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "x2" in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "!hot!" in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "+" in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "-" in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "..." in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "helloWorld" in testCase (show s) $ tparse R5.identifier s @?= Right s,
let s = "" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on empty input",
let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on #t",
let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on #f",
let s = "123" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on 123",
let s = "+123" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on +123",
let s = "-123" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on -123",
let s = "+i" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on +i",
let s = "-i" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on -i"
],
testGroup "string" $ [
let s = "\"abc def ghi\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "abc def ghi",
let s = "\"\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "",
let s = "\"\n\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "\n",
let s = "\" \"" in testCase (show s) $ tparse R5.stringParser s @?= Right " ",
let s = "\"\t\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "\t",
let s = T.pack ['"','\\','\\','"'] in testCase (show s) $ tparse R5.stringParser s @?= Right "\\",
let s = T.pack ['"','\\','"','"'] in testCase (show s) $ tparse R5.stringParser s @?= Right "\"",
let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.stringParser s) @? "Parsing must fail on #t",
let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.stringParser s) @? "Parsing must fail on #f"
],
testGroup "number" $ [
let s = "-1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Minus (UInteger 1))),
let s = "-0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Minus (UInteger 0 ))),
let s = "0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 0))),
let s = "1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "#e1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "#i1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Plus (UInteger 1))),
let s = "#b1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "#o1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "#d1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "#x1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "#xa" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 10))),
let s = "#xb" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 11))),
let s = "#xc" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 12))),
let s = "#xd" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 13))),
let s = "#xe" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 14))),
let s = "#xf" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 15))),
let s = "-0001" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Minus (UInteger 1))),
let s = "-0000" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Minus (UInteger 0))),
let s = "0000" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 0))),
let s = "0001" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 1))),
let s = "-1#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Minus (UIntPounds 1 1))),
let s = "-0#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Minus (UIntPounds 0 1))),
let s = "0#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Plus (UIntPounds 0 1))),
let s = "1#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Plus (UIntPounds 1 1))),
let s = "-1###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Minus (UIntPounds 1 3))),
let s = "-0###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Minus (UIntPounds 0 3))),
let s = "0###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Plus (UIntPounds 0 3))),
let s = "1###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SInteger Plus (UIntPounds 1 3))),
let s = "-12345" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Minus (UInteger 12345))),
let s = "12345" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SInteger Plus (UInteger 12345))),
let s = "-12345/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SRational Minus (UInteger 12345) (UInteger 5))),
let s = "12345/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SRational Plus (UInteger 12345) (UInteger 5))),
let s = "-12345#/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SRational Minus (UIntPounds 12345 1) (UInteger 5))),
let s = "12345/5##" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SRational Plus (UInteger 12345) (UIntPounds 5 2))),
let s = "-12345##/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SRational Minus (UIntPounds 12345 2) (UInteger 5))),
let s = "12345####/5#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SRational Plus (UIntPounds 12345 4) (UIntPounds 5 1))),
let s = "-12345.0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Minus (UInteger 12345) (UInteger 0) Nothing)),
let s = ".0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 0) (UInteger 0) Nothing)),
let s = "0." in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 0) (UInteger 0) Nothing)),
let s = "0.###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 0) (UPounds 3) Nothing)),
let s = "-.569" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Minus (UInteger 0) (UInteger 569) Nothing)),
let s = "-245#." in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Minus (UIntPounds 245 1) (UPounds 0) Nothing)),
let s = "#e-.569" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CReal (SDecimal Minus (UInteger 0) (UInteger 569) Nothing)),
let s = "1e10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 1)
(UInteger 0)
(Just $ Suffix PDefault Plus 10))),
let s = "1e-10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 1)
(UInteger 0)
(Just $ Suffix PDefault Minus 10))),
let s = "1s10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 1)
(UInteger 0)
(Just $ Suffix PShort Plus 10))),
let s = "1f10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 1)
(UInteger 0)
(Just $ Suffix PSingle Plus 10))),
let s = "1d10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 1)
(UInteger 0)
(Just $ Suffix PDouble Plus 10))),
let s = "1l10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CReal (SDecimal Plus (UInteger 1)
(UInteger 0)
(Just $ Suffix PLong Plus 10))),
let s = "1+i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CAbsolute (SInteger Plus (UInteger 1)) (SInteger Plus (UInteger 1))),
let s = "1-i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CAbsolute (SInteger Plus (UInteger 1)) (SInteger Minus (UInteger 1))),
let s = "0.5+i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CAbsolute (SDecimal Plus (UInteger 0)
(UInteger 5)
Nothing) (SInteger Plus (UInteger 1))),
let s = "-8i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CAbsolute (SInteger Plus (UInteger 0)) (SInteger Minus (UInteger 8))),
let s = "-8.25i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CAbsolute (SInteger Plus (UInteger 0)) (SDecimal Minus (UInteger 8)
(UInteger 25)
Nothing)),
let s = "0@25" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CAngle (SInteger Plus (UInteger 0)) (SInteger Plus (UInteger 25))),
let s = "1/4@-25" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
CAngle (SRational Plus (UInteger 1) (UInteger 4)) (SInteger Minus (UInteger 25))),
let s = "1#/4@-25##" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
CAngle (SRational Plus (UIntPounds 1 1) (UInteger 4)) (SInteger Minus (UIntPounds 25 2))),
let s = "#b3" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #b3",
let s = "#o9" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #o9",
let s = "#da" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #da",
let s = "#xA" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #xA",
let s = "#b1.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #b1.1",
let s = "#o1.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #o1.1",
let s = "#x1.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #x1.1",
let s = "#b.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #b.1",
let s = "#o.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #o.1",
let s = "#x.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #x.1",
let s = "123##.12" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on 123##.12",
let s = "#" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #",
let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #t",
let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #f"
],
testGroup "datum" $ [
let s = "1" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DNumber (SchemeNumber Exact (CReal (SInteger Plus (UInteger 1))))]),
let s = "foo" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DIdentifier "foo"]),
let s = "(foo #\\a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DList [DIdentifier "foo", DChar 'a']]),
let s = "(foo #\\a) \"hello\"" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DList [DIdentifier "foo", DChar 'a'], DString "hello"]),
let s = "'foo" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuote (DIdentifier "foo")]),
let s = "`foo" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DIdentifier "foo")]),
let s = "`(foo ,a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
let s = "`(foo , a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
let s = "`(foo, a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
let s = "`(foo ,@a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
let s = "`(foo ,@ a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
let s = "`(foo,@ a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
let s = "(foo . a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DDotList [DIdentifier "foo"] (DIdentifier "a")]),
let s = "(foo a b c . d)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
(Right $ [DDotList [DIdentifier "foo", DIdentifier "a", DIdentifier "b", DIdentifier "c"] (DIdentifier "d")]),
let s = "(foo .)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo .)",
let s = "(foo ')" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo ')",
let s = "(foo `)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo `)",
let s = "(foo ,)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo ,)",
let s = "(foo ,@)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo ,@)",
let s = "(foo a b . c d)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo a b . c d)"
]
]