From 8a3405146b918ef18a42aca1bcdac55a8c484c47 Mon Sep 17 00:00:00 2001
From: Marvin Borner
Date: Thu, 3 Mar 2022 15:57:46 +0100
Subject: Tests
---
test/Fun.hs | 8 ++
test/FunTests/Parser.hs | 225 ++++++++++++++++++++++++++++++++++++++++++++++++
test/Spec.hs | 2 -
3 files changed, 233 insertions(+), 2 deletions(-)
create mode 100644 test/Fun.hs
create mode 100644 test/FunTests/Parser.hs
delete mode 100644 test/Spec.hs
(limited to 'test')
diff --git a/test/Fun.hs b/test/Fun.hs
new file mode 100644
index 0000000..ea9dbf8
--- /dev/null
+++ b/test/Fun.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import FunTests.Parser
+import Test.HUnit
+
+main :: IO Counts
+main = do
+ parserTest
diff --git a/test/FunTests/Parser.hs b/test/FunTests/Parser.hs
new file mode 100644
index 0000000..2339a82
--- /dev/null
+++ b/test/FunTests/Parser.hs
@@ -0,0 +1,225 @@
+module FunTests.Parser
+ ( parserTest
+ ) where
+
+import Fun.Parser
+import Test.HUnit
+
+isLeft :: Either a b -> Bool
+isLeft (Left _) = True
+isLeft (Right _) = False
+
+isRight :: Either a b -> Bool
+isRight (Right _) = True
+isRight (Left _) = False
+
+----
+
+testIsDigit :: Test
+testIsDigit = test
+ [ isDigit '0' ~=? True
+ , isDigit '9' ~=? True
+ , isDigit 'A' ~=? False
+ , isDigit 'z' ~=? False
+ ]
+
+testIsAlpha :: Test
+testIsAlpha = test
+ [ isAlpha 'A' ~=? True
+ , isAlpha 'z' ~=? True
+ , isAlpha '0' ~=? False
+ , isAlpha '9' ~=? False
+ ]
+
+testIsLower :: Test
+testIsLower = test
+ [ isLower 'a' ~=? True
+ , isLower 'z' ~=? True
+ , isLower 'A' ~=? False
+ , isLower '9' ~=? False
+ ]
+
+testIsUpper :: Test
+testIsUpper = test
+ [ isUpper 'A' ~=? True
+ , isUpper 'Z' ~=? True
+ , isUpper '9' ~=? False
+ , isUpper 'a' ~=? False
+ ]
+
+testChar :: Test
+testChar = test
+ [ char "abc" ~=? Right ('a', "bc")
+ , char "a" ~=? Right ('a', "")
+ , isLeft (char "") ~=? True
+ ]
+
+testDigit :: Test
+testDigit = test
+ [ digit "123" ~=? Right ('1', "23")
+ , digit "9abc" ~=? Right ('9', "abc")
+ , isLeft (digit "a123") ~=? True
+ ]
+
+testDigits :: Test
+testDigits = test
+ [ digits "123" ~=? Right ("123", "")
+ , digits "98abc" ~=? Right ("98", "abc")
+ , isLeft (digits "a123") ~=? True
+ ]
+
+testNumber :: Test
+testNumber = test
+ [ number "-123" ~=? Right (-123, "")
+ , number "98abc" ~=? Right (98, "abc")
+ , isLeft (number "--123") ~=? True
+ , isLeft (number "a123") ~=? True
+ ]
+
+testSpace :: Test
+testSpace = test
+ [ space " ab" ~=? Right (' ', "ab")
+ , space " a" ~=? Right (' ', " a")
+ , isLeft (space "a b") ~=? True
+ ]
+
+testNotSpace :: Test
+testNotSpace = test
+ [ notSpace "~b" ~=? Right ('~', "b")
+ , notSpace "8b" ~=? Right ('8', "b")
+ , notSpace "ab" ~=? Right ('a', "b")
+ , isLeft (notSpace " b") ~=? True
+ ]
+
+testNewline :: Test
+testNewline = test
+ [ newline "\nab" ~=? Right ('\n', "ab")
+ , newline "\n\na" ~=? Right ('\n', "\na")
+ --, newline "\r\na" ~=? Right ('\r', "\na") -- or sth TODO
+ , isLeft (newline "a\nb") ~=? True
+ ]
+
+testLetter :: Test
+testLetter = test
+ [ letter "abc" ~=? Right ('a', "bc")
+ , letter "a123" ~=? Right ('a', "123")
+ , isLeft (letter "1abc") ~=? True
+ ]
+
+testLetters :: Test
+testLetters = test
+ [ letters "abc" ~=? Right ("abc", "")
+ , letters "ab123" ~=? Right ("ab", "123")
+ , isLeft (letters "1abc") ~=? True
+ ]
+
+testAlphanum :: Test
+testAlphanum = test
+ [ alphanum "abc" ~=? Right ('a', "bc")
+ , alphanum "a123" ~=? Right ('a', "123")
+ , alphanum "1234" ~=? Right ('1', "234")
+ , isLeft (alphanum "_abc") ~=? True
+ , isLeft (alphanum "*123") ~=? True
+ ]
+
+testSpecial :: Test
+testSpecial = test
+ [ special "*123" ~=? Right ('*', "123")
+ , special "#abc" ~=? Right ('#', "abc")
+ , isLeft (special "abc") ~=? True
+ , isLeft (special "123") ~=? True
+ ]
+
+testOneOf :: Test
+testOneOf = test
+ [ oneOf "abcd" "d123" ~=? Right ('d', "123")
+ , oneOf "#(!" "#abc" ~=? Right ('#', "abc")
+ , isLeft (oneOf "abcde" "fu") ~=? True
+ , isLeft (oneOf "123" "a123") ~=? True
+ ]
+
+testString :: Test
+testString = test
+ [ string "\"hallo\"naa" ~=? Right ("hallo", "naa")
+ , string "\"\"ah" ~=? Right ("", "ah")
+ , isLeft (string "\"hallo naa") ~=? True
+ , isLeft (string "na\"hallo\"") ~=? True
+ ]
+
+testLiteral :: Test
+testLiteral = test
+ [ literal 'a' "abc" ~=? Right ('a', "bc")
+ , literal '~' "~12" ~=? Right ('~', "12")
+ , isLeft (literal 'a' "123abc") ~=? True
+ , isLeft (literal '1' " 123") ~=? True
+ ]
+
+testResult :: Test
+testResult = test
+ [result 'a' "abc" ~=? Right ('a', "abc"), result ' ' "" ~=? Right (' ', "")]
+
+testOneOrMore :: Test
+testOneOrMore = test
+ [ oneOrMore (literal 'a') "abc" ~=? Right ("a", "bc")
+ , oneOrMore (literal '1') "111234" ~=? Right ("111", "234")
+ , isLeft (oneOrMore (literal 'a') "1234") ~=? True
+ ]
+
+testIter :: Test
+testIter = test
+ [ iter (literal 'a') "abc" ~=? Right ("a", "bc")
+ , iter (literal '1') "111234" ~=? Right ("111", "234")
+ , iter (literal 'a') "1234" ~=? Right ("", "1234")
+ ]
+
+testIterFull :: Test
+testIterFull = test
+ [ iterFull (literal 'a') "aaa" ~=? Right ("aaa", "")
+ , iterFull (literal '1') "1" ~=? Right ("1", "")
+ , isLeft (iterFull (literal 'a') "abc") ~=? True
+ , isLeft (iterFull (literal 'a') "1234") ~=? True
+ ]
+
+testToken :: Test
+testToken = test
+ [ token (literal 'a') "a b" ~=? Right ('a', "b")
+ , token (literal ' ') " a" ~=? Right (' ', "a")
+ , isLeft (token (literal 'a') "ab") ~=? True
+ , isLeft (token (literal 'a') "ba ") ~=? True
+ ]
+
+testAccept :: Test
+testAccept = test
+ [ accept "abc" "abc 123" ~=? Right ("abc", "123")
+ , accept "1" "1 1 23" ~=? Right ("1", "1 23")
+ , isLeft (accept " " " a") ~=? True
+ , isLeft (accept "abc" "aabc ") ~=? True
+ ]
+
+parserTest :: IO Counts
+parserTest = runTestTT $ TestList
+ [ testIsDigit
+ , testIsAlpha
+ , testIsLower
+ , testIsUpper
+ , testChar
+ , testDigit
+ , testDigits
+ , testNumber
+ , testSpace
+ , testNotSpace
+ , testNewline
+ , testLetter
+ , testLetters
+ , testAlphanum
+ , testSpecial
+ , testOneOf
+ , testString
+ , testLiteral
+ , testResult
+ , testOneOrMore
+ , testIter
+ , testIterFull
+ , testToken
+ , testAccept
+ ]
diff --git a/test/Spec.hs b/test/Spec.hs
deleted file mode 100644
index cd4753f..0000000
--- a/test/Spec.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"
--
cgit v1.2.3