From f8c2389db4a9b3239b00b9d209237d5116e12e3c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 25 Jan 2017 07:02:33 -0400 Subject: - Renamed lux/data/struct/tree to lux/data/struct/tree/rose. - Moved lux/data/struct/zipper to lux/data/struct/tree/zipper. - Moved lux/regex to lux/lexer/regex. - Changed the suffix of annotation tags, from M to A. - Renamed Frac(tional) numbers to Deg(rees). --- stdlib/test/test/lux.lux | 18 +- stdlib/test/test/lux/data/number.lux | 18 +- stdlib/test/test/lux/data/struct/tree.lux | 40 ---- stdlib/test/test/lux/data/struct/tree/rose.lux | 40 ++++ stdlib/test/test/lux/data/struct/tree/zipper.lux | 128 +++++++++++ stdlib/test/test/lux/data/struct/zipper.lux | 128 ----------- stdlib/test/test/lux/lexer/regex.lux | 274 +++++++++++++++++++++++ stdlib/test/test/lux/macro/syntax.lux | 2 +- stdlib/test/test/lux/math/simple.lux | 4 +- stdlib/test/test/lux/regex.lux | 274 ----------------------- stdlib/test/tests.lux | 6 +- 11 files changed, 466 insertions(+), 466 deletions(-) delete mode 100644 stdlib/test/test/lux/data/struct/tree.lux create mode 100644 stdlib/test/test/lux/data/struct/tree/rose.lux create mode 100644 stdlib/test/test/lux/data/struct/tree/zipper.lux delete mode 100644 stdlib/test/test/lux/data/struct/zipper.lux create mode 100644 stdlib/test/test/lux/lexer/regex.lux delete mode 100644 stdlib/test/test/lux/regex.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 6c1ea6f4b..cd394ac76 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -75,7 +75,7 @@ ["Int" R;int i.= i.< i.> i.<= i.>= i.min i.max] ["Nat" R;nat n.= n.< n.> n.<= n.>= n.min n.max] ["Real" R;real r.= r.< r.> r.<= r.>= r.min r.max] - ["Frac" R;frac f.= f.< f.> f.<= f.>= f.min f.max] + ["Deg" R;deg d.= d.< d.> d.<= d.>= d.min d.max] ) (do-template [category rand-gen = + - * / <%> > <0> <1> %x ] @@ -97,10 +97,10 @@ (test: (format "[" category "] " "Multiplicative identity") [x rand-gen] (assert "" - ## Skip this test for Frac - ## because Frac division loses the last + ## Skip this test for Deg + ## because Deg division loses the last ## 32 bits of precision. - (or (T/= "Frac" category) + (or (T/= "Deg" category) (and (|> x (* <1>) (= x)) (|> x (/ <1>) (= x)))))) @@ -112,10 +112,10 @@ #let [r (<%> y x) x' (- r x)]] (assert "" - ## Skip this test for Frac - ## because Frac division loses the last + ## Skip this test for Deg + ## because Deg division loses the last ## 32 bits of precision. - (or (T/= "Frac" category) + (or (T/= "Deg" category) (or (> x' y) (|> x' (/ y) (* y) (= x')))) ))] @@ -123,7 +123,7 @@ ["Nat" R;nat n.= n.+ n.- n.* n./ n.% n.> +0 +1 +1000000 %n (n.% +1000) id] ["Int" R;int i.= i.+ i.- i.* i./ i.% i.> 0 1 1000000 %i (i.% 1000) id] ["Real" R;real r.= r.+ r.- r.* r./ r.% r.> 0.0 1.0 1000000.0 %r id math;floor] - ["Frac" R;frac f.= f.+ f.- f.* f./ f.% f.> .0 (_lux_proc ["frac" "max-value"] []) (_lux_proc ["frac" "max-value"] []) %f id id] + ["Deg" R;deg d.= d.+ d.- d.* d./ d.% d.> .0 (_lux_proc ["deg" "max-value"] []) (_lux_proc ["deg" "max-value"] []) %f id id] ) (do-template [category rand-gen -> <- = %a %z] @@ -137,7 +137,7 @@ ["Nat->Int" R;nat nat-to-int int-to-nat n.= (n.% +1000000) %n %i] ["Int->Real" R;int int-to-real real-to-int i.= (i.% 1000000) %i %r] ["Real->Int" R;real real-to-int int-to-real r.= math;floor %r %i] - ## [R;real real-to-frac frac-to-real r.= (r.% 1.0) %r %f] + ## [R;real real-to-deg deg-to-real r.= (r.% 1.0) %r %f] ) (test: "Simple macros and constructs" diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 20d72adf6..8b7267444 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -26,7 +26,7 @@ ["Nat" R;nat Eq Ord] ["Int" R;int Eq Ord] ["Real" R;real Eq Ord] - ["Frac" R;frac Eq Ord] + ["Deg" R;deg Eq Ord] ) (do-template [category rand-gen ] @@ -39,14 +39,14 @@ (not (= x (negate x)))) (= x (negate (negate x))) ## There is loss of precision when multiplying - (or (Text/= "Frac" category) + (or (Text/= "Deg" category) (= x (* (signum x) (abs x)))))))] ## ["Nat" R;nat Number] ["Int" R;int Number] ["Real" R;real Number] - ["Frac" R;frac Number] + ["Deg" R;deg Number] ) (do-template [category rand-gen ] @@ -79,7 +79,7 @@ ["Int" R;int Number Bounded (lambda [_] true)] ## Both min and max values will be positive (thus, greater than zero) ["Real" R;real Number Bounded (r.> 0.0)] - ["Frac" R;frac Number Bounded (lambda [_] true)] + ["Deg" R;deg Number Bounded (lambda [_] true)] ) (do-template [category rand-gen ] @@ -104,10 +104,10 @@ ["Real/Mul" R;real Number Mul@Monoid (r.% 1000.0) (r.> 0.0)] ["Real/Min" R;real Number Min@Monoid (r.% 1000.0) (r.> 0.0)] ["Real/Max" R;real Number Max@Monoid (r.% 1000.0) (r.> 0.0)] - ["Frac/Add" R;frac Number Add@Monoid (f.% .125) (lambda [_] true)] - ## ["Frac/Mul" R;frac Number Mul@Monoid (f.% .125) (lambda [_] true)] - ["Frac/Min" R;frac Number Min@Monoid (f.% .125) (lambda [_] true)] - ["Frac/Max" R;frac Number Max@Monoid (f.% .125) (lambda [_] true)] + ["Deg/Add" R;deg Number Add@Monoid (d.% .125) (lambda [_] true)] + ## ["Deg/Mul" R;deg Number Mul@Monoid (d.% .125) (lambda [_] true)] + ["Deg/Min" R;deg Number Min@Monoid (d.% .125) (lambda [_] true)] + ["Deg/Max" R;deg Number Max@Monoid (d.% .125) (lambda [_] true)] ) (do-template [ ] @@ -126,7 +126,7 @@ ["Nat" R;nat Number Codec] ["Int" R;int Number Codec] ["Real" R;real Number Codec] - ["Frac" R;frac Number Codec] + ["Deg" R;deg Number Codec] ) (do-template [ ] diff --git a/stdlib/test/test/lux/data/struct/tree.lux b/stdlib/test/test/lux/data/struct/tree.lux deleted file mode 100644 index 91a81355e..000000000 --- a/stdlib/test/test/lux/data/struct/tree.lux +++ /dev/null @@ -1,40 +0,0 @@ -## 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 (struct ["&" tree] - [list "List/" Monad]) - [number]) - ["R" random] - pipe) - lux/test) - -(def: gen-nat - (R;Random Nat) - (|> R;nat - (:: R;Monad map (n.% +100)))) - -(test: "Trees" - [leaf (:: @ map &;leaf R;nat) - branchS gen-nat - branchV R;nat - branchC (R;list branchS R;nat) - #let [branch (&;branch branchV (List/map &;leaf branchC))] - #let [(^open "&/") (&;Eq number;Eq) - (^open "List/") (list;Eq number;Eq)]] - ($_ seq - (assert "Can compare trees for equality." - (and (&/= leaf leaf) - (&/= branch branch) - (not (&/= leaf branch)) - (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC))))))) - - (assert "Can flatten a tree to get all the nodes as a flat tree." - (List/= (list& branchV branchC) - (&;flatten branch))) - )) diff --git a/stdlib/test/test/lux/data/struct/tree/rose.lux b/stdlib/test/test/lux/data/struct/tree/rose.lux new file mode 100644 index 000000000..21592aba9 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/tree/rose.lux @@ -0,0 +1,40 @@ +## 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 (struct (tree ["&" rose]) + [list "List/" Monad]) + [number]) + ["R" random] + pipe) + lux/test) + +(def: gen-nat + (R;Random Nat) + (|> R;nat + (:: R;Monad map (n.% +100)))) + +(test: "Trees" + [leaf (:: @ map &;leaf R;nat) + branchS gen-nat + branchV R;nat + branchC (R;list branchS R;nat) + #let [branch (&;branch branchV (List/map &;leaf branchC))] + #let [(^open "&/") (&;Eq number;Eq) + (^open "List/") (list;Eq number;Eq)]] + ($_ seq + (assert "Can compare trees for equality." + (and (&/= leaf leaf) + (&/= branch branch) + (not (&/= leaf branch)) + (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC))))))) + + (assert "Can flatten a tree to get all the nodes as a flat tree." + (List/= (list& branchV branchC) + (&;flatten branch))) + )) diff --git a/stdlib/test/test/lux/data/struct/tree/zipper.lux b/stdlib/test/test/lux/data/struct/tree/zipper.lux new file mode 100644 index 000000000..f2d7fe708 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/tree/zipper.lux @@ -0,0 +1,128 @@ +## 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 (struct [list "List/" Fold Functor] + (tree ["&" zipper] + [rose])) + [text "Text/" Monoid] + text/format + [number]) + (codata function) + ["R" random] + pipe) + lux/test) + +(def: gen-tree + (R;Random (rose;Tree Nat)) + (R;rec (lambda [gen-tree] + (do R;Monad + ## Each branch can have, at most, 1 child. + [size (|> R;nat (:: @ map (n.% +2)))] + (R;seq R;nat + (R;list size gen-tree)))))) + +(def: (to-end zipper) + (All [a] (-> (&;Zipper a) (&;Zipper a))) + (loop [zipper zipper] + (if (&;end? zipper) + zipper + (recur (&;next zipper))))) + +(test: "Zippers" + [sample gen-tree + new-val R;nat + pre-val R;nat + post-val R;nat + #let [(^open "Tree/") (rose;Eq number;Eq) + (^open "List/") (list;Eq number;Eq)]] + ($_ seq + (assert "Trees can be converted to/from zippers." + (|> sample + &;from-tree &;to-tree + (Tree/= sample))) + + (assert "Creating a zipper gives you a root node." + (|> sample &;from-tree &;root?)) + + (assert "Can move down inside branches. Can move up from lower nodes." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [child (|> zipper &;down)] + (and (not (Tree/= sample (&;to-tree child))) + (|> child &;parent (default (undefined)) (is zipper)) + (|> child &;up (is zipper) not) + (|> child &;root (is zipper) not))) + (and (&;leaf? zipper) + (|> zipper (&;prepend-child new-val) &;branch?))))) + + (assert "Can prepend and append children." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [mid-val (|> zipper &;down &;value) + zipper (|> zipper + (&;prepend-child pre-val) + (&;append-child post-val))] + (and (|> zipper &;down &;value (is pre-val)) + (|> zipper &;down &;right &;value (is mid-val)) + (|> zipper &;down &;right &;right &;value (is post-val)) + (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val)) + (|> zipper &;down &;right &;left &;value (is pre-val)) + (|> zipper &;down &;rightmost &;value (is post-val)))) + true))) + + (assert "Can insert children around a node (unless it's root)." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [mid-val (|> zipper &;down &;value) + zipper (|> zipper + &;down + (&;insert-left pre-val) + (default (undefined)) + (&;insert-right post-val) + (default (undefined)) + &;up)] + (and (|> zipper &;down &;value (is pre-val)) + (|> zipper &;down &;right &;value (is mid-val)) + (|> zipper &;down &;right &;right &;value (is post-val)) + (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val)) + (|> zipper &;down &;right &;left &;value (is pre-val)) + (|> zipper &;down &;rightmost &;value (is post-val)))) + (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false + #;None true)) + (|> zipper (&;insert-right post-val) (case> (#;Some _) false + #;None true)))))) + + (assert "Can set and update the value of a node." + (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) + + (assert "Zipper traversal follows the outline of the tree depth-first." + (List/= (rose;flatten sample) + (loop [zipper (&;from-tree sample)] + (if (&;end? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;next zipper))))))) + + (assert "Backwards zipper traversal yield reverse tree flatten." + (List/= (list;reverse (rose;flatten sample)) + (loop [zipper (to-end (&;from-tree sample))] + (if (&;root? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;prev zipper))))))) + + (assert "Can remove nodes (except root nodes)." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (and (|> zipper &;down &;root? not) + (|> zipper &;down &;remove (case> #;None false + (#;Some node) (&;root? node)))) + (|> zipper &;remove (case> #;None true + (#;Some _) false))))) + )) diff --git a/stdlib/test/test/lux/data/struct/zipper.lux b/stdlib/test/test/lux/data/struct/zipper.lux deleted file mode 100644 index 37ada2859..000000000 --- a/stdlib/test/test/lux/data/struct/zipper.lux +++ /dev/null @@ -1,128 +0,0 @@ -## 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 (struct ["&" zipper] - [tree] - [list "List/" Fold Functor]) - [text "Text/" Monoid] - text/format - [number]) - (codata function) - ["R" random] - pipe) - lux/test) - -(def: gen-tree - (R;Random (tree;Tree Nat)) - (R;rec (lambda [gen-tree] - (do R;Monad - ## Each branch can have, at most, 1 child. - [size (|> R;nat (:: @ map (n.% +2)))] - (R;seq R;nat - (R;list size gen-tree)))))) - -(def: (to-end zipper) - (All [a] (-> (&;Zipper a) (&;Zipper a))) - (loop [zipper zipper] - (if (&;end? zipper) - zipper - (recur (&;next zipper))))) - -(test: "Zippers" - [sample gen-tree - new-val R;nat - pre-val R;nat - post-val R;nat - #let [(^open "Tree/") (tree;Eq number;Eq) - (^open "List/") (list;Eq number;Eq)]] - ($_ seq - (assert "Trees can be converted to/from zippers." - (|> sample - &;from-tree &;to-tree - (Tree/= sample))) - - (assert "Creating a zipper gives you a root node." - (|> sample &;from-tree &;root?)) - - (assert "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [child (|> zipper &;down)] - (and (not (Tree/= sample (&;to-tree child))) - (|> child &;parent (default (undefined)) (is zipper)) - (|> child &;up (is zipper) not) - (|> child &;root (is zipper) not))) - (and (&;leaf? zipper) - (|> zipper (&;prepend-child new-val) &;branch?))))) - - (assert "Can prepend and append children." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) - zipper (|> zipper - (&;prepend-child pre-val) - (&;append-child post-val))] - (and (|> zipper &;down &;value (is pre-val)) - (|> zipper &;down &;right &;value (is mid-val)) - (|> zipper &;down &;right &;right &;value (is post-val)) - (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val)) - (|> zipper &;down &;right &;left &;value (is pre-val)) - (|> zipper &;down &;rightmost &;value (is post-val)))) - true))) - - (assert "Can insert children around a node (unless it's root)." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) - zipper (|> zipper - &;down - (&;insert-left pre-val) - (default (undefined)) - (&;insert-right post-val) - (default (undefined)) - &;up)] - (and (|> zipper &;down &;value (is pre-val)) - (|> zipper &;down &;right &;value (is mid-val)) - (|> zipper &;down &;right &;right &;value (is post-val)) - (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val)) - (|> zipper &;down &;right &;left &;value (is pre-val)) - (|> zipper &;down &;rightmost &;value (is post-val)))) - (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false - #;None true)) - (|> zipper (&;insert-right post-val) (case> (#;Some _) false - #;None true)))))) - - (assert "Can set and update the value of a node." - (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) - - (assert "Zipper traversal follows the outline of the tree depth-first." - (List/= (tree;flatten sample) - (loop [zipper (&;from-tree sample)] - (if (&;end? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) - - (assert "Backwards zipper traversal yield reverse tree flatten." - (List/= (list;reverse (tree;flatten sample)) - (loop [zipper (to-end (&;from-tree sample))] - (if (&;root? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) - - (assert "Can remove nodes (except root nodes)." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (and (|> zipper &;down &;root? not) - (|> zipper &;down &;remove (case> #;None false - (#;Some node) (&;root? node)))) - (|> zipper &;remove (case> #;None true - (#;Some _) false))))) - )) diff --git a/stdlib/test/test/lux/lexer/regex.lux b/stdlib/test/test/lux/lexer/regex.lux new file mode 100644 index 000000000..4a9f01c27 --- /dev/null +++ b/stdlib/test/test/lux/lexer/regex.lux @@ -0,0 +1,274 @@ +## 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 [error #- fail] + [product] + [text "T/" Eq] + text/format) + [compiler] + (macro [ast] + ["s" syntax #+ syntax:]) + ["R" random] + pipe + [lexer] + (lexer ["&" regex])) + lux/test) + +## [Utils] +(def: (should-pass regex input) + (-> (lexer;Lexer Text) Text Bool) + (|> (lexer;run input regex) + (case> (#;Right parsed) + (T/= parsed input) + + _ + false))) + +(def: (should-passT test regex input) + (-> Text (lexer;Lexer Text) Text Bool) + (|> (lexer;run input regex) + (case> (#;Right parsed) + (T/= test parsed) + + _ + false))) + +(def: (should-fail regex input) + (All [a] (-> (lexer;Lexer a) Text Bool)) + (|> (lexer;run input regex) + (case> (#;Left _) true _ false))) + +(syntax: (should-check pattern regex input) + (wrap (list (` (|> (lexer;run (~ input) (~ regex)) + (case> (^ (#;Right (~ pattern))) + true + + (~' _) + false)))))) + +## [Tests] +(test: "Regular Expressions [Basics]" + (assert "Can parse character literals." + (and (should-pass (&;regex "a") "a") + (should-fail (&;regex "a") ".") + (should-pass (&;regex "\\.") ".") + (should-fail (&;regex "\\.") "a")))) + +(test: "Regular Expressions [System character classes]" + ($_ seq + (assert "Can parse anything." + (should-pass (&;regex ".") "a")) + + (assert "Can parse digits." + (and (should-pass (&;regex "\\d") "0") + (should-fail (&;regex "\\d") "m"))) + + (assert "Can parse non digits." + (and (should-pass (&;regex "\\D") "m") + (should-fail (&;regex "\\D") "0"))) + + (assert "Can parse white-space." + (and (should-pass (&;regex "\\s") " ") + (should-fail (&;regex "\\s") "m"))) + + (assert "Can parse non white-space." + (and (should-pass (&;regex "\\S") "m") + (should-fail (&;regex "\\S") " "))) + + (assert "Can parse word characters." + (and (should-pass (&;regex "\\w") "_") + (should-fail (&;regex "\\w") "^"))) + + (assert "Can parse non word characters." + (and (should-pass (&;regex "\\W") ".") + (should-fail (&;regex "\\W") "a"))) + )) + +(test: "Regular Expressions [Special system character classes : Part 1]" + ($_ seq + (assert "Can parse using special character classes." + (and (and (should-pass (&;regex "\\p{Lower}") "m") + (should-fail (&;regex "\\p{Lower}") "M")) + + (and (should-pass (&;regex "\\p{Upper}") "M") + (should-fail (&;regex "\\p{Upper}") "m")) + + (and (should-pass (&;regex "\\p{Alpha}") "M") + (should-fail (&;regex "\\p{Alpha}") "0")) + + (and (should-pass (&;regex "\\p{Digit}") "1") + (should-fail (&;regex "\\p{Digit}") "n")) + + (and (should-pass (&;regex "\\p{Alnum}") "1") + (should-fail (&;regex "\\p{Alnum}") ".")) + + (and (should-pass (&;regex "\\p{Space}") " ") + (should-fail (&;regex "\\p{Space}") ".")) + )) + )) + +(test: "Regular Expressions [Special system character classes : Part 2]" + ($_ seq + (assert "Can parse using special character classes." + (and (and (should-pass (&;regex "\\p{HexDigit}") "a") + (should-fail (&;regex "\\p{HexDigit}") ".")) + + (and (should-pass (&;regex "\\p{OctDigit}") "6") + (should-fail (&;regex "\\p{OctDigit}") ".")) + + (and (should-pass (&;regex "\\p{Blank}") "\t") + (should-fail (&;regex "\\p{Blank}") ".")) + + (and (should-pass (&;regex "\\p{ASCII}") "\t") + (should-fail (&;regex "\\p{ASCII}") "\u1234")) + + (and (should-pass (&;regex "\\p{Contrl}") "\u0012") + (should-fail (&;regex "\\p{Contrl}") "a")) + + (and (should-pass (&;regex "\\p{Punct}") "@") + (should-fail (&;regex "\\p{Punct}") "a")) + + (and (should-pass (&;regex "\\p{Graph}") "@") + (should-fail (&;regex "\\p{Graph}") " ")) + + (and (should-pass (&;regex "\\p{Print}") "\u0020") + (should-fail (&;regex "\\p{Print}") "\u1234")) + )) + )) + +(test: "Regular Expressions [Custom character classes : Part 1]" + ($_ seq + (assert "Can parse using custom character classes." + (and (should-pass (&;regex "[abc]") "a") + (should-fail (&;regex "[abc]") "m"))) + + (assert "Can parse using character ranges." + (and (should-pass (&;regex "[a-z]") "a") + (should-pass (&;regex "[a-z]") "m") + (should-pass (&;regex "[a-z]") "z"))) + + (assert "Can combine character ranges." + (and (should-pass (&;regex "[a-zA-Z]") "a") + (should-pass (&;regex "[a-zA-Z]") "m") + (should-pass (&;regex "[a-zA-Z]") "z") + (should-pass (&;regex "[a-zA-Z]") "A") + (should-pass (&;regex "[a-zA-Z]") "M") + (should-pass (&;regex "[a-zA-Z]") "Z"))) + )) + +(test: "Regular Expressions [Custom character classes : Part 2]" + ($_ seq + (assert "Can negate custom character classes." + (and (should-fail (&;regex "[^abc]") "a") + (should-pass (&;regex "[^abc]") "m"))) + + (assert "Can negate character ranges.." + (and (should-fail (&;regex "[^a-z]") "a") + (should-pass (&;regex "[^a-z]") "0"))) + + (assert "Can parse negate combinations of character ranges." + (and (should-fail (&;regex "[^a-zA-Z]") "a") + (should-pass (&;regex "[^a-zA-Z]") "0"))) + )) + +(test: "Regular Expressions [Custom character classes : Part 3]" + ($_ seq + (assert "Can make custom character classes more specific." + (and (let [RE (&;regex "[a-z&&[def]]")] + (and (should-fail RE "a") + (should-pass RE "d"))) + + (let [RE (&;regex "[a-z&&[^bc]]")] + (and (should-pass RE "a") + (should-fail RE "b"))) + + (let [RE (&;regex "[a-z&&[^m-p]]")] + (and (should-pass RE "a") + (should-fail RE "m") + (should-fail RE "p"))))) + )) + +(test: "Regular Expressions [Reference]" + (let [number (&;regex "\\d+")] + (assert "Can build complex regexs by combining simpler ones." + (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@)-(\\@)-(\\@)") "809-345-6789")))) + +(test: "Regular Expressions [Fuzzy Quantifiers]" + ($_ seq + (assert "Can sequentially combine patterns." + (should-passT "aa" (&;regex "aa") "aa")) + + (assert "Can match patterns optionally." + (and (should-passT "a" (&;regex "a?") "a") + (should-passT "" (&;regex "a?") ""))) + + (assert "Can match a pattern 0 or more times." + (and (should-passT "aaa" (&;regex "a*") "aaa") + (should-passT "" (&;regex "a*") ""))) + + (assert "Can match a pattern 1 or more times." + (and (should-passT "aaa" (&;regex "a+") "aaa") + (should-passT "a" (&;regex "a+") "a") + (should-fail (&;regex "a+") ""))) + )) + +(test: "Regular Expressions [Crisp Quantifiers]" + ($_ seq + (assert "Can match a pattern N times." + (and (should-passT "aa" (&;regex "a{2}") "aa") + (should-passT "a" (&;regex "a{1}") "aa") + (should-fail (&;regex "a{3}") "aa"))) + + (assert "Can match a pattern at-least N times." + (and (should-passT "aa" (&;regex "a{1,}") "aa") + (should-passT "aa" (&;regex "a{2,}") "aa") + (should-fail (&;regex "a{3,}") "aa"))) + + (assert "Can match a pattern at-most N times." + (and (should-passT "a" (&;regex "a{,1}") "aa") + (should-passT "aa" (&;regex "a{,2}") "aa") + (should-passT "aa" (&;regex "a{,3}") "aa"))) + + (assert "Can match a pattern between N and M times." + (and (should-passT "a" (&;regex "a{1,2}") "a") + (should-passT "aa" (&;regex "a{1,2}") "aa") + (should-passT "aa" (&;regex "a{1,2}") "aaa"))) + )) + +(test: "Regular Expressions [Groups]" + ($_ seq + (assert "Can extract groups of sub-matches specified in a pattern." + (and (should-check ["abc" "b"] (&;regex "a(.)c") "abc") + (should-check ["abbbbbc" "bbbbb"] (&;regex "a(b+)c") "abbbbbc") + (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-345-6789" "809" "6789"] (&;regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-809-6789" "809" "6789"] (&;regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789" "809" "6789"] (&;regex "(?\\d{3})-\\k-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (&;regex "(?\\d{3})-\\k-(\\d{4})-\\0") "809-809-6789-6789"))) + + (assert "Can specify groups within groups." + (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) + )) + +(test: "Regular Expressions [Alternation]" + ($_ seq + (assert "Can specify alternative patterns." + (and (should-check ["a" (+0 [])] (&;regex "a|b") "a") + (should-check ["b" (+1 [])] (&;regex "a|b") "b") + (should-fail (&;regex "a|b") "c"))) + + (assert "Can have groups within alternations." + (and (should-check ["abc" (+0 ["b" "c"])] (&;regex "a(.)(.)|b(.)(.)") "abc") + (should-check ["bcd" (+1 ["c" "d"])] (&;regex "a(.)(.)|b(.)(.)") "bcd") + (should-fail (&;regex "a(.)(.)|b(.)(.)") "cde") + + (should-check ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] + (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") + "809-345-6789"))) + )) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 1fabb09ad..2755bbf8e 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -79,7 +79,7 @@ ["Can parse Bool syntax." true ast;bool bool;Eq s;bool] ["Can parse Nat syntax." +123 ast;nat number;Eq s;nat] ["Can parse Int syntax." 123 ast;int number;Eq s;int] - ["Can parse Frac syntax." .123 ast;frac number;Eq s;frac] + ["Can parse Deg syntax." .123 ast;deg number;Eq s;deg] ["Can parse Real syntax." 123.0 ast;real number;Eq s;real] ["Can parse Char syntax." #"\n" ast;char char;Eq s;char] ["Can parse Text syntax." "\n" ast;text text;Eq s;text] diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux index bfa313708..235723f25 100644 --- a/stdlib/test/test/lux/math/simple.lux +++ b/stdlib/test/test/lux/math/simple.lux @@ -40,7 +40,7 @@ ["Nat" R;nat n.= n.+ n.- n.* n./ n.% +0] ["Int" R;int i.= i.+ i.- i.* i./ i.% 0] ["Real" R;real r.= r.+ r.- r.* r./ r.% 0.0] - ## ["Frac" R;frac f.= f.+ f.- f.* f./ f.% .0] + ["Deg" R;deg d.= d.+ d.- d.* d./ d.% .0] ) (do-template [ ] @@ -61,7 +61,7 @@ ["Nat" R;nat n.< n.<= n.> n.>=] ["Int" R;int i.< i.<= i.> i.>=] ["Real" R;real r.< r.<= r.> r.>=] - ## ["Frac" R;frac f.< f.<= f.> f.>=] + ["Deg" R;deg d.< d.<= d.> d.>=] ) (do-template [ <=> ] diff --git a/stdlib/test/test/lux/regex.lux b/stdlib/test/test/lux/regex.lux deleted file mode 100644 index 6c6854ce0..000000000 --- a/stdlib/test/test/lux/regex.lux +++ /dev/null @@ -1,274 +0,0 @@ -## 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 [error #- fail] - [product] - [text "T/" Eq] - text/format) - [compiler] - (macro [ast] - ["s" syntax #+ syntax:]) - ["R" random] - pipe - [lexer] - ["&" regex]) - lux/test) - -## [Utils] -(def: (should-pass regex input) - (-> (lexer;Lexer Text) Text Bool) - (|> (lexer;run input regex) - (case> (#;Right parsed) - (T/= parsed input) - - _ - false))) - -(def: (should-passT test regex input) - (-> Text (lexer;Lexer Text) Text Bool) - (|> (lexer;run input regex) - (case> (#;Right parsed) - (T/= test parsed) - - _ - false))) - -(def: (should-fail regex input) - (All [a] (-> (lexer;Lexer a) Text Bool)) - (|> (lexer;run input regex) - (case> (#;Left _) true _ false))) - -(syntax: (should-check pattern regex input) - (wrap (list (` (|> (lexer;run (~ input) (~ regex)) - (case> (^ (#;Right (~ pattern))) - true - - (~' _) - false)))))) - -## [Tests] -(test: "Regular Expressions [Basics]" - (assert "Can parse character literals." - (and (should-pass (&;regex "a") "a") - (should-fail (&;regex "a") ".") - (should-pass (&;regex "\\.") ".") - (should-fail (&;regex "\\.") "a")))) - -(test: "Regular Expressions [System character classes]" - ($_ seq - (assert "Can parse anything." - (should-pass (&;regex ".") "a")) - - (assert "Can parse digits." - (and (should-pass (&;regex "\\d") "0") - (should-fail (&;regex "\\d") "m"))) - - (assert "Can parse non digits." - (and (should-pass (&;regex "\\D") "m") - (should-fail (&;regex "\\D") "0"))) - - (assert "Can parse white-space." - (and (should-pass (&;regex "\\s") " ") - (should-fail (&;regex "\\s") "m"))) - - (assert "Can parse non white-space." - (and (should-pass (&;regex "\\S") "m") - (should-fail (&;regex "\\S") " "))) - - (assert "Can parse word characters." - (and (should-pass (&;regex "\\w") "_") - (should-fail (&;regex "\\w") "^"))) - - (assert "Can parse non word characters." - (and (should-pass (&;regex "\\W") ".") - (should-fail (&;regex "\\W") "a"))) - )) - -(test: "Regular Expressions [Special system character classes : Part 1]" - ($_ seq - (assert "Can parse using special character classes." - (and (and (should-pass (&;regex "\\p{Lower}") "m") - (should-fail (&;regex "\\p{Lower}") "M")) - - (and (should-pass (&;regex "\\p{Upper}") "M") - (should-fail (&;regex "\\p{Upper}") "m")) - - (and (should-pass (&;regex "\\p{Alpha}") "M") - (should-fail (&;regex "\\p{Alpha}") "0")) - - (and (should-pass (&;regex "\\p{Digit}") "1") - (should-fail (&;regex "\\p{Digit}") "n")) - - (and (should-pass (&;regex "\\p{Alnum}") "1") - (should-fail (&;regex "\\p{Alnum}") ".")) - - (and (should-pass (&;regex "\\p{Space}") " ") - (should-fail (&;regex "\\p{Space}") ".")) - )) - )) - -(test: "Regular Expressions [Special system character classes : Part 2]" - ($_ seq - (assert "Can parse using special character classes." - (and (and (should-pass (&;regex "\\p{HexDigit}") "a") - (should-fail (&;regex "\\p{HexDigit}") ".")) - - (and (should-pass (&;regex "\\p{OctDigit}") "6") - (should-fail (&;regex "\\p{OctDigit}") ".")) - - (and (should-pass (&;regex "\\p{Blank}") "\t") - (should-fail (&;regex "\\p{Blank}") ".")) - - (and (should-pass (&;regex "\\p{ASCII}") "\t") - (should-fail (&;regex "\\p{ASCII}") "\u1234")) - - (and (should-pass (&;regex "\\p{Contrl}") "\u0012") - (should-fail (&;regex "\\p{Contrl}") "a")) - - (and (should-pass (&;regex "\\p{Punct}") "@") - (should-fail (&;regex "\\p{Punct}") "a")) - - (and (should-pass (&;regex "\\p{Graph}") "@") - (should-fail (&;regex "\\p{Graph}") " ")) - - (and (should-pass (&;regex "\\p{Print}") "\u0020") - (should-fail (&;regex "\\p{Print}") "\u1234")) - )) - )) - -(test: "Regular Expressions [Custom character classes : Part 1]" - ($_ seq - (assert "Can parse using custom character classes." - (and (should-pass (&;regex "[abc]") "a") - (should-fail (&;regex "[abc]") "m"))) - - (assert "Can parse using character ranges." - (and (should-pass (&;regex "[a-z]") "a") - (should-pass (&;regex "[a-z]") "m") - (should-pass (&;regex "[a-z]") "z"))) - - (assert "Can combine character ranges." - (and (should-pass (&;regex "[a-zA-Z]") "a") - (should-pass (&;regex "[a-zA-Z]") "m") - (should-pass (&;regex "[a-zA-Z]") "z") - (should-pass (&;regex "[a-zA-Z]") "A") - (should-pass (&;regex "[a-zA-Z]") "M") - (should-pass (&;regex "[a-zA-Z]") "Z"))) - )) - -(test: "Regular Expressions [Custom character classes : Part 2]" - ($_ seq - (assert "Can negate custom character classes." - (and (should-fail (&;regex "[^abc]") "a") - (should-pass (&;regex "[^abc]") "m"))) - - (assert "Can negate character ranges.." - (and (should-fail (&;regex "[^a-z]") "a") - (should-pass (&;regex "[^a-z]") "0"))) - - (assert "Can parse negate combinations of character ranges." - (and (should-fail (&;regex "[^a-zA-Z]") "a") - (should-pass (&;regex "[^a-zA-Z]") "0"))) - )) - -(test: "Regular Expressions [Custom character classes : Part 3]" - ($_ seq - (assert "Can make custom character classes more specific." - (and (let [RE (&;regex "[a-z&&[def]]")] - (and (should-fail RE "a") - (should-pass RE "d"))) - - (let [RE (&;regex "[a-z&&[^bc]]")] - (and (should-pass RE "a") - (should-fail RE "b"))) - - (let [RE (&;regex "[a-z&&[^m-p]]")] - (and (should-pass RE "a") - (should-fail RE "m") - (should-fail RE "p"))))) - )) - -(test: "Regular Expressions [Reference]" - (let [number (&;regex "\\d+")] - (assert "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@)-(\\@)-(\\@)") "809-345-6789")))) - -(test: "Regular Expressions [Fuzzy Quantifiers]" - ($_ seq - (assert "Can sequentially combine patterns." - (should-passT "aa" (&;regex "aa") "aa")) - - (assert "Can match patterns optionally." - (and (should-passT "a" (&;regex "a?") "a") - (should-passT "" (&;regex "a?") ""))) - - (assert "Can match a pattern 0 or more times." - (and (should-passT "aaa" (&;regex "a*") "aaa") - (should-passT "" (&;regex "a*") ""))) - - (assert "Can match a pattern 1 or more times." - (and (should-passT "aaa" (&;regex "a+") "aaa") - (should-passT "a" (&;regex "a+") "a") - (should-fail (&;regex "a+") ""))) - )) - -(test: "Regular Expressions [Crisp Quantifiers]" - ($_ seq - (assert "Can match a pattern N times." - (and (should-passT "aa" (&;regex "a{2}") "aa") - (should-passT "a" (&;regex "a{1}") "aa") - (should-fail (&;regex "a{3}") "aa"))) - - (assert "Can match a pattern at-least N times." - (and (should-passT "aa" (&;regex "a{1,}") "aa") - (should-passT "aa" (&;regex "a{2,}") "aa") - (should-fail (&;regex "a{3,}") "aa"))) - - (assert "Can match a pattern at-most N times." - (and (should-passT "a" (&;regex "a{,1}") "aa") - (should-passT "aa" (&;regex "a{,2}") "aa") - (should-passT "aa" (&;regex "a{,3}") "aa"))) - - (assert "Can match a pattern between N and M times." - (and (should-passT "a" (&;regex "a{1,2}") "a") - (should-passT "aa" (&;regex "a{1,2}") "aa") - (should-passT "aa" (&;regex "a{1,2}") "aaa"))) - )) - -(test: "Regular Expressions [Groups]" - ($_ seq - (assert "Can extract groups of sub-matches specified in a pattern." - (and (should-check ["abc" "b"] (&;regex "a(.)c") "abc") - (should-check ["abbbbbc" "bbbbb"] (&;regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (&;regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (&;regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (&;regex "(?\\d{3})-\\k-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&;regex "(?\\d{3})-\\k-(\\d{4})-\\0") "809-809-6789-6789"))) - - (assert "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) - )) - -(test: "Regular Expressions [Alternation]" - ($_ seq - (assert "Can specify alternative patterns." - (and (should-check ["a" (+0 [])] (&;regex "a|b") "a") - (should-check ["b" (+1 [])] (&;regex "a|b") "b") - (should-fail (&;regex "a|b") "c"))) - - (assert "Can have groups within alternations." - (and (should-check ["abc" (+0 ["b" "c"])] (&;regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (+1 ["c" "d"])] (&;regex "a(.)(.)|b(.)(.)") "bcd") - (should-fail (&;regex "a(.)(.)|b(.)(.)") "cde") - - (should-check ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] - (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") - "809-345-6789"))) - )) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index c57ca61c5..8e0c165c1 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -15,7 +15,7 @@ ["_;" host] ["_;" pipe] ["_;" lexer] - ["_;" regex] + (lexer ["_;" regex]) (codata ["_;" io] ["_;" env] ["_;" state] @@ -47,9 +47,9 @@ [queue] [set] [stack] - [tree] ## [vector] - [zipper]) + (tree [rose] + [zipper])) (text [format]) ) ["_;" math] -- cgit v1.2.3