From ae72864af3e95e46a042277873d38c3006361c79 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 18 Apr 2020 04:06:01 -0400 Subject: Improved test for exceptions. --- stdlib/source/lux/control/continuation.lux | 2 +- stdlib/source/lux/control/exception.lux | 24 ++--- stdlib/source/lux/data/collection/list.lux | 2 +- stdlib/source/test/lux/abstract/predicate.lux | 18 ++-- stdlib/source/test/lux/control/exception.lux | 123 +++++++++++++++++++++----- 5 files changed, 128 insertions(+), 41 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index cd8f6a131..5bfe690e3 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -17,7 +17,7 @@ (-> (-> i o) o)) (def: #export (continue next cont) - {#.doc "Continues a thunk."} + {#.doc "Continues a continuation thunk."} (All [i o] (-> (-> i o) (Cont i o) o)) (cont next)) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 85236b6fa..53b770bcd 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -73,7 +73,7 @@ (def: #export (throw exception message) {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."} - (All [e] (-> (Exception e) e Try)) + (All [e a] (-> (Exception e) e (Try a))) (#//.Failure (construct exception message))) (def: #export (assert exception message test) @@ -114,7 +114,7 @@ (def: header-separator ": ") -(def: #export (report' entries) +(def: (report' entries) (-> (List [Text Text]) Text) (let [largest-header-size (|> entries (list@map (|>> product.left text.size)) @@ -136,15 +136,17 @@ (text.join-with text.new-line)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) - (wrap (list (` (report' (list (~+ (|> entries - (list@map (function (_ [header message]) - (` [(~ header) (~ message)]))))))))))) + (wrap (list (` ((~! report') (list (~+ (|> entries + (list@map (function (_ [header message]) + (` [(~ header) (~ message)]))))))))))) (def: separator - ($_ "lux text concat" - text.new-line text.new-line - (|> "-" (list.repeat 64) (text.join-with "")) - text.new-line text.new-line)) + (let [gap ($_ "lux text concat" text.new-line text.new-line) + horizontal-line (|> "-" (list.repeat 64) (text.join-with ""))] + ($_ "lux text concat" + gap + horizontal-line + gap))) (def: (decorate prelude error) (-> Text Text Text) @@ -167,11 +169,11 @@ success success)) -(def: #export (enumerate %entry) +(def: #export (enumerate format) (All [a] (-> (-> a Text) (-> (List a) Text))) (|>> list.enumerate (list@map (function (_ [index entry]) - ($_ text@compose (n@encode index) ": " (%entry entry)))) + ($_ text@compose (n@encode index) ": " (format entry)))) (text.join-with text.new-line))) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index dd8e3f09b..eaf7df755 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -210,7 +210,7 @@ (-> (-> a (Maybe b)) (List a) (List b))) (case xs #.Nil - #.None + #.Nil (#.Cons x xs') (case (check x) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index 946d8371e..fe942a044 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -4,6 +4,8 @@ [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] + [control + ["." function]] [data ["." bit ("#@." equivalence)] [text @@ -17,12 +19,16 @@ {1 ["." / (#+ Predicate)]}) +(def: (multiple? factor) + (-> Nat (/.Predicate Nat)) + (case factor + 0 (function.constant false) + _ (|>> (n.% factor) (n.= 0)))) + (def: #export test Test - (let [/2? (: (/.Predicate Nat) - (|>> (n.% 2) (n.= 0))) - /3? (: (/.Predicate Nat) - (|>> (n.% 3) (n.= 0)))] + (let [/2? (multiple? 2) + /3? (multiple? 3)] (<| (_.context (%.name (name-of /.Predicate))) (do r.monad [sample r.nat]) @@ -52,7 +58,9 @@ (bit@= (left sample) (right sample))))) generator (: (Random (/.Predicate Nat)) - (wrap /2?))] + (|> r.nat + (r.filter (|>> (n.= 0) not)) + (:: @ map multiple?)))] ($_ _.and (//monoid.spec equivalence /.union generator) (//monoid.spec equivalence /.intersection generator))) diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index fde485472..5d0fa3d47 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -2,38 +2,115 @@ [lux #* [abstract/monad (#+ do)] [data + ["." name] [number ["n" nat]] - [text + ["." text ("#@." equivalence) ["%" format (#+ format)]]] [math - ["r" random]] + ["." random]] ["_" test (#+ Test)]] {1 - ["." / (#+ exception:)]}) + ["." / (#+ exception:) + [// + ["." try (#+ Try)]]]}) (exception: an-exception) (exception: another-exception) +(def: label "YOLO") +(exception: (custom-exception {value Nat}) + (/.report [label (%.nat value)])) + (def: #export test - (do r.monad - [right r.nat - wrong (r.filter (|>> (n.= right) not) r.nat)] - (<| (_.context (%.name (name-of /.Exception))) + Test + (do random.monad + [expected random.nat + wrong (|> random.nat (random.filter (|>> (n.= expected) not))) + assertion-succeeded? random.bit + #let [report-element (:: @ map %.nat random.nat)] + field0 report-element + value0 report-element + field1 report-element + value1 report-element] + (<| (_.context (name.module (name-of /._))) ($_ _.and - (_.test "Can catch exceptions." - (n.= right - (|> (/.throw an-exception []) - (/.catch an-exception (function (_ ex) right)) - (/.otherwise (function (_ ex) wrong))))) - (_.test "Can catch multiple exceptions." - (n.= right - (|> (/.throw another-exception []) - (/.catch an-exception (function (_ ex) wrong)) - (/.catch another-exception (function (_ ex) right)) - (/.otherwise (function (_ ex) wrong))))) - (_.test "Can handle uncaught exceptions." - (n.= right - (|> (/.throw another-exception []) - (/.catch an-exception (function (_ ex) wrong)) - (/.otherwise (function (_ ex) right))))))))) + (_.test (%.name (name-of /.return)) + (case (/.return expected) + (#try.Success actual) (n.= expected actual) + (#try.Failure _) false)) + (_.test (%.name (name-of /.throw)) + (case (/.throw ..an-exception []) + (#try.Success _) false + (#try.Failure _) true)) + (_.test (%.name (name-of /.construct)) + (case (/.throw ..an-exception []) + (#try.Success _) + false + + (#try.Failure message) + (text@= message (/.construct ..an-exception [])))) + (_.test (%.name (name-of /.match?)) + (/.match? ..an-exception + (/.construct ..an-exception []))) + (_.test (%.name (name-of /.assert)) + (case (/.assert ..an-exception [] assertion-succeeded?) + (#try.Success _) + assertion-succeeded? + + (#try.Failure message) + (and (not assertion-succeeded?) + (text@= message (/.construct ..an-exception []))))) + (_.test (%.name (name-of /.catch)) + (and (n.= expected + (|> (/.throw ..an-exception []) + (/.catch ..an-exception (function (_ ex) expected)) + (/.otherwise (function (_ ex) wrong)))) + (n.= expected + (|> (/.throw ..another-exception []) + (/.catch ..an-exception (function (_ ex) wrong)) + (/.catch ..another-exception (function (_ ex) expected)) + (/.otherwise (function (_ ex) wrong)))))) + (_.test (%.name (name-of /.otherwise)) + (n.= expected + (|> (/.throw ..another-exception []) + (/.catch ..an-exception (function (_ ex) wrong)) + (/.otherwise (function (_ ex) expected))))) + (_.test (%.name (name-of /.report)) + (let [report (/.report [field0 value0] + [field1 value1])] + (and (text.contains? field0 report) + (text.contains? value0 report) + (text.contains? field1 report) + (text.contains? value1 report)))) + (_.test (%.name (name-of /.enumerate)) + (let [enumeration (/.enumerate %.text (list field0 value0 field1 value1))] + (and (text.contains? field0 enumeration) + (text.contains? value0 enumeration) + (text.contains? field1 enumeration) + (text.contains? value1 enumeration)))) + (_.test (%.name (name-of /.with)) + (and (case (/.with ..an-exception [] (#try.Success expected)) + (#try.Success actual) (n.= expected actual) + (#try.Failure _) false) + (case (/.with ..an-exception [] (#try.Failure "")) + (#try.Success _) false + (#try.Failure message) (text@= message (/.construct ..an-exception []))) + (case (/.with ..an-exception [] + (: (Try Nat) + (/.throw ..another-exception []))) + (#try.Success _) + false + + (#try.Failure message) + (and (text.contains? (/.construct ..an-exception []) message) + (text.contains? (/.construct ..another-exception []) message))))) + (_.test (%.name (name-of /.exception:)) + (case (/.throw ..custom-exception [expected]) + (#try.Success _) + false + + (#try.Failure message) + (and (text.contains? ..label message) + (text.contains? (%.nat expected) message)))) + )))) -- cgit v1.2.3