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/test/lux/abstract/predicate.lux | 18 ++-- stdlib/source/test/lux/control/exception.lux | 123 +++++++++++++++++++++----- 2 files changed, 113 insertions(+), 28 deletions(-) (limited to 'stdlib/source/test') 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