From 70c30b91b83426c04ff3c5f1f54e2dde993f2302 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 14 Dec 2016 18:08:50 -0400 Subject: - Updated tests for lux/macro/ast and lux/macro/syntax. - Added tests for lux/macro/template. --- stdlib/test/test/lux/macro/ast.lux | 52 ++-- stdlib/test/test/lux/macro/syntax.lux | 419 +++++++++++++++++++------------- stdlib/test/test/lux/macro/template.lux | 27 ++ stdlib/test/tests.lux | 18 +- 4 files changed, 317 insertions(+), 199 deletions(-) create mode 100644 stdlib/test/test/lux/macro/template.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux index b06efce01..a10486edc 100644 --- a/stdlib/test/test/lux/macro/ast.lux +++ b/stdlib/test/test/lux/macro/ast.lux @@ -1,31 +1,39 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (codata [io]) + (codata function) (control monad) - (data [text "Text/" Monoid] + (data [text "T/" Eq] + text/format [number]) - (macro ast) - (codata function)) + (math ["R" random]) + pipe + (macro ["&" ast])) lux/test) -(test: "lux/macro/ast exports" - (let% [ (do-template [ ] - [(match ) - (match (ast-to-text )) - (match true (:: Eq = ))] +(test: "AST" + (let% [ (do-template [ ] + [(assert (format "Can produce AST node: " ) + (and (T/= (&;to-text )) + (:: &;Eq = )))] - [(bool true) "true" [["" -1 -1] (#;BoolS true)]] - [(bool false) "false" [_ (#;BoolS false)]] - [(int 123) "123" [_ (#;IntS 123)]] - [(real 123.0) "123.0" [_ (#;RealS 123.0)]] - [(char #"\n") "#\"\\n\"" [_ (#;CharS #"\n")]] - [(text "\n") "\"\\n\"" [_ (#;TextS "\n")]] - [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;TagS ["yolo" "lol"])]] - [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;SymbolS ["yolo" "lol"])]] - [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;FormS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])] - [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;TupleS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])] - [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;RecordS (list [[_ (#;BoolS true)] [_ (#;IntS 123)]]))])] - [(local-tag "lol") "#lol" [_ (#;TagS ["" "lol"])]] - [(local-symbol "lol") "lol" [_ (#;SymbolS ["" "lol"])]] + [(&;bool true) "true"] + [(&;bool false) "false"] + [(&;int 123) "123"] + [(&;real 123.0) "123.0"] + [(&;char #"\n") "#\"\\n\""] + [(&;text "\n") "\"\\n\""] + [(&;tag ["yolo" "lol"]) "#yolo;lol"] + [(&;symbol ["yolo" "lol"]) "yolo;lol"] + [(&;form (list (&;bool true) (&;int 123))) "(true 123)"] + [(&;tuple (list (&;bool true) (&;int 123))) "[true 123]"] + [(&;record (list [(&;bool true) (&;int 123)])) "{true 123}"] + [(&;local-tag "lol") "#lol"] + [(&;local-symbol "lol") "lol"] )] - (test-all ))) + ($_ seq ))) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 99f8550c0..17d4c935b 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -1,176 +1,259 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (codata [io]) - (control monad) + (control monad + eq) (data [text "Text/" Monoid] - [number]) + text/format + [number] + [bool] + [char] + [ident] + [error #- fail]) + (codata function) + (math ["R" random]) + pipe + [compiler] (macro [ast] - ["s" syntax #+ syntax: Syntax]) - (codata function)) + ["s" syntax #+ syntax: Syntax])) lux/test) -(test: "lux/macro/syntax exports [Part 1]" - (let% [ (do-template [ ] - [(match (#;Right [_ ]) - (s;run (list ) - )) - (match (#;Right [_ true]) - (s;run (list ) - ( ))) - (match (#;Right [_ []]) - (s;run (list ) - ( )))] - - [true (ast;bool true) s;bool s;bool? s;bool!] - [123 (ast;int 123) s;int s;int? s;int!] - [123.0 (ast;real 123.0) s;real s;real? s;real!] - [#"\n" (ast;char #"\n") s;char s;char? s;char!] - ["\n" (ast;text "\n") s;text s;text? s;text!] - [["yolo" "lol"] (ast;symbol ["yolo" "lol"]) s;symbol s;symbol? s;symbol!] - [["yolo" "lol"] (ast;tag ["yolo" "lol"]) s;tag s;tag? s;tag!] - ) - (do-template [ ] - [(match (#;Right [_ [true 123]]) - (s;run (list ( (list (ast;bool true) (ast;int 123)))) - ( (s;seq s;bool s;int)))) - (match (#;Right [_ true]) - (s;run (list ( (list (ast;bool true)))) - ( s;bool))) - (match (#;Left _) - (s;run (list ( (list (ast;bool true) (ast;int 123)))) - ( s;bool))) - (match (#;Right [_ (#;Left true)]) - (s;run (list ( (list (ast;bool true)))) - ( (s;alt s;bool s;int)))) - (match (#;Right [_ (#;Right 123)]) - (s;run (list ( (list (ast;int 123)))) - ( (s;alt s;bool s;int)))) - (match (#;Left _) - (s;run (list ( (list (ast;real 123.0)))) - ( (s;alt s;bool s;int))))] - - [s;form ast;form] - [s;tuple ast;tuple])] - (test-all (match (#;Right [_ [_ (#;BoolS true)]]) - (s;run (list (ast;bool true) (ast;int 123)) - s;any)) - - (match (#;Right [_ []]) - (s;run (list (ast;bool true) (ast;int 123)) - (s;assert true "yolo"))) - (match (#;Left _) +## [Utils] +(def: (enforced? parser input) + (-> (Syntax []) (List AST) Bool) + (case (s;run input parser) + (#;Right [_ []]) + true + + _ + false)) + +(def: (found? parser input) + (-> (Syntax Bool) (List AST) Bool) + (case (s;run input parser) + (#;Right [_ true]) + true + + _ + false)) + +(def: (is? Eq test parser input) + (All [a] (-> (Eq a) a (Syntax a) (List AST) Bool)) + (case (s;run input parser) + (#;Right [_ output]) + (:: Eq = test output) + + _ + false)) + +(def: (fails? input) + (All [a] (-> (Error a) Bool)) + (case input + (#;Left _) + true + + _ + false)) + +(syntax: (match pattern input) + (wrap (list (` (case (~ input) + (^ (#;Right [(~' _) (~ pattern)])) + true + + (~' _) + false))))) + +## [Tests] +(test: "Simple value syntax." + (let% [ (do-template [ ] + [(assert + (and (is? (list ( ))) + (found? ( ) (list ( ))) + (enforced? ( ) (list ( )))))] + + ["Can parse Bool syntax." true ast;bool bool;Eq s;bool s;bool? s;bool!] + ["Can parse Nat syntax." +123 ast;nat number;Eq s;nat s;nat? s;nat!] + ["Can parse Int syntax." 123 ast;int number;Eq s;int s;int? s;int!] + ## ["Can parse Frac syntax." .123 ast;frac number;Eq s;frac s;frac? s;frac!] + ["Can parse Real syntax." 123.0 ast;real number;Eq s;real s;real? s;real!] + ["Can parse Char syntax." #"\n" ast;char char;Eq s;char s;char? s;char!] + ["Can parse Text syntax." "\n" ast;text text;Eq s;text s;text? s;text!] + ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq s;symbol s;symbol? s;symbol!] + ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq s;tag s;tag? s;tag!] + )] + ($_ seq + + + (assert "Can parse symbols belonging to the current namespace." + (and (match "yolo" + (s;run (list (ast;local-symbol "yolo")) + s;local-symbol)) + (fails? (s;run (list (ast;symbol ["yolo" "lol"])) + s;local-symbol)))) + + (assert "Can parse tags belonging to the current namespace." + (and (match "yolo" + (s;run (list (ast;local-tag "yolo")) + s;local-tag)) + (fails? (s;run (list (ast;tag ["yolo" "lol"])) + s;local-tag)))) + ))) + +(test: "Complex value syntax." + (let% [ (do-template [ ] + [(assert (format "Can parse " " syntax.") + (and (match [true 123] + (s;run (list ( (list (ast;bool true) (ast;int 123)))) + ( (s;seq s;bool s;int)))) + (match true + (s;run (list ( (list (ast;bool true)))) + ( s;bool))) + (fails? (s;run (list ( (list (ast;bool true) (ast;int 123)))) + ( s;bool))) + (match (#;Left true) + (s;run (list ( (list (ast;bool true)))) + ( (s;alt s;bool s;int)))) + (match (#;Right 123) + (s;run (list ( (list (ast;int 123)))) + ( (s;alt s;bool s;int)))) + (fails? (s;run (list ( (list (ast;real 123.0)))) + ( (s;alt s;bool s;int))))))] + + ["form" s;form ast;form] + ["tuple" s;tuple ast;tuple])] + ($_ seq + + + (assert "Can parse record syntax." + (match [true 123] + (s;run (list (ast;record (list [(ast;bool true) (ast;int 123)]))) + (s;record (s;seq s;bool s;int))))) + ))) + +(test: "Assertions" + (assert "Can make assertions while parsing." + (and (match [] + (s;run (list (ast;bool true) (ast;int 123)) + (s;assert "yolo" true))) + (fails? (s;run (list (ast;bool true) (ast;int 123)) + (s;assert "yolo" false)))))) + +(test: "Combinators [Part 1]" + ($_ seq + (assert "Can parse any AST." + (match [_ (#;BoolS true)] (s;run (list (ast;bool true) (ast;int 123)) - (s;assert false "yolo"))) - (match (#;Right [_ +123]) - (s;run (list (ast;nat +123)) - s;nat)) - (match (#;Left _) - (s;run (list (ast;int -123)) - s;nat)) - (match (#;Right [_ "yolo"]) - (s;run (list (ast;local-symbol "yolo")) - s;local-symbol)) - (match (#;Left _) - (s;run (list (ast;symbol ["yolo" "lol"])) - s;local-symbol)) - (match (#;Right [_ "yolo"]) - (s;run (list (ast;local-tag "yolo")) - s;local-tag)) - (match (#;Left _) - (s;run (list (ast;tag ["yolo" "lol"])) - s;local-tag)) - - ))) - -(test: "lux/macro/syntax exports [Part 2]" - (test-all (match (#;Right [_ [true 123]]) - (s;run (list (ast;record (list [(ast;bool true) (ast;int 123)]))) - (s;record (s;seq s;bool s;int)))) - (match (#;Right [_ (#;Some +123)]) - (s;run (list (ast;nat +123)) - (s;opt s;nat))) - (match (#;Right [_ #;None]) - (s;run (list (ast;int -123)) - (s;opt s;nat))) - (match (^ (#;Right [_ (list +123 +456 +789)])) - (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) - (s;some s;nat))) - (match (^ (#;Right [_ (list)])) - (s;run (list (ast;int -123)) - (s;some s;nat))) - (match (^ (#;Right [_ (list +123 +456 +789)])) - (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) - (s;many s;nat))) - (match (^ (#;Right [_ (list +123)])) - (s;run (list (ast;nat +123)) - (s;many s;nat))) - (match (#;Left _) - (s;run (list (ast;int -123)) - (s;many s;nat))) - (match (#;Right [_ 123]) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;either s;pos-int s;int))) - (match (#;Right [_ -123]) - (s;run (list (ast;int -123) (ast;int 456) (ast;int 789)) - (s;either s;pos-int s;int))) - (match (#;Left _) - (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) - (s;either s;pos-int s;int))) - (match (#;Right [_ true]) - (s;run (list) - s;end?)) - (match (#;Right [_ false]) - (s;run (list (ast;bool true)) - s;end?)) - (match (#;Right [_ []]) - (s;run (list) - s;end)) - (match (#;Left _) - (s;run (list (ast;bool true)) - s;end)) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;exactly +3 s;int))) - (match (^ (#;Right [_ (list 123 456)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;exactly +2 s;int))) - (match (#;Left _) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;exactly +4 s;int))) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;at-least +3 s;int))) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;at-least +2 s;int))) - (match (#;Left _) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;at-least +4 s;int))) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;at-most +3 s;int))) - (match (^ (#;Right [_ (list 123 456)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;at-most +2 s;int))) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;at-most +4 s;int))) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;between +3 +10 s;int))) - (match (#;Left _) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;between +4 +10 s;int))) - (match (^ (#;Right [_ (list 123 456 789)])) - (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;text "YOLO") (ast;int 789)) - (s;sep-by (s;text! "YOLO") s;int))) - (match (^ (#;Right [_ (list 123 456)])) - (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;int 789)) - (s;sep-by (s;text! "YOLO") s;int))) - (match (#;Left _) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) - (s;not s;int))) - (match (#;Right [_ []]) - (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) - (s;not s;int))) - )) + s;any))) + + (assert "Can optionally succeed with some parser." + (and (match (#;Some +123) + (s;run (list (ast;nat +123)) + (s;opt s;nat))) + (match #;None + (s;run (list (ast;int -123)) + (s;opt s;nat))))) + + (assert "Can apply a parser 0 or more times." + (and (match (list +123 +456 +789) + (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) + (s;some s;nat))) + (match (list) + (s;run (list (ast;int -123)) + (s;some s;nat))))) + + (assert "Can apply a parser 1 or more times." + (and (match (list +123 +456 +789) + (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) + (s;many s;nat))) + (match (list +123) + (s;run (list (ast;nat +123)) + (s;many s;nat))) + (fails? (s;run (list (ast;int -123)) + (s;many s;nat))))) + + (assert "Can use either parser." + (and (match 123 + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;either s;pos-int s;int))) + (match -123 + (s;run (list (ast;int -123) (ast;int 456) (ast;int 789)) + (s;either s;pos-int s;int))) + (fails? (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) + (s;either s;pos-int s;int))))) + + (assert "Can create the opposite/negation of any parser." + (and (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;not s;int))) + (match [] + (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) + (s;not s;int))))) + )) + +(test: "Combinators Part [2]" + ($_ seq + (assert "Can check whether the end has been reached." + (and (match true + (s;run (list) + s;end?)) + (match false + (s;run (list (ast;bool true)) + s;end?)))) + + (assert "Can ensure the end has been reached." + (and (match [] + (s;run (list) + s;end)) + (fails? (s;run (list (ast;bool true)) + s;end)))) + + (assert "Can apply a parser N times." + (and (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;exactly +3 s;int))) + (match (list 123 456) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;exactly +2 s;int))) + (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;exactly +4 s;int))))) + + (assert "Can apply a parser at-least N times." + (and (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-least +3 s;int))) + (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-least +2 s;int))) + (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-least +4 s;int))))) + + (assert "Can apply a parser at-most N times." + (and (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-most +3 s;int))) + (match (list 123 456) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-most +2 s;int))) + (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-most +4 s;int))))) + + (assert "Can apply a parser between N and M times." + (and (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;between +3 +10 s;int))) + (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;between +4 +10 s;int))))) + + (assert "Can parse while taking separators into account." + (and (match (list 123 456 789) + (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;text "YOLO") (ast;int 789)) + (s;sep-by (s;text! "YOLO") s;int))) + (match (list 123 456) + (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;int 789)) + (s;sep-by (s;text! "YOLO") s;int))))) + )) diff --git a/stdlib/test/test/lux/macro/template.lux b/stdlib/test/test/lux/macro/template.lux new file mode 100644 index 000000000..4ff5e683f --- /dev/null +++ b/stdlib/test/test/lux/macro/template.lux @@ -0,0 +1,27 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data text/format + [error #- fail]) + (math ["R" random]) + pipe + [compiler] + (macro ["s" syntax] + ["&" template #+ template:])) + lux/test) + +(template: (hypotenuse x y) + (i.+ (i.* x x) (i.* y y))) + +(test: "Templates" + [x R;int + y R;int] + (assert "Template application is a stand-in for the templated code." + (i.= (i.+ (i.* x x) (i.* y y)) + (hypotenuse x y)))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 857d5c25c..e225e1f28 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -55,20 +55,20 @@ ## ["_;" random] ["_;" simple] ) - ## (macro [ast] - ## [syntax]) + ## [macro] + (macro ["_;" ast] + ["_;" syntax] + ["_;" template]) ## [type] + ## (type [check] [auto]) ## (control ...) ) ) ## (lux (codata [cont]) - ## [macro] - ## (macro [template] - ## [poly] - ## (poly ["poly_;" eq] - ## ["poly_;" text-encoder] - ## ["poly_;" functor])) - ## (type [check] [auto]) + ## (macro [poly] + ## (poly ["poly_;" eq] + ## ["poly_;" text-encoder] + ## ["poly_;" functor])) ## (control [effect])) ) -- cgit v1.2.3