diff --git a/.gitignore b/.gitignore index 1b655e0..0f7f94e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ *_doc/ *.ibc *~ +dependencies/ \ No newline at end of file diff --git a/.travis.yml b/.travis.yml index 796a163..5397158 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,5 +1,2 @@ -os: osx -install: - - brew install idris -script: - - make test +language: nix +script: nix-shell -A lightyear --command "make testCI" diff --git a/Makefile b/Makefile index a775534..b8091a2 100644 --- a/Makefile +++ b/Makefile @@ -3,11 +3,18 @@ all: install install: build idris --install lightyear.ipkg +dependencies: + mkdir dependencies + (cd dependencies; git clone https://github.com/pheymann/specdris; git fetch; cd specdris; git checkout v0.2.2; ./project --build; cd ../..) + build: Lightyear/*.idr idris --build lightyear.ipkg test: build - (cd tests; bash runtests.sh) + (cd tests; idris --clean test.ipkg; idris --testpkg test.ipkg --idrispath ../dependencies/specdris/src) + +testCI: dependencies + (cd tests; idris --clean test.ipkg; idris --testpkg test.ipkg --idrispath ../dependencies/specdris/src) clean: idris --clean lightyear.ipkg diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..e1d8caa --- /dev/null +++ b/default.nix @@ -0,0 +1,11 @@ +# This is used in the Travis build to install the Idris compiler. +let + pkgs = import {}; + stdenv = pkgs.stdenv; +in { + lightyear = stdenv.mkDerivation { + name = "lightyear"; + src = ./.; + buildInputs = with pkgs; [ haskellPackages.idris gmp ]; + }; +} \ No newline at end of file diff --git a/tests/JsonTest.idr b/tests/JsonTest.idr index 33386b0..768fa93 100644 --- a/tests/JsonTest.idr +++ b/tests/JsonTest.idr @@ -2,39 +2,32 @@ module JsonTest import Json -import Lightyear.Testing +import TestUtil +import Specdris.Spec -%access export - -test : String -> IO () -test s = case parse jsonToplevelValue s of - Left err => putStrLn $ "error: " ++ err - Right v => printLn v - -jsonTests : IO () -jsonTests = runTests - [ parseTestCmpShow - "JSON 1" - jsonToplevelValue - "[1,2,4,[5,6],null,{\"some\":[\"object\"]},false]" - "[1, 2, 4, [5, 6], null, {\"some\": [\"object\"]}, false]" - , parseTestCmpShow - "JSON 2" - jsonToplevelValue - "{\n \"hallo\":42,\"nichts\":null}" - "{\"hallo\": 42, \"nichts\": null}" - - , parseTestCmpShow - "JSON 3" - jsonToplevelValue - "{\"hello\": [{\"world\": false}, 3, \"string\", true, null]}" - "{\"hello\": [{\"world\": false}, 3, \"string\", true, null]}" - - , parseTestCmpNot - "JSON 4" - jsonToplevelValue - "{{\n \"hallo\":42,\"nichts\":null}" - """At 1:1: +export +specs : SpecTree +specs = describe "Json parser (data from examples)" $ do + it "JSON 1" $ do + shouldParseEqShow + jsonToplevelValue + "[1,2,4,[5,6],null,{\"some\":[\"object\"]},false]" + "[1, 2, 4, [5, 6], null, {\"some\": [\"object\"]}, false]" + it "JSON 2" $ do + shouldParseEqShow + jsonToplevelValue + "{\n \"hallo\":42,\"nichts\":null}" + "{\"hallo\": 42, \"nichts\": null}" + it "JSON 3" $ do + shouldParseEqShow + jsonToplevelValue + "{\"hello\": [{\"world\": false}, 3, \"string\", true, null]}" + "{\"hello\": [{\"world\": false}, 3, \"string\", true, null]}" + it "JSON 4" $ do + shouldNotParseEq + jsonToplevelValue + "{{\n \"hallo\":42,\"nichts\":null}" + """At 1:1: character '[' At 1:1: a different token @@ -42,4 +35,3 @@ At 1:2: character '}' At 1:2: a different token""" - ] diff --git a/tests/ParserTest.idr b/tests/ParserTest.idr new file mode 100644 index 0000000..780c287 --- /dev/null +++ b/tests/ParserTest.idr @@ -0,0 +1,33 @@ +module ParserTest + +import Data.Vect +import Data.Fin + +import Lightyear +import Lightyear.Char +import Lightyear.Strings + +import TestUtil +import Specdris.Spec + +listOf : Parser a -> Parser (List a) +listOf p = string "[" *!> (p `sepBy` string ",") <* string "]" + +listOf' : Parser a -> Parser (List a) +listOf' p = brackets (commaSep p) + +export +specs : SpecTree +specs = describe "Parser" $ do + it "parse scalar values" $ do + shouldParseEq integer "123" 123 + it "parse recursive structures" $ do + shouldParseEq (listOf integer) "[1,2,3,98]" [1, 2, 3, 98] + shouldParseEq (listOf' integer) "[1,2,3,99]" [1, 2, 3, 99] + it "parse nested structures" $ do + shouldParseEq (listOf $ listOf integer) "[[1,2],[],[3,4,5]]" [[1, 2], [], [3, 4, 5]] + shouldParseEq (listOf' $ listOf integer) "[[1,2],[],[3,4,5,6]]" [[1, 2], [], [3, 4, 5, 6]] + it "should commit and fail" $ do + shouldNotParseEq (listOf integer) "foo" "At 1:1:\n\tstring \"[\"\nAt 1:1:\n\tcharacter '['\nAt 1:1:\n\ta different token" + shouldParseEq (listOf' integer <|> (string "[foo" *> pure List.Nil)) "[foo" [] + shouldNotParseEq (listOf integer <|> (string "[foo" *> pure List.Nil)) "[foo" "At 1:2:\n\tstring \"]\"\nAt 1:2:\n\tcharacter ']'\nAt 1:2:\n\ta different token" diff --git a/tests/SpecSuite.idr b/tests/SpecSuite.idr new file mode 100644 index 0000000..c6e110d --- /dev/null +++ b/tests/SpecSuite.idr @@ -0,0 +1,13 @@ +module SpecSuite + +import ParserTest +import JsonTest +import TestLazy + +import Specdris.Spec + +export +specSuite : IO () +specSuite = spec $ do ParserTest.specs + JsonTest.specs + TestLazy.specs diff --git a/tests/Test.idr b/tests/Test.idr deleted file mode 100644 index 3f2182e..0000000 --- a/tests/Test.idr +++ /dev/null @@ -1,38 +0,0 @@ -module Test - -import Data.Vect -import Data.Fin - -import Lightyear -import Lightyear.Char -import Lightyear.Strings -import Lightyear.Testing - -%access export - -listOf : Parser a -> Parser (List a) -listOf p = string "[" *!> (p `sepBy` string ",") <* string "]" - -listOf' : Parser a -> Parser (List a) -listOf' p = brackets (commaSep p) - -nat : Parser Nat -nat = integer - -tests : IO () -tests = runTests - [ parseTestCmp "Test 1" nat (==) "123" 123 - , parseTestCmp "Test 2" (listOf nat) (==) "[1,2,3,99]" [1,2,3,99] - - , parseTestCmpNot "Test 3" (listOf nat) "foo" "At 1:1:\n\tstring \"[\"\nAt 1:1:\n\tcharacter '['\nAt 1:1:\n\ta different token" - - -- should commit and fail - , parseTestCmpNot "Test 4" (listOf nat <|> (string "[foo" *> pure List.Nil)) "[foo" "At 1:2:\n\tstring \"]\"\nAt 1:2:\n\tcharacter ']'\nAt 1:2:\n\ta different token" - - , parseTestCmp "Test 5" (listOf $ listOf nat) (==) "[[1,2],[],[3,4,5]]" [[1, 2], [], [3, 4, 5]] - , parseTestCmp "Test 6" (listOf' nat) (==) "[1,2,3,99]" [1, 2, 3, 99] - , parseTestCmp "Test 6" (listOf' $ listOf' nat) (==) "[[1,2],[],[3,4,5]]" [[1, 2], [], [3, 4, 5]] - - -- should commit and fail - , parseTestCmp "Test 7" (listOf' nat <|> (string "[foo" *> pure List.Nil)) (==) "[foo" [] - ] diff --git a/tests/TestLazy.idr b/tests/TestLazy.idr index 6a146f8..8c138a1 100644 --- a/tests/TestLazy.idr +++ b/tests/TestLazy.idr @@ -5,13 +5,13 @@ import Lightyear.Char import Lightyear.Strings import Lightyear.Testing +import TestUtil +import Specdris.Spec + %default partial -%access export -public export data Ty = ATOM | EXPR -export data SExpr : Ty -> Type where Atom : String -> SExpr ATOM AtomExpr : SExpr ATOM -> SExpr EXPR @@ -21,10 +21,6 @@ Show (SExpr ty) where show (Atom a) = unwords ["Atom", a] show (Expr a b) = unwords ["Expr", show a, show b] -Show (SExpr ty) => Show (ty : Ty ** SExpr ty) where - show (x ** pf) {ty = ATOM} = show pf - show (x ** pf) {ty = EXPR} = show pf - atom : Parser $ SExpr ATOM atom = do cs <- some $ satisfy isAlphaNum @@ -44,15 +40,9 @@ expr = do pure $ Expr exprA exprB "EXPR" -tests : IO () -tests = runTests - [ parseTest "Atoms" atom "Test" - , parseTest "Numbers" atom "1" - , parseTest "Simple Expr 1" expr "Test" - , parseTest "Simple Expr 2" expr "(id x)" - , parseTest "Complex Expr 1" expr "(add (1 2))" - , parseTest "Complex Expr 2" expr "(a (b (c (d (e (f (g (h (i (j (k (l (m (n (o (p (q (r (s (t (u (v (w (x (y (z NIL))))))))))))))))))))))))))" - , parseTestNot "Complex Expr 3" expr """(a +complex1 : String +complex1 = + """(a (b (c (d @@ -67,9 +57,10 @@ tests = runTests (m (n (o (p (q (r (s (t (u (v (w (x (y (z NIL)))))))))))))))))))))))))) """ - , parseTestCmpNot "Complex Expr 4" - expr - """(a + +complex2 : String +complex2 = + """(a (b (c (d @@ -83,7 +74,10 @@ tests = runTests (l (m (n (o (p (q (r (s (t (u (v (w (x (y (z NIL))))))))))))))))))))))))))""" - """At 1:1: + +complex2Error : String +complex2Error = + """At 1:1: EXPR At 1:1: Atom @@ -121,4 +115,18 @@ At 6:12: character ')' At 6:12: a different token""" - ] + +export +specs : SpecTree +specs = describe "Lazy evaluation" $ do + it "parse atomic expressions" $ do + shouldParse atom "Test" + shouldParse atom "1" + it "parse simple expressions" $ do + shouldParse expr "Test" + shouldParse expr "(id x)" + it "parse complexe expressions" $ do + shouldParse expr "(add (1 2))" + shouldParse expr "(a (b (c (d (e (f (g (h (i (j (k (l (m (n (o (p (q (r (s (t (u (v (w (x (y (z NIL))))))))))))))))))))))))))" + shouldNotParse expr complex1 + shouldNotParseEq expr complex2 complex2Error diff --git a/tests/TestUtil.idr b/tests/TestUtil.idr new file mode 100644 index 0000000..b0d0c1a --- /dev/null +++ b/tests/TestUtil.idr @@ -0,0 +1,35 @@ +module TestUtil + +import Lightyear +import Lightyear.Char +import Lightyear.Strings + +import Specdris.Spec + +%access export +%default total + +shouldParse : (Show a) => Parser a -> (raw : String) -> SpecResult +shouldParse p raw = case parse p raw of + (Left err) => (UnaryFailure raw err) + (Right _) => Success + +shouldNotParse : (Show a) => Parser a -> (raw : String) -> SpecResult +shouldNotParse p raw = case parse p raw of + (Left _) => Success + (Right actual) => (UnaryFailure raw "should fail") + +shouldParseEq : (Show a, Eq a) => Parser a -> (raw : String) -> (expected : a) -> SpecResult +shouldParseEq p raw expected = case parse p raw of + (Left err) => (BinaryFailure raw expected err) + (Right actual) => actual === expected + +shouldParseEqShow : Show a => Parser a -> (raw : String) -> (expected : String) -> SpecResult +shouldParseEqShow p raw expected = case parse p raw of + (Left err) => (BinaryFailure raw expected err) + (Right actual) => (show actual) === expected + +shouldNotParseEq : Show a => Parser a -> (raw : String) -> (expected : String) -> SpecResult +shouldNotParseEq p raw expected = case parse p raw of + (Left actual) => actual === expected + (Right err) => (BinaryFailure err expected "should fail") diff --git a/tests/expected b/tests/expected deleted file mode 100644 index 20081d1..0000000 --- a/tests/expected +++ /dev/null @@ -1,12 +0,0 @@ -[PASS] JSON 1 -[PASS] JSON 2 -[PASS] JSON 3 -[PASS] JSON 4 -[PASS] Test 1 -[PASS] Test 2 -[PASS] Test 3 -[PASS] Test 4 -[PASS] Test 5 -[PASS] Test 6 -[PASS] Test 6 -[PASS] Test 7 diff --git a/tests/runtests.sh b/tests/runtests.sh deleted file mode 100755 index 6f83af4..0000000 --- a/tests/runtests.sh +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/env bash - -set -euo pipefail - -OS=`uname -s` - -# Timeout on Mac OS X is installed via brew install coreutils and called gtimeout -if [ "$OS" = "Darwin" ]; then - TIMEOUTCMD=gtimeout -else - TIMEOUTCMD=timeout -fi - -echo "TIMOUTCMD set to ${TIMEOUTCMD}" - -die() { - echo "$1" >&2 - exit 1 -} - -clean_up() { - idris --clean test.ipkg - rm -f *.ibc output -} - -clean_up - -echo "compiling lightyear tests..." -idris --build test.ipkg || die "* could not compile tests *" - -echo "compiled OK, running lightyear tests..." -$TIMEOUTCMD 120s idris --testpkg test.ipkg | grep -v -e "idris" > output || die "* test failed or timed out *" - -#echo "compiling the JSON test..." -#idris JsonTest.idr -p lightyear -p contrib -o json || die "* could not compile the json test *" -# -#echo "compiled OK, running the JSON test..." -#$TIMEOUTCMD 5s ./json >> output || die "* test failed or timed out *" - -# use a default parameter if $1 is not set -if [ "${1-}" = "believe_me" ]; then - echo '### marking current output as expected ###' - cat output > expected - clean_up - exit 0 -else - if diff output expected; then - echo "### everything PASS ###" - clean_up - exit 0 - else - echo "### something FAIL ###" - clean_up - exit 1 - fi -fi diff --git a/tests/test.ipkg b/tests/test.ipkg index 7055394..f7a0853 100644 --- a/tests/test.ipkg +++ b/tests/test.ipkg @@ -4,7 +4,9 @@ opts = "--sourcepath ../ --idrispath ../ -p contrib" modules = Json , JsonTest - , Test + , ParserTest + , TestLazy + , TestUtil + , SpecSuite -tests = JsonTest.jsonTests - , Test.tests +tests = SpecSuite.specSuite