├── .github └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE ├── LSpec.lean ├── LSpec ├── Examples.lean ├── Instances.lean ├── LSpec.lean ├── SlimCheck │ ├── Checkable.lean │ ├── Control │ │ ├── DefaultRange.lean │ │ └── Random.lean │ ├── Gen.lean │ └── Sampleable.lean └── Testing.lean ├── README.md ├── flake.lock ├── flake.nix ├── lake-manifest.json ├── lakefile.toml └── lean-toolchain /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI Tests 2 | 3 | on: 4 | push: 5 | branches: main 6 | pull_request: 7 | workflow_dispatch: 8 | 9 | concurrency: 10 | group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }} 11 | cancel-in-progress: true 12 | 13 | jobs: 14 | lean: 15 | name: Lean Build 16 | runs-on: ubuntu-latest 17 | steps: 18 | - uses: actions/checkout@v4 19 | - uses: leanprover/lean-action@v1 20 | with: 21 | build-args: "--wfail" 22 | 23 | nix: 24 | name: Nix Flake Check 25 | runs-on: ubuntu-latest 26 | steps: 27 | - uses: actions/checkout@v4 28 | - uses: cachix/install-nix-action@v30 29 | with: 30 | nix_path: nixpkgs=channel:nixos-unstable 31 | github_access_token: ${{ secrets.GITHUB_TOKEN }} 32 | - uses: cachix/cachix-action@v14 33 | with: 34 | name: argumentcomputer 35 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' 36 | - run: nix build 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | /lake-packages 3 | .lake/ 4 | /result* 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Yatima Inc. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /LSpec.lean: -------------------------------------------------------------------------------- 1 | import LSpec.LSpec 2 | import LSpec.Instances 3 | import LSpec.SlimCheck.Checkable 4 | -------------------------------------------------------------------------------- /LSpec/Examples.lean: -------------------------------------------------------------------------------- 1 | import LSpec 2 | 3 | section LSpec 4 | /- In this section we demonstrate the basic usage of `LSpec`. -/ 5 | 6 | open LSpec 7 | 8 | /- The simplest way to invoke `LSpec` is in a file via the `#lspec` command -/ 9 | #lspec test "Nat equality" (4 ≠ 5) 10 | 11 | /- 12 | `#lspec` runs a sequence of tests which are encoded with the inductive type `TestSeq` which allows 13 | for tests to be composable 14 | -/ 15 | #lspec test "bool equality" (42 == 42) $ 16 | test "list length" ([42].length = 2) $ 17 | test "list nonempty" ¬ [42].isEmpty 18 | 19 | /- 20 | Tests that can be tested are of the `Testable` typeclass, which have a low-priority instance 21 | `(p : Prop) : Decidable p → Testable p` which can be over-ridden to allow for more intricate 22 | failure or success messages. 23 | 24 | This instance is generic enough that tests like `∀ n, n < 10 → n - 5 < 5` can be evaluated 25 | -/ 26 | #lspec test "all lt" $ ∀ n, n < 10 → n - 5 < 5 27 | 28 | /- 29 | There are even more ways to invoke LSpec tests (`lspecEachIO` for example) for more intricate moandic 30 | testing 31 | -/ 32 | 33 | end LSpec 34 | 35 | section SlimCheck 36 | /- 37 | In this section we demonstrate the usage of `SlimCheck` in the Lspec library. 38 | -/ 39 | 40 | open LSpec SlimCheck 41 | 42 | /- 43 | In this case `Nat` has a `SampleableExt` instance which allows the below examples to be run 44 | -/ 45 | example : SampleableExt Nat := by infer_instance 46 | 47 | /- SlimCheck tests are invoked with `check`, and are composable in the same way `test` is -/ 48 | #lspec check "add_comm" (∀ n m : Nat, n + m = m + n) $ 49 | check "mul_comm" $ ∀ n m : Nat, n * m = m * m 50 | -- ? add_comm 51 | -- × mul_comm 52 | 53 | -- =================== 54 | -- Found problems! 55 | -- n := 1 56 | -- m := 2 57 | -- issue: 2 = 4 does not hold 58 | -- (2 shrinks) 59 | -- ------------------- 60 | /- 61 | We can also apply Slimcheck to custom structures if we define the appropriate instances 62 | -/ 63 | structure Pairs where 64 | left : Nat 65 | right : Nat 66 | deriving Repr 67 | 68 | private def mkPairs (as : List α) (bs : List β) : List (α × β) := 69 | let mkPairsAux (a : α) (bs : List β) : List (α × β) := bs.map fun b => (a, b) 70 | as.foldl (fun abs a => mkPairsAux a bs ++ abs) [] 71 | 72 | /- An instance of `Shrinkable` is needed -/ 73 | open Shrinkable in 74 | instance : Shrinkable Pairs where 75 | shrink := fun p => 76 | let shrinkl := shrink p.left 77 | let shrinkr := shrink p.right 78 | mkPairs shrinkl shrinkr |>.map fun (a, b) => ⟨a, b⟩ 79 | 80 | /- 81 | As is one for `SampleableExt`. 82 | 83 | In both of these cases we are using the instances already written for more primitive types like 84 | `Nat`, but it's possible to write a these instances by hand if we want more fine-grained behavior. 85 | -/ 86 | open SampleableExt 87 | 88 | def pairsGen : Gen Pairs := return ⟨← Gen.chooseAny Nat, ← Gen.chooseAny Nat⟩ 89 | 90 | /- 91 | To generate the instance of `SampleableExt α` we use the `mkSelfContained` function which relies only 92 | on having a `Gen α`. 93 | 94 | It is possible to define more tailored instances of `SampleableExt` by writing it by hand. 95 | -/ 96 | instance : SampleableExt Pairs := mkSelfContained pairsGen 97 | 98 | /- Now we can conduct the tests just as we did before for `Nat` -/ 99 | #lspec check "left + 2 is less than right" $ ∀ pair : Pairs, pair.left + 2 ≤ pair.right 100 | 101 | /- 102 | You always have to be careful with your implementation for `shrink` and `SampleableExt` because 103 | Slimcheck may not flag tests that should fail, in this case `⟨0, 0⟩` should fail the test but 104 | isn't detected 105 | -/ 106 | #lspec check "left + right > right" $ ∀ pair : Pairs, pair.left + pair.right > pair.right 107 | 108 | end SlimCheck 109 | -------------------------------------------------------------------------------- /LSpec/Instances.lean: -------------------------------------------------------------------------------- 1 | import LSpec.LSpec 2 | 3 | namespace LSpec 4 | 5 | instance (priority := 50) (x y : α) [DecidableEq α] [Repr α] : Testable (x = y) := 6 | if h : x = y then 7 | .isTrue h 8 | else 9 | .isFalse h $ s!"Expected to be equal: '{repr x}' and '{repr y}'" 10 | 11 | instance (priority := 50) (x y : α) [BEq α] [Repr α] : Testable (x == y) := 12 | if h : x == y then 13 | .isTrue h 14 | else 15 | .isFalse h $ s!"Expected to be equal: '{repr x}' and '{repr y}'" 16 | 17 | instance (priority := 50) (x y : α) [DecidableEq α] [Repr α] : Testable (x ≠ y) := 18 | if h : x ≠ y then 19 | .isTrue h 20 | else 21 | .isFalse h s!"Expected to be different but both equal to '{repr x}'" 22 | 23 | instance (priority := 50) (x y : α) [BEq α] [Repr α] : Testable (x != y) := 24 | if h : x != y then 25 | .isTrue h 26 | else 27 | .isFalse h s!"Expected to be different but both equal to '{repr x}'" 28 | 29 | /-- 30 | A fancier example of `Testable` instance that allows us to write: 31 | ```lean 32 | #lspec test "forall n < 10, n - 5 < 5" $ ∀ n, n < 10 → n - 5 < 5 33 | ``` 34 | -/ 35 | instance Nat.Testable_forall_lt 36 | (b : Nat) (p : Nat → Prop) 37 | [d : (n : Nat) → Testable (p n)] : 38 | Testable (∀ n, n < b → p n) := 39 | match b with 40 | | 0 => .isTrue (by simp [Nat.not_lt_zero]) 41 | | b + 1 => 42 | match Testable_forall_lt b p with 43 | | .isTrue h => 44 | match d b with 45 | | .isTrue hb => 46 | .isTrue $ by 47 | intros n hn 48 | cases Nat.eq_or_lt_of_le (Nat.le_of_lt_succ hn) with 49 | | inl hl => cases hl; assumption 50 | | inr => apply h; assumption 51 | | .isMaybe msg => .isMaybe msg 52 | | .isFalse hb msg => 53 | .isFalse (λ h => hb (h _ (Nat.lt_succ_self _))) $ 54 | match msg with 55 | | some msg => s!"Fails on input {b}. {msg}" 56 | | none => s!"Fails on input {b}." 57 | | .isFailure msg => .isFailure msg 58 | | .isMaybe msg => .isMaybe msg 59 | | .isFalse h msg => .isFalse (λ h' => h λ n hn => h' _ (Nat.le_step hn)) msg 60 | | .isFailure msg => .isFailure msg 61 | 62 | end LSpec 63 | -------------------------------------------------------------------------------- /LSpec/LSpec.lean: -------------------------------------------------------------------------------- 1 | import Lean 2 | import LSpec.SlimCheck.Checkable 3 | 4 | /-! 5 | # The core `LSpec` framework 6 | 7 | ## Add all relavent documentation 8 | 9 | Check [here](./LSpec/Examples.lean) for examples of uses 10 | 11 | ## Tags 12 | 13 | testing frameworks 14 | 15 | ## References 16 | 17 | * https://hackage.haskell.org/package/hspec 18 | -/ 19 | 20 | namespace LSpec 21 | 22 | /-- 23 | The main typeclass of propositions that can be tested by `LSpec`. 24 | 25 | In non-succeeding cases, it may contain an explanatory message. 26 | -/ 27 | class inductive Testable (p : Prop) where 28 | | isTrue (h : p) 29 | | isMaybe (msg : Option String := none) 30 | | isFalse (h : ¬ p) (msg : Option String := none) 31 | | isFailure (msg : Option String := none) 32 | 33 | /-- A default `Testable` instance with low priority. -/ 34 | instance (priority := 25) (p : Prop) [d : Decidable p] : Testable p := 35 | match d with 36 | | isFalse h => .isFalse h "Evaluated to false" 37 | | isTrue h => .isTrue h 38 | 39 | open SlimCheck in 40 | instance instTestableOfCheckable (p : Prop) (cfg : Configuration) [Checkable p] : Testable p := 41 | let (res, _) := ReaderT.run (Checkable.runSuite p cfg) (.up mkStdGen) 42 | match res with 43 | | .success (.inr h) => .isTrue h 44 | | .success (.inl _) => .isMaybe 45 | | .gaveUp n => .isFailure s!"Gave up {n} times" 46 | | .failure h xs n => .isFalse h $ Checkable.formatFailure "Found problems!" xs n 47 | 48 | /-- Formats the extra error message from `Testable` failures. -/ 49 | def formatErrorMsg : Option String → String 50 | | some msg => s!"\n {msg}" 51 | | none => "" 52 | 53 | section TestSequences 54 | 55 | /-- 56 | The datatype used to represent a sequence of tests. 57 | The `group` constructor represents a purely decorative concept 58 | of a test group, allowing to print tests results more prettily. 59 | -/ 60 | inductive TestSeq 61 | | individual : String → (prop : Prop) → Testable prop → TestSeq → TestSeq 62 | | group : String → TestSeq → TestSeq → TestSeq 63 | | done 64 | 65 | /-- Appends two sequences of tests. -/ 66 | def TestSeq.append : TestSeq → TestSeq → TestSeq 67 | | done, t => t 68 | | individual d p i n, t' => individual d p i $ n.append t' 69 | | group d ts n, t' => group d ts $ n.append t' 70 | 71 | instance : Append TestSeq where 72 | append := TestSeq.append 73 | 74 | /-- 75 | Allows the composition of tests with propositions for which a `Testable` 76 | instance exists. 77 | -/ 78 | def test (descr : String) (p : Prop) [Testable p] 79 | (next : TestSeq := .done) : TestSeq := 80 | .individual descr p inferInstance next 81 | 82 | /-- Allows collecting a `TestSeq` into a test group to print results in a group. -/ 83 | def group (descr : String) (groupTests : TestSeq) 84 | (next : TestSeq := .done) : TestSeq := 85 | .group descr groupTests next 86 | 87 | open SlimCheck Decorations in 88 | /-- 89 | Checks a `Checkable` prop. Note that `mk_decorations` is here simply to improve error messages 90 | and if `p` is Checkable, then so is `p'`. 91 | -/ 92 | def check (descr : String) (p : Prop) (next : TestSeq := .done) (cfg : Configuration := {}) 93 | (p' : DecorationsOf p := by mk_decorations) [Checkable p'] : TestSeq := 94 | haveI : Testable p' := instTestableOfCheckable p' cfg 95 | test descr p' next 96 | 97 | inductive ExpectationFailure (exp got : String) : Prop 98 | 99 | instance : Testable (ExpectationFailure exp got) := 100 | .isFailure s!"Expected '{repr exp}' but got '{repr got}'" 101 | 102 | /-- A test pipeline to run a function assuming that `opt` is `Option.some _` -/ 103 | def withOptionSome (descr : String) (opt : Option α) (f : α → TestSeq) : 104 | TestSeq := 105 | match opt with 106 | | none => test descr (ExpectationFailure "some _" "none") 107 | | some a => test descr true $ f a 108 | 109 | /-- A test pipeline to run a function assuming that `opt` is `Option.none` -/ 110 | def withOptionNone (descr : String) (opt : Option α) [ToString α] 111 | (f : TestSeq) : TestSeq := 112 | match opt with 113 | | none => test descr true $ f 114 | | some a => test descr (ExpectationFailure "none" s!"some {a}") 115 | 116 | /-- A test pipeline to run a function assuming that `exc` is `Except.ok _` -/ 117 | def withExceptOk (descr : String) (exc : Except ε α) [ToString ε] 118 | (f : α → TestSeq) : TestSeq := 119 | match exc with 120 | | .error e => test descr (ExpectationFailure "ok _" s!"error {e}") 121 | | .ok a => test descr true $ f a 122 | 123 | /-- A test pipeline to run a function assuming that `exc` is `Except.error _` -/ 124 | def withExceptError (descr : String) (exc : Except ε α) [ToString α] 125 | (f : ε → TestSeq) : TestSeq := 126 | match exc with 127 | | .error e => test descr true $ f e 128 | | .ok a => test descr (ExpectationFailure "error _" s!"ok {a}") 129 | 130 | /-- A generic runner for `TestSeq` -/ 131 | def TestSeq.run (tSeq : TestSeq) (indent := 0) : Bool × String := 132 | let pad := String.mk $ List.replicate indent ' ' 133 | let rec aux (acc : String) : TestSeq → Bool × String 134 | | .done => (true, acc) 135 | | .group d ts n => 136 | let (pass, msg) := ts.run (indent + 2) 137 | let (b, m) := aux s!"{acc}{pad}{d}:\n{msg}" n 138 | (pass && b, m) 139 | | .individual d _ (.isTrue _) n => aux s!"{acc}{pad}✓ {d}\n" n 140 | | .individual d _ (.isMaybe msg) n => 141 | aux s!"{acc}{pad}? {d}{formatErrorMsg msg}\n" n 142 | | .individual d _ (.isFalse _ msg) n 143 | | .individual d _ (.isFailure msg) n => 144 | let (_b, m) := aux s!"{acc}{pad}× {d}{formatErrorMsg msg}\n" n 145 | (false, m) 146 | aux "" tSeq 147 | 148 | end TestSequences 149 | 150 | /-- 151 | Runs a `TestSeq` with an output meant for the Lean Infoview. 152 | This function is meant to be called from a custom command. It runs in 153 | `TermElabM` to have access to `logInfo` and `throwError`. 154 | -/ 155 | def runInTermElabMAsUnit (tSeq : TestSeq) : Lean.Elab.TermElabM Unit := 156 | match tSeq.run with 157 | | (true, msg) => Lean.logInfo msg 158 | | (false, msg) => throwError msg 159 | 160 | /-- 161 | A custom command to run `LSpec` tests. Example: 162 | 163 | ```lean 164 | #lspec test "four equals four" (4 = 4) 165 | ``` 166 | -/ 167 | macro "#lspec " term:term : command => 168 | `(#eval LSpec.runInTermElabMAsUnit $term) 169 | 170 | open Std (HashMap) in 171 | /-- 172 | Consumes a map of string-keyed test suites and returns a test function meant to 173 | be used via CLI. 174 | 175 | The arguments `args` are matched against the test suite keys. If a key starts 176 | with one of the elements in `args`, then its respective test suite will be 177 | marked to run. 178 | 179 | If the empty list is provided, all test suites will run. 180 | -/ 181 | def lspecIO (map : HashMap String (List TestSeq)) (args : List String) : IO UInt32 := do 182 | -- Compute the filtered map containing the test suites to run 183 | let filteredMap := 184 | if args.isEmpty then map 185 | else Id.run do 186 | let mut acc := .empty 187 | for arg in args do 188 | for (key, tSeq) in map do 189 | if key.startsWith arg then 190 | acc := acc.insert key tSeq 191 | pure acc 192 | 193 | -- Accumulate error messages 194 | let mut testsWithErrors : HashMap String (Array String) := .empty 195 | for (key, tSeqs) in filteredMap do 196 | IO.println key 197 | for tSeq in tSeqs do 198 | let (success, msg) := tSeq.run (indent := 2) 199 | if success then IO.println msg 200 | else 201 | IO.eprintln msg 202 | if let some msgs := testsWithErrors[key]? then 203 | testsWithErrors := testsWithErrors.insert key $ msgs.push msg 204 | else 205 | testsWithErrors := testsWithErrors.insert key #[msg] 206 | 207 | -- Early return 0 when there are no errors 208 | if testsWithErrors.isEmpty then return 0 209 | 210 | -- Print error messages and then return 1 211 | IO.eprintln "-------------------------------- Failing tests ---------------------------------" 212 | for (key, msgs) in testsWithErrors do 213 | IO.eprintln key 214 | for msg in msgs do 215 | IO.eprintln msg 216 | return 1 217 | 218 | /-- 219 | Runs a sequence of tests that are created from a `List α` and a function 220 | `α → IO TestSeq`. Instead of creating all tests and running them consecutively, 221 | this function alternates between test creation and test execution. 222 | 223 | It's useful when the test creation process involves heavy computations in `IO` 224 | (e.g. when `f` reads data from files and processes it). 225 | -/ 226 | def lspecEachIO (l : List α) (f : α → IO TestSeq) : IO UInt32 := do 227 | let success ← l.foldlM (init := true) fun acc a => do 228 | match (← f a).run with 229 | | (true, msg) => IO.println msg; pure acc 230 | | (false, msg) => IO.eprintln msg; pure false 231 | if success then return 0 else return 1 232 | 233 | end LSpec 234 | -------------------------------------------------------------------------------- /LSpec/SlimCheck/Checkable.lean: -------------------------------------------------------------------------------- 1 | /- 2 | Copyright (c) 2022 Henrik Böving. All rights reserved. 3 | Released under Apache 2.0 license as described in the file LICENSE. 4 | Authors: Henrik Böving, Simon Hudon 5 | -/ 6 | 7 | import LSpec.SlimCheck.Sampleable 8 | import Lean 9 | 10 | /-! 11 | # `Checkable` Class 12 | Checkable propositions have a procedure that can generate counter-examples 13 | together with a proof that they invalidate the proposition. 14 | This is a port of the Haskell QuickCheck library. 15 | ## Creating Customized Instances 16 | The type classes `Checkable`, `SampleableExt` and `Shrinkable` are the 17 | means by which `SlimCheck` creates samples and tests them. For instance, 18 | the proposition `∀ i j : ℕ, i ≤ j` has a `Checkable` instance because `ℕ` 19 | is sampleable and `i ≤ j` is decidable. Once `SlimCheck` finds the `Checkable` 20 | instance, it can start using the instance to repeatedly creating samples 21 | and checking whether they satisfy the property. Once it has found a 22 | counter-example it will then use a `Shrinkable` instance to reduce the 23 | example. This allows the user to create new instances and apply 24 | `SlimCheck` to new situations. 25 | ### What do I do if I'm testing a property about my newly defined type? 26 | Let us consider a type made for a new formalization: 27 | ```lean 28 | structure MyType where 29 | x : ℕ 30 | y : ℕ 31 | h : x ≤ y 32 | deriving Repr 33 | ``` 34 | How do we test a property about `MyType`? For instance, let us consider 35 | `Checkable.check $ ∀ a b : MyType, a.y ≤ b.x → a.x ≤ b.y`. Writing this 36 | property as is will give us an error because we do not have an instance 37 | of `Shrinkable MyType` and `SampleableExt MyType`. We can define one as follows: 38 | ```lean 39 | instance : Shrinkable MyType where 40 | shrink := fun ⟨x,y,h⟩ => 41 | let proxy := Shrinkable.shrink (x, y - x) 42 | proxy.map (fun ⟨⟨fst, snd⟩, ha⟩ => ⟨⟨fst, fst + snd, sorry⟩, sorry⟩) 43 | instance : SampleableExt MyType := 44 | SampleableExt.mkSelfContained do 45 | let x ← SampleableExt.interpSample Nat 46 | let xyDiff ← SampleableExt.interpSample Nat 47 | pure $ ⟨x, x + xyDiff, sorry⟩ 48 | ``` 49 | Again, we take advantage of the fact that other types have useful 50 | `Shrinkable` implementations, in this case `Prod`. Note that the second 51 | proof is heavily based on `WellFoundedRelation` since its used for termination so 52 | the first step you want to take is almost always to `simp_wf` in order to 53 | get through the `WellFoundedRelation`. 54 | ## Main definitions 55 | * `Checkable` class 56 | * `Checkable.check`: a way to test a proposition using random examples 57 | ## Tags 58 | random testing 59 | ## References 60 | * https://hackage.haskell.org/package/QuickCheck 61 | -/ 62 | 63 | namespace SlimCheck 64 | 65 | /-- Result of trying to disprove `p` 66 | The constructors are: 67 | * `success : (PSum Unit p) → TestResult p` 68 | succeed when we find another example satisfying `p` 69 | In `success h`, `h` is an optional proof of the proposition. 70 | Without the proof, all we know is that we found one example 71 | where `p` holds. With a proof, the one test was sufficient to 72 | prove that `p` holds and we do not need to keep finding examples. 73 | * `gaveUp : ℕ → TestResult p` 74 | give up when a well-formed example cannot be generated. 75 | `gaveUp n` tells us that `n` invalid examples were tried. 76 | Above 100, we give up on the proposition and report that we 77 | did not find a way to properly test it. 78 | * `failure : ¬ p → (List String) → ℕ → TestResult p` 79 | a counter-example to `p`; the strings specify values for the relevant variables. 80 | `failure h vs n` also carries a proof that `p` does not hold. This way, we can 81 | guarantee that there will be no false positive. The last component, `n`, 82 | is the number of times that the counter-example was shrunk. 83 | -/ 84 | inductive TestResult (p : Prop) where 85 | | success : PSum Unit p → TestResult p 86 | | gaveUp : Nat → TestResult p 87 | | failure : ¬ p → List String → Nat → TestResult p 88 | deriving Inhabited 89 | 90 | /-- Configuration for testing a property. -/ 91 | structure Configuration where 92 | numInst : Nat := 100 93 | maxSize : Nat := 100 94 | numRetries : Nat := 10 95 | traceDiscarded : Bool := false 96 | traceSuccesses : Bool := false 97 | traceShrink : Bool := false 98 | traceShrinkCandidates : Bool := false 99 | randomSeed : Option Nat := none 100 | quiet : Bool := false 101 | 102 | namespace Configuration 103 | 104 | /-- A configuration with all the trace options enabled, useful for debugging. -/ 105 | def verbose : Configuration where 106 | traceDiscarded := true 107 | traceSuccesses := true 108 | traceShrink := true 109 | traceShrinkCandidates := true 110 | 111 | end Configuration 112 | 113 | /-- 114 | `PrintableProp p` allows one to print a proposition so that 115 | `SlimCheck` can indicate how values relate to each other. 116 | It's basically a poor man's delaborator. 117 | -/ 118 | class PrintableProp (p : Prop) where 119 | printProp : String 120 | 121 | export PrintableProp (printProp) 122 | 123 | instance (priority := low) : PrintableProp p where 124 | printProp := "⋯" 125 | 126 | /-- `Checkable p` uses random examples to try to disprove `p`. -/ 127 | class Checkable (p : Prop) where 128 | run (cfg : Configuration) (minimize : Bool) : Gen (TestResult p) 129 | 130 | def NamedBinder (_n : String) (p : Prop) : Prop := p 131 | 132 | namespace TestResult 133 | 134 | def toString : TestResult p → String 135 | | success (PSum.inl _) => "success (no proof)" 136 | | success (PSum.inr _) => "success (proof)" 137 | | gaveUp n => s!"gave {n} times" 138 | | failure _ counters _ => s!"failed {counters}" 139 | 140 | instance : ToString (TestResult p) := ⟨toString⟩ 141 | 142 | /-- Applicative combinator proof carrying test results. -/ 143 | def combine {p q : Prop} : PSum Unit (p → q) → PSum Unit p → PSum Unit q 144 | | PSum.inr f, PSum.inr proof => PSum.inr $ f proof 145 | | _, _ => PSum.inl () 146 | 147 | /-- Combine the test result for properties `p` and `q` to create a test for their conjunction. -/ 148 | def and : TestResult p → TestResult q → TestResult (p ∧ q) 149 | | failure h xs n, _ => failure (fun h2 => h h2.left) xs n 150 | | _, failure h xs n => failure (fun h2 => h h2.right) xs n 151 | | success h1, success h2 => success $ combine (combine (PSum.inr And.intro) h1) h2 152 | | gaveUp n, gaveUp m => gaveUp $ n + m 153 | | gaveUp n, _ => gaveUp n 154 | | _, gaveUp n => gaveUp n 155 | 156 | /-- Combine the test result for properties `p` and `q` to create a test for their disjunction. -/ 157 | def or : TestResult p → TestResult q → TestResult (p ∨ q) 158 | | failure h1 xs n, failure h2 ys m => 159 | let h3 := fun h => 160 | match h with 161 | | Or.inl h3 => h1 h3 162 | | Or.inr h3 => h2 h3 163 | failure h3 (xs ++ ys) (n + m) 164 | | success h, _ => success $ combine (PSum.inr Or.inl) h 165 | | _, success h => success $ combine (PSum.inr Or.inr) h 166 | | gaveUp n, gaveUp m => gaveUp $ n + m 167 | | gaveUp n, _ => gaveUp n 168 | | _, gaveUp n => gaveUp n 169 | 170 | /-- If `q → p`, then `¬ p → ¬ q` which means that testing `p` can allow us 171 | to find counter-examples to `q`. -/ 172 | def imp (h : q → p) (r : TestResult p) 173 | (p : PSum Unit (p → q) := PSum.inl ()) : TestResult q := 174 | match r with 175 | | failure h2 xs n => failure (mt h h2) xs n 176 | | success h2 => success $ combine p h2 177 | | gaveUp n => gaveUp n 178 | 179 | /-- Test `q` by testing `p` and proving the equivalence between the two. -/ 180 | def iff (h : q ↔ p) (r : TestResult p) : TestResult q := 181 | imp h.mp r (PSum.inr h.mpr) 182 | 183 | /-- When we assign a value to a universally quantified variable, 184 | we record that value using this function so that our counter-examples 185 | can be informative. -/ 186 | def addInfo (x : String) (h : q → p) (r : TestResult p) 187 | (p : PSum Unit (p → q) := PSum.inl ()) : TestResult q := 188 | if let failure h2 xs n := r then 189 | failure (mt h h2) (x :: xs) n 190 | else 191 | imp h r p 192 | 193 | /-- Add some formatting to the information recorded by `addInfo`. -/ 194 | def addVarInfo [Repr γ] (var : String) (x : γ) (h : q → p) (r : TestResult p) 195 | (p : PSum Unit (p → q) := PSum.inl ()) : TestResult q := 196 | addInfo s!"{var} := {repr x}" h r p 197 | 198 | def isFailure : TestResult p → Bool 199 | | failure .. => true 200 | | _ => false 201 | 202 | end TestResult 203 | 204 | namespace Checkable 205 | 206 | open TestResult 207 | 208 | def runProp (p : Prop) [Checkable p] : Configuration → Bool → Gen (TestResult p) := Checkable.run 209 | 210 | /-- A `dbgTrace` with special formatting -/ 211 | def slimTrace [Pure m] (s : String) : m Unit := 212 | dbgTrace s!"[SlimCheck: {s}]" fun _ => pure () 213 | 214 | instance andCheckable [Checkable p] [Checkable q] : Checkable (p ∧ q) where 215 | run := fun cfg min => do 216 | let xp ← runProp p cfg min 217 | let xq ← runProp q cfg min 218 | pure $ and xp xq 219 | 220 | instance orCheckable [Checkable p] [Checkable q] : Checkable (p ∨ q) where 221 | run := fun cfg min => do 222 | let xp ← runProp p cfg min 223 | -- As a little performance optimization we can just not run the second 224 | -- test if the first succeeds 225 | match xp with 226 | | success (PSum.inl h) => pure $ success (PSum.inl h) 227 | | success (PSum.inr h) => pure $ success (PSum.inr $ Or.inl h) 228 | | _ => 229 | let xq ← runProp q cfg min 230 | pure $ or xp xq 231 | 232 | instance iffCheckable [Checkable ((p ∧ q) ∨ (¬ p ∧ ¬ q))] : Checkable (p ↔ q) where 233 | run := fun cfg min => do 234 | let h ← runProp ((p ∧ q) ∨ (¬ p ∧ ¬ q)) cfg min 235 | have key {a b} : (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) := by 236 | constructor 237 | · intro h; rw [h] 238 | by_cases h : b 239 | · exact .inl $ .intro h h 240 | · exact .inr $ .intro h h 241 | · intro h 242 | match h with 243 | | .inl h => exact Iff.intro (fun _ => h.2) (fun _ => h.1) 244 | | .inr h => exact Iff.intro (fun a => False.elim $ h.1 a) (fun b => False.elim $ h.2 b) 245 | pure $ iff key h 246 | 247 | instance decGuardCheckable [PrintableProp p] [Decidable p] {β : p → Prop} [∀ h, Checkable (β h)] : Checkable (NamedBinder var $ ∀ h, β h) where 248 | run := fun cfg min => do 249 | if h : p then 250 | let res := (runProp (β h) cfg min) 251 | let s := printProp p 252 | (fun r => addInfo s!"guard: {s}" (· $ h) r (PSum.inr $ fun q _ => q)) <$> res 253 | else if cfg.traceDiscarded || cfg.traceSuccesses then 254 | let res := (fun _ => pure $ gaveUp 1) 255 | let s := printProp p 256 | slimTrace s!"discard: Guard {s} does not hold"; res 257 | else 258 | pure $ gaveUp 1 259 | 260 | instance forallTypesCheckable {f : Type → Prop} [Checkable (f Int)] : Checkable (NamedBinder var $ ∀ x, f x) where 261 | run := fun cfg min => do 262 | let r ← runProp (f Int) cfg min 263 | pure $ addVarInfo var "ℤ" (· $ Int) r 264 | 265 | /-- Format the counter-examples found in a test failure. -/ 266 | def formatFailure (s : String) (xs : List String) (n : Nat) : String := 267 | let counter := "\n".intercalate xs 268 | let parts := [ 269 | "\n===================", 270 | s, 271 | counter, 272 | s!"({n} shrinks)", 273 | "-------------------" 274 | ] 275 | "\n".intercalate parts 276 | 277 | /-- Increase the number of shrinking steps in a test result. -/ 278 | def addShrinks (n : Nat) : TestResult p → TestResult p 279 | | TestResult.failure p xs m => TestResult.failure p xs (m + n) 280 | | p => p 281 | 282 | /-- Shrink a counter-example `x` by using `Shrinkable.shrink x`, picking the first 283 | candidate that falsifies a property and recursively shrinking that one. 284 | The process is guaranteed to terminate because `shrink x` produces 285 | a proof that all the values it produces are smaller (according to `SizeOf`) 286 | than `x`. -/ 287 | def minimizeAux [SampleableExt α] {β : α → Prop} [∀ x, Checkable (β x)] 288 | (cfg : Configuration) (var : String) (x : SampleableExt.proxy α) (n : Nat) : 289 | OptionT Gen (Σ x, TestResult (β (SampleableExt.interp x))) := do 290 | let candidates := SampleableExt.shrink.shrink x 291 | if cfg.traceShrinkCandidates then 292 | slimTrace s!"Candidates for {var} := {repr x}:\n {repr candidates}" 293 | for candidate in candidates do 294 | if cfg.traceShrinkCandidates then 295 | slimTrace s!"Trying {var} := {repr candidate}" 296 | let res ← OptionT.lift $ Checkable.runProp (β (SampleableExt.interp candidate)) cfg true 297 | if res.isFailure then 298 | if cfg.traceShrink then 299 | slimTrace s!"{var} shrunk to {repr candidate} from {repr x}" 300 | let currentStep := OptionT.lift $ pure $ Sigma.mk candidate (addShrinks (n + 1) res) 301 | -- todo: `nextStep` is unused. Why is it here? 302 | -- let nextStep := @minimizeAux α _ β _ cfg var candidate (n + 1) 303 | return ← (currentStep) 304 | if cfg.traceShrink then 305 | slimTrace s!"No shrinking possible for {var} := {repr x}" 306 | failure 307 | 308 | /-- Once a property fails to hold on an example, look for smaller counter-examples 309 | to show the user. -/ 310 | def minimize [SampleableExt α] {β : α → Prop} [∀ x, Checkable (β x)] (cfg : Configuration) (var : String) 311 | (x : SampleableExt.proxy α) (r : TestResult (β $ SampleableExt.interp x)) : Gen (Σ x, TestResult (β $ SampleableExt.interp x)) := do 312 | if cfg.traceShrink then 313 | slimTrace "Shrink" 314 | slimTrace s!"Attempting to shrink {var} := {repr x}" 315 | let res ← OptionT.run $ minimizeAux cfg var x 0 316 | pure $ res.getD ⟨x, r⟩ 317 | 318 | /-- Test a universal property by creating a sample of the right type and instantiating the 319 | bound variable with it. -/ 320 | instance varCheckable [SampleableExt α] {β : α → Prop} [∀ x, Checkable (β x)] : Checkable (NamedBinder var $ ∀ x : α, β x) where 321 | run := fun cfg min => do 322 | let x ← SampleableExt.sample 323 | if cfg.traceSuccesses || cfg.traceDiscarded then 324 | slimTrace s!"{var} := {repr x}" 325 | let r ← Checkable.runProp (β $ SampleableExt.interp x) cfg false 326 | let ⟨finalX, finalR⟩ ← 327 | if isFailure r then 328 | if cfg.traceSuccesses then 329 | slimTrace s!"{var} := {repr x} is a failure" 330 | if min then 331 | minimize cfg var x r 332 | else 333 | pure $ ⟨x, r⟩ 334 | else 335 | pure $ ⟨x, r⟩ 336 | pure $ addVarInfo var finalX (· $ SampleableExt.interp finalX) finalR 337 | 338 | /-- Test a universal property about propositions -/ 339 | instance propVarCheckable {β : Prop → Prop} [∀ b : Bool, Checkable (β b)] : 340 | Checkable (NamedBinder var $ ∀ p : Prop, β p) 341 | where 342 | run := fun cfg min => 343 | imp (fun h (b : Bool) => h b) <$> Checkable.runProp (NamedBinder var $ ∀ b : Bool, β b) cfg min 344 | 345 | instance (priority := high) unusedVarCheckable [Nonempty α] [Checkable β] : 346 | Checkable (NamedBinder var $ ∀ _x : α, β) 347 | where 348 | run := fun cfg min => do 349 | if cfg.traceDiscarded || cfg.traceSuccesses then 350 | slimTrace s!"{var} is unused" 351 | let r ← Checkable.runProp β cfg min 352 | let finalR := addInfo s!"{var} is irrelevant (unused)" id r 353 | pure $ imp (· $ Classical.ofNonempty) finalR (PSum.inr $ fun x _ => x) 354 | 355 | instance (priority := low) decidableCheckable {p : Prop} [PrintableProp p] [Decidable p] : Checkable p where 356 | run := fun _ _ => 357 | if h : p then 358 | pure $ success (PSum.inr h) 359 | else 360 | let s := printProp p 361 | pure $ failure h [s!"issue: {s} does not hold"] 0 362 | 363 | end Checkable 364 | 365 | section PrintableProp 366 | 367 | instance Eq.printableProp [Repr α] {x y : α} : PrintableProp (x = y) where 368 | printProp := s!"{repr x} = {repr y}" 369 | 370 | instance Ne.printableProp [Repr α] {x y : α} : PrintableProp (x ≠ y) where 371 | printProp := s!"{repr x} ≠ {repr y}" 372 | 373 | instance LE.printableProp [Repr α] [LE α] {x y : α} : PrintableProp (x ≤ y) where 374 | printProp := s!"{repr x} ≤ {repr y}" 375 | 376 | instance LT.printableProp [Repr α] [LT α] {x y : α} : PrintableProp (x < y) where 377 | printProp := s!"{repr x} < {repr y}" 378 | 379 | instance And.printableProp [PrintableProp x] [PrintableProp y] : PrintableProp (x ∧ y) where 380 | printProp := s!"{printProp x} ∧ {printProp y}" 381 | 382 | instance Or.printableProp [PrintableProp x] [PrintableProp y] : PrintableProp (x ∨ y) where 383 | printProp := s!"{printProp x} ∨ {printProp y}" 384 | 385 | instance Iff.printableProp [PrintableProp x] [PrintableProp y] : PrintableProp (x ↔ y) where 386 | printProp := s!"{printProp x} ↔ {printProp y}" 387 | 388 | instance Imp.printableProp [PrintableProp x] [PrintableProp y] : PrintableProp (x → y) where 389 | printProp := s!"{printProp x} → {printProp y}" 390 | 391 | instance Not.printableProp [PrintableProp x] : PrintableProp (¬x) where 392 | printProp := s!"¬{printProp x}" 393 | 394 | instance True.printableProp : PrintableProp True where 395 | printProp := "True" 396 | 397 | instance False.printableProp : PrintableProp False where 398 | printProp := "False" 399 | 400 | instance Bool.printableProp {b : Bool} : PrintableProp b where 401 | printProp := if b then "true" else "false" 402 | 403 | end PrintableProp 404 | 405 | section IO 406 | open TestResult 407 | 408 | /-- Execute `cmd` and repeat every time the result is `gave_up` (at most `n` times). -/ 409 | def retry (cmd : Rand (TestResult p)) : Nat → Rand (TestResult p) 410 | | 0 => pure $ TestResult.gaveUp 1 411 | | n + 1 => do match ← cmd with 412 | | success hp => pure $ success hp 413 | | TestResult.failure h xs n => pure $ failure h xs n 414 | | gaveUp _ => retry cmd n 415 | 416 | /-- Count the number of times the test procedure gave up. -/ 417 | def giveUp (x : Nat) : TestResult p → TestResult p 418 | | success (PSum.inl ()) => gaveUp x 419 | | success (PSum.inr p) => success $ (PSum.inr p) 420 | | gaveUp n => gaveUp $ n + x 421 | | TestResult.failure h xs n => failure h xs n 422 | 423 | /-- Try `n` times to find a counter-example for `p`. -/ 424 | def Checkable.runSuiteAux (p : Prop) [Checkable p] (cfg : Configuration) (r : TestResult p) : 425 | Nat → Rand (TestResult p) 426 | | 0 => pure r 427 | | n + 1 => do 428 | let size := (cfg.numInst - n - 1) * cfg.maxSize / cfg.numInst 429 | if cfg.traceSuccesses then 430 | slimTrace s!"New sample" 431 | slimTrace s!"Retrying up to {cfg.numRetries} times until guards hold" 432 | let x ← retry (ReaderT.run (Checkable.runProp p cfg true) ⟨size⟩) cfg.numRetries 433 | match x with 434 | | (success (PSum.inl ())) => runSuiteAux p cfg r n 435 | | (gaveUp g) => runSuiteAux p cfg (giveUp g r) n 436 | | _ => pure $ x 437 | 438 | /-- Try to find a counter-example of `p`. -/ 439 | def Checkable.runSuite (p : Prop) [Checkable p] (cfg : Configuration := {}) : Rand (TestResult p) := 440 | Checkable.runSuiteAux p cfg (success $ PSum.inl ()) cfg.numInst 441 | 442 | /-- Run a test suite for `p` in `BaseIO` using the global RNG in `stdGenRef`. -/ 443 | def Checkable.checkIO (p : Prop) [Checkable p] (cfg : Configuration := {}) : BaseIO (TestResult p) := 444 | match cfg.randomSeed with 445 | | none => IO.runRand (Checkable.runSuite p cfg) 446 | | some seed => IO.runRandWith seed (Checkable.runSuite p cfg) 447 | 448 | end IO 449 | 450 | namespace Decorations 451 | 452 | open Lean 453 | 454 | /-- Traverse the syntax of a proposition to find universal quantifiers 455 | quantifiers and add `NamedBinder` annotations next to them. -/ 456 | partial def addDecorations (e : Expr) : Expr := 457 | e.replace fun expr => match expr with 458 | | Expr.forallE name type body data => 459 | let n := name.toString 460 | let newType := addDecorations type 461 | let newBody := addDecorations body 462 | let rest := Expr.forallE name newType newBody data 463 | some $ mkApp2 (mkConst `SlimCheck.NamedBinder) (mkStrLit n) rest 464 | | _ => none 465 | 466 | /-- `DecorationsOf p` is used as a hint to `mk_decorations` to specify 467 | that the goal should be satisfied with a proposition equivalent to `p` 468 | with added annotations. -/ 469 | abbrev DecorationsOf (_p : Prop) := Prop 470 | 471 | open Elab.Tactic in 472 | /-- In a goal of the shape `⊢ DecorationsOf p`, `mk_decoration` examines 473 | the syntax of `p` and adds `NamedBinder` around universal quantifications 474 | to improve error messages. This tool can be used in the declaration of a 475 | function as follows: 476 | ```lean 477 | def foo (p : Prop) (p' : Decorations.DecorationsOf p := by mk_decorations) [Checkable p'] : ... 478 | ``` 479 | `p` is the parameter given by the user, `p'` is a definitionally equivalent 480 | proposition where the quantifiers are annotated with `NamedBinder`. 481 | -/ 482 | scoped elab "mk_decorations" : tactic => do 483 | let goalType ← (← getMainGoal).getType 484 | if let Expr.app (.const ``Decorations.DecorationsOf ..) body := goalType then 485 | closeMainGoal `SlimCheck.mk_decorations (addDecorations body) 486 | 487 | end Decorations 488 | 489 | open Decorations in 490 | /-- Run a test suite for `p` and throw an exception if `p` does not not hold.-/ 491 | def Checkable.check (p : Prop) (cfg : Configuration := {}) 492 | (p' : DecorationsOf p := by mk_decorations) [Checkable p'] : IO Unit := do 493 | match ← Checkable.checkIO p' cfg with 494 | | TestResult.success _ => if !cfg.quiet then IO.println "Success" else pure () 495 | | TestResult.gaveUp n => if !cfg.quiet then IO.println s!"Gave up {n} times" 496 | | TestResult.failure _ xs n => throw (IO.userError $ formatFailure "Found problems!" xs n) 497 | 498 | -- #eval Checkable.check (∀ (x y z a : Nat) (h1 : 3 < x) (h2 : 3 < y), x - y = y - x) Configuration.verbose 499 | -- #eval Checkable.check (∀ x : Nat, ∀ y : Nat, x + y = y + x) Configuration.verbose 500 | -- #eval Checkable.check (∀ (x : (Nat × Nat)), x.fst - x.snd - 10 = x.snd - x.fst - 10) Configuration.verbose 501 | -- #eval Checkable.check (∀ (x : Nat) (h : 10 < x), 5 < x) Configuration.verbose 502 | 503 | end SlimCheck 504 | -------------------------------------------------------------------------------- /LSpec/SlimCheck/Control/DefaultRange.lean: -------------------------------------------------------------------------------- 1 | /- 2 | Copyright (c) 2022 Hanting Zhang. All rights reserved. 3 | Released under Apache 2.0 license as described in the file LICENSE. 4 | Authors: Hanting Zhang 5 | -/ 6 | 7 | /-! 8 | # Bounded and DefaultRange classes 9 | 10 | This module encapsulates the notion of a range of elements. 11 | 12 | ## Main definitions 13 | * `Bounded` class for objects which are naturally bounded 14 | by two `lo` and `hi` elements; 15 | * `DefaultRange` class for objects which are unbounded, 16 | but nevertheless need a convenient range of values which to operate within. 17 | 18 | Note that we go against Lean's principles by NOT providing any 19 | mathematical guarantees for the `Bounded` and `DefaultRange` classes. 20 | It is perfectly possible to define `Bounded Nat` with `lo := 37` and `hi := 37`; 21 | we leave these to the judgement of the programmer. *gasp of horror* 22 | This more follows the design of `Bounded` in Haskell, and allows us to 23 | forgo carrying proofs around when we start defining `Random` instances. 24 | 25 | Lean developers, please forgive us. 26 | 27 | ## References 28 | * Haskell 29 | -/ 30 | 31 | namespace SlimCheck 32 | 33 | class Bounded (α : Type u) where 34 | lo : α 35 | hi : α 36 | 37 | class DefaultRange (α : Type u) where 38 | lo : α 39 | hi : α 40 | 41 | instance [Bounded α] : DefaultRange α where 42 | lo := Bounded.lo 43 | hi := Bounded.hi 44 | 45 | instance : Bounded Bool where 46 | lo := false 47 | hi := true 48 | 49 | instance : DefaultRange Nat where 50 | lo := 0 51 | hi := USize.size - 1 52 | 53 | instance {n : Nat} : Bounded (Fin n.succ) where 54 | lo := ⟨0, n.succ_pos⟩ 55 | hi := ⟨n, n.lt_succ_self⟩ 56 | 57 | instance : DefaultRange Int where 58 | lo := - Int.ofNat (USize.size / 2) 59 | hi := Int.ofNat (USize.size / 2 - 1) 60 | 61 | end SlimCheck 62 | -------------------------------------------------------------------------------- /LSpec/SlimCheck/Control/Random.lean: -------------------------------------------------------------------------------- 1 | /- 2 | Copyright (c) 2022 Henrik Böving. All rights reserved. 3 | Released under Apache 2.0 license as described in the file LICENSE. 4 | Authors: Henrik Böving 5 | -/ 6 | import LSpec.SlimCheck.Control.DefaultRange 7 | 8 | /-! 9 | # Rand Monad and Random Class 10 | 11 | This module provides tools for formulating computations guided by randomness and for 12 | defining objects that can be created randomly. 13 | 14 | ## Main definitions 15 | * `Rand` and `RandT` monad for computations guided by randomness; 16 | * `Random` class for objects that can be generated randomly; 17 | * `random` to generate one object; 18 | * `BoundedRandom` class for objects that can be generated randomly inside a range; 19 | * `randomR` to generate one object inside a range; 20 | * `IO.runRand` to run a randomized computation inside the `IO` monad; 21 | 22 | ## Notes 23 | * Often we need to do some panic-possible things like use `List.get!`. 24 | In these cases, panic often needs an instance of `Inhabited (Gen α)`; 25 | the default generator will always be `StdGen` with `seed := 0`. 26 | 27 | ## References 28 | * Similar library in Haskell: https://hackage.haskell.org/package/MonadRandom 29 | -/ 30 | 31 | namespace SlimCheck 32 | 33 | /-- A monad to generate random objects using the generic generator type `g` -/ 34 | abbrev RandT (g : Type) := StateM (ULift g) 35 | 36 | instance inhabitedRandT [Inhabited g] [Inhabited α] : Inhabited (RandT g α) where 37 | default := fun _ => pure (default, .up default) 38 | 39 | /-- A monad to generate random objects using the generator type `Rng` -/ 40 | abbrev Rand (α : Type u) := RandT StdGen α 41 | 42 | instance inhabitedStdGen : Inhabited StdGen where 43 | default := mkStdGen 44 | 45 | /-- `Random α` gives us machinery to generate values of type `α` -/ 46 | class Random (α : Type u) where 47 | randomR [RandomGen g] (lo hi : α) : RandT g α 48 | 49 | -- /-- `BoundedRandom α` gives us machinery to generate values of type `α` between certain bounds -/ 50 | -- class BoundedRandom (α : Type u) [LE α] where 51 | -- randomR {g : Type} (lo hi : α) (h : lo ≤ hi) [RandomGen g] : RandT g {a // lo ≤ a ∧ a ≤ hi} 52 | 53 | namespace Rand 54 | /-- Generate one more `Nat` -/ 55 | def next [RandomGen g] : RandT g Nat := do 56 | let rng := (← get).down 57 | let (res, new) := RandomGen.next rng 58 | set (ULift.up new) 59 | pure res 60 | 61 | /-- Create a new random number generator distinct from the one stored in the state -/ 62 | def split {g : Type} [RandomGen g] : RandT g g := do 63 | let rng := (← get).down 64 | let (r1, r2) := RandomGen.split rng 65 | set (ULift.up r1) 66 | pure r2 67 | 68 | /-- Get the range of Nat that can be generated by the generator `g` -/ 69 | def range {g : Type} [RandomGen g] : RandT g (Nat × Nat) := do 70 | let rng := (← get).down 71 | pure <| RandomGen.range rng 72 | end Rand 73 | 74 | namespace Random 75 | 76 | open Rand 77 | 78 | /-- Generate a random value of type `α`. -/ 79 | def rand (α : Type u) [Random α] [range : DefaultRange α] [RandomGen g] : RandT g α := 80 | Random.randomR range.lo range.hi 81 | 82 | /-- Generate a random value of type `α` between `x` and `y` inclusive. -/ 83 | def randBound (α : Type u) [Random α] (lo hi : α) [RandomGen g] : RandT g α := 84 | Random.randomR lo hi 85 | 86 | def randFin {n : Nat} [RandomGen g] : RandT g (Fin n.succ) := 87 | λ ⟨g⟩ => randNat g 0 n.succ |>.map (Fin.ofNat' _) ULift.up 88 | 89 | instance : Random Bool where 90 | randomR := fun lo hi g => 91 | let (n, g') := RandomGen.next g.down 92 | match lo, hi with 93 | | true, false => (n % 2 == 1, .up g') 94 | | false, true => (n % 2 == 0, .up g') -- this doesn't matter btw, I'm just being quirky 95 | | x, _ => (x, .up g') 96 | 97 | instance : Random Nat where 98 | randomR := fun lo hi g => 99 | let (n, g') := randNat g.down lo hi 100 | (n, .up g') 101 | 102 | instance {n : Nat} : Random (Fin n.succ) where 103 | randomR := fun lo hi g => 104 | let (n, g') := randNat g.down lo hi 105 | (.ofNat' _ n, .up g') 106 | 107 | instance : Random Int where 108 | randomR := fun lo hi g => 109 | let lo' := if lo > hi then hi else lo 110 | let hi' := if lo > hi then lo else hi 111 | let hi'' := (hi' - lo').toNat 112 | let (n, g') := randNat g.down 0 hi'' 113 | (.ofNat n - lo', .up g') 114 | 115 | end Random 116 | 117 | /-- Computes a `Rand α` using the global `stdGenRef` as RNG. 118 | Note that: 119 | - `stdGenRef` is not necessarily properly seeded on program startup 120 | as of now and will therefore be deterministic. 121 | - `stdGenRef` is not thread local, hence two threads accessing it 122 | at the same time will get the exact same generator. 123 | -/ 124 | def IO.runRand (cmd : Rand α) : BaseIO α := do 125 | let stdGen ← IO.stdGenRef.get 126 | let rng := ULift.up stdGen 127 | let (res, new) := Id.run <| StateT.run cmd rng 128 | IO.stdGenRef.set new.down 129 | pure res 130 | 131 | def IO.runRandWith (seed : Nat) (cmd : Rand α) : BaseIO α := do 132 | pure $ (cmd.run (ULift.up $ mkStdGen seed)).1 133 | 134 | end SlimCheck 135 | -------------------------------------------------------------------------------- /LSpec/SlimCheck/Gen.lean: -------------------------------------------------------------------------------- 1 | /- 2 | Copyright (c) 2021 Henrik Böving. All rights reserved. 3 | Released under Apache 2.0 license as described in the file LICENSE. 4 | Authors: Henrik Böving, Simon Hudon 5 | -/ 6 | import LSpec.SlimCheck.Control.Random 7 | 8 | /-! 9 | # `Gen` Monad 10 | This monad is used to formulate randomized computations with a parameter 11 | to specify the desired size of the result. 12 | This is a port of the Haskell QuickCheck library. 13 | ## Main definitions 14 | * `Gen` monad 15 | ## Tags 16 | random testing 17 | ## References 18 | * https://hackage.haskell.org/package/QuickCheck 19 | -/ 20 | 21 | namespace SlimCheck 22 | 23 | open Random 24 | 25 | /-- Monad to generate random examples to test properties with. 26 | It has a `Nat` parameter so that the caller can decide on the 27 | size of the examples. -/ 28 | abbrev Gen (α : Type u) := ReaderT (ULift Nat) Rand α 29 | 30 | namespace Gen 31 | 32 | /-- Lift `Random.random` to the `Gen` monad. -/ 33 | def chooseAny (α : Type u) [Random α] [DefaultRange α] : Gen α := 34 | fun _ => rand α 35 | 36 | /-- Lift `BoundedRandom.randomR` to the `Gen` monad. -/ 37 | def choose (α : Type u) [Random α] (lo hi : α) : Gen α := 38 | fun _ => randBound α lo hi 39 | 40 | /-- Get access to the size parameter of the `Gen` monad. -/ 41 | def getSize : Gen Nat := 42 | return (← read).down 43 | 44 | /-- Apply a function to the size parameter. -/ 45 | def resize (f : Nat → Nat) (x : Gen α) : Gen α := 46 | withReader (ULift.up ∘ f ∘ ULift.down) x 47 | 48 | /-- Create an `Array` of examples using `x`. The size is controlled 49 | by the size parameter of `Gen`. -/ 50 | def arrayOf (x : Gen α) : Gen (Array α) := do 51 | let sz ← choose Nat 0 (← getSize) 52 | let mut res := #[] 53 | for _ in [0:sz] do 54 | res := res.push (← x) 55 | pure res 56 | 57 | /-- Create an `List` of examples using `x`. The size is controlled 58 | by the size parameter of `Gen`. -/ 59 | def listOf (x : Gen α) : Gen (List α) := 60 | arrayOf x >>= pure ∘ Array.toList 61 | 62 | /-- Given an array of example generators, choose one to create an example. -/ 63 | def oneOf [Inhabited α] (xs : Array (Gen α)) : Gen α := do 64 | let i ← choose Nat 0 (xs.size - 1) 65 | if h : i < xs.size then 66 | xs[i] 67 | else -- The array is empty 68 | pure default 69 | 70 | /-- Given an array of examples, choose one. -/ 71 | def elements [Inhabited α] (xs : Array α) : Gen α := do 72 | let i ← choose Nat 0 (xs.size - 1) 73 | if h : i < xs.size then 74 | return xs[i] 75 | else -- The array is empty 76 | pure default 77 | 78 | /-- Generate a random permutation of a given list. -/ 79 | def permutationOf : (xs : List α) → Gen (List α) 80 | | [] => pure [] 81 | | x::xs => do 82 | let ys ← permutationOf xs 83 | let n ← choose Nat 0 ys.length 84 | pure $ ys.take n ++ [x] ++ ys.drop n 85 | 86 | /-- Given two generators produces a tuple consisting out of the result of both -/ 87 | def prodOf {α β : Type u} (x : Gen α) (y : Gen β) : Gen (α × β) := do 88 | pure (←x, ←y) 89 | 90 | end Gen 91 | 92 | /-- Execute a `Gen` inside the `IO` monad using `size` as the example size-/ 93 | def Gen.run (x : Gen α) (size : Nat) : BaseIO α := 94 | IO.runRand $ ReaderT.run x ⟨size⟩ 95 | 96 | end SlimCheck 97 | -------------------------------------------------------------------------------- /LSpec/SlimCheck/Sampleable.lean: -------------------------------------------------------------------------------- 1 | /- 2 | Copyright (c) 2022 Henrik Böving. All rights reserved. 3 | Released under Apache 2.0 license as described in the file LICENSE. 4 | Authors: Henrik Böving, Simon Hudon 5 | -/ 6 | import LSpec.SlimCheck.Gen 7 | 8 | /-! 9 | # `SampleableExt` Class 10 | This class permits the creation samples of a given type 11 | controlling the size of those values using the `Gen` monad`. 12 | # `Shrinkable` Class 13 | This class helps minimize examples by creating smaller versions of 14 | given values. 15 | When testing a proposition like `∀ n : ℕ, prime n → n ≤ 100`, 16 | `SlimCheck` requires that `ℕ` have an instance of `SampleableExt` and for 17 | `prime n` to be decidable. `SlimCheck` will then use the instance of 18 | `SampleableExt` to generate small examples of ℕ and progressively increase 19 | in size. For each example `n`, `prime n` is tested. If it is false, 20 | the example will be rejected (not a test success nor a failure) and 21 | `SlimCheck` will move on to other examples. If `prime n` is true, `n 22 | ≤ 100` will be tested. If it is false, `n` is a counter-example of `∀ 23 | n : ℕ, prime n → n ≤ 100` and the test fails. If `n ≤ 100` is true, 24 | the test passes and `SlimCheck` moves on to trying more examples. 25 | This is a port of the Haskell QuickCheck library. 26 | ## Main definitions 27 | * `SampleableExt` class 28 | * `Shrinkable` class 29 | ### `SampleableExt` 30 | `SampleableExt` can be used in two ways. The first (and most common) 31 | is to simply generate values of a type directly using the `Gen` monad, 32 | if this is what you want to do then `SampleableExt.mkSelfContained` is 33 | the way to go. 34 | Furthermore it makes it possible to express generators for types that 35 | do not lend themselves to introspection, such as `ℕ → ℕ`. 36 | If we test a quantification over functions the 37 | counter-examples cannot be shrunken or printed meaningfully. 38 | For that purpose, `SampleableExt` provides a proxy representation 39 | `proxy` that can be printed and shrunken as well 40 | as interpreted (using `interp`) as an object of the right type. If you 41 | are using it in the first way, this proxy type will simply be the type 42 | itself and the `interp` function `id`. 43 | ### `Shrinkable 44 | Given an example `x : α`, `Shrinkable α` gives us a way to shrink it 45 | and suggest simpler examples. 46 | ## Shrinking 47 | Shrinking happens when `SlimCheck` find a counter-example to a 48 | property. It is likely that the example will be more complicated than 49 | necessary so `SlimCheck` proceeds to shrink it as much as 50 | possible. Although equally valid, a smaller counter-example is easier 51 | for a user to understand and use. 52 | The `Shrinkable` class, , has a `shrink` function so that we can use 53 | specialized knowledge while shrinking a value. It is not responsible 54 | for the whole shrinking process however. It only has to take one step 55 | in the shrinking process. `SlimCheck` will repeatedly call `shrink` 56 | until no more steps can be taken. Because `shrink` guarantees that the 57 | size of the candidates it produces is strictly smaller than the 58 | argument, we know that `SlimCheck` is guaranteed to terminate. 59 | ## Tags 60 | random testing 61 | ## References 62 | * https://hackage.haskell.org/package/QuickCheck 63 | -/ 64 | 65 | namespace SlimCheck 66 | 67 | open Random 68 | 69 | /-- Given an example `x : α`, `Shrinkable α` gives us a way to shrink it 70 | and suggest simpler examples. -/ 71 | class Shrinkable (α : Type u) extends WellFoundedRelation α where 72 | shrink : (x : α) → List α := fun _ => [] 73 | 74 | /-- `SampleableExt` can be used in two ways. The first (and most common) 75 | is to simply generate values of a type directly using the `Gen` monad, 76 | if this is what you want to do then `SampleableExt.mkSelfContained` is 77 | the way to go. 78 | Furthermore it makes it possible to express generators for types that 79 | do not lend themselves to introspection, such as `ℕ → ℕ`. 80 | If we test a quantification over functions the 81 | counter-examples cannot be shrunken or printed meaningfully. 82 | For that purpose, `SampleableExt` provides a proxy representation 83 | `proxy` that can be printed and shrunken as well 84 | as interpreted (using `interp`) as an object of the right type. -/ 85 | class SampleableExt (α : Sort u) where 86 | proxy : Type v 87 | [proxyRepr : Repr proxy] 88 | [shrink : Shrinkable proxy] 89 | sample : Gen proxy 90 | interp : proxy → α 91 | 92 | attribute [instance] SampleableExt.proxyRepr 93 | attribute [instance] SampleableExt.shrink 94 | 95 | namespace SampleableExt 96 | 97 | /-- Use to generate instance whose purpose is to simply generate values 98 | of a type directly using the `Gen` monad -/ 99 | def mkSelfContained [Repr α] [Shrinkable α] (sample : Gen α) : SampleableExt α where 100 | proxy := α 101 | proxyRepr := inferInstance 102 | shrink := inferInstance 103 | sample := sample 104 | interp := id 105 | 106 | /-- First samples a proxy value and interprets it. Especially useful if 107 | the proxy and target type are the same. -/ 108 | def interpSample (α : Type u) [SampleableExt α] : Gen α := 109 | SampleableExt.interp <$> SampleableExt.sample 110 | 111 | end SampleableExt 112 | 113 | section Shrinkers 114 | 115 | /-- `Nat.shrink' n` creates a list of smaller natural numbers by 116 | successively dividing `n` by 2 . For example, `Nat.shrink 5 = [2, 1, 0]`. -/ 117 | partial def Nat.shrink (n : Nat) : List Nat := 118 | if 0 < n then 119 | let m := n / 2 120 | let rest := shrink m 121 | m :: rest 122 | else 123 | [] 124 | 125 | instance Nat.shrinkable : Shrinkable Nat where 126 | shrink := Nat.shrink 127 | 128 | /-- `Fin.shrink` works like `Nat.shrink` but instead operates on `Fin`. -/ 129 | partial def Fin.shrink {n : Nat} (m : Fin n.succ) : List (Fin n.succ) := 130 | if 0 < m then 131 | let m := m / 2 132 | let rest := shrink m 133 | m :: rest 134 | else 135 | [] 136 | 137 | instance Fin.shrinkable {n : Nat} : Shrinkable (Fin n.succ) where 138 | shrink := Fin.shrink 139 | 140 | local instance Int_sizeOfAbs : SizeOf Int := ⟨Int.natAbs⟩ 141 | 142 | /-- `Int.shrinkable` operates like `Nat.shrinkable` but also includes the negative variants. -/ 143 | instance Int.shrinkable : Shrinkable Int where 144 | shrink n := 145 | Nat.shrink n.natAbs |>.map fun x => - Int.ofNat x 146 | 147 | instance Bool.shrinkable : Shrinkable Bool := {} 148 | instance Char.shrinkable : Shrinkable Char := {} 149 | 150 | instance Prod.shrinkable [shrA : Shrinkable α] [shrB : Shrinkable β] : Shrinkable (Prod α β) where 151 | shrink := fun (fst,snd) => 152 | let shrink1 := shrA.shrink fst |>.map fun x => (x, snd) 153 | let shrink2 := shrB.shrink snd |>.map fun x => (fst, x) 154 | shrink1 ++ shrink2 155 | 156 | end Shrinkers 157 | 158 | section Samplers 159 | 160 | open Gen SampleableExt 161 | 162 | instance Nat.sampleableExt : SampleableExt Nat := 163 | mkSelfContained (do choose Nat 0 (← getSize)) 164 | 165 | instance Fin.sampleableExt {n : Nat} : SampleableExt (Fin (n.succ)) := 166 | mkSelfContained (do choose (Fin n.succ) (Fin.ofNat' _ 0) (Fin.ofNat' _ (← getSize))) 167 | 168 | instance Int.sampleableExt : SampleableExt Int := 169 | mkSelfContained (do choose Int (-(← getSize)) (← getSize)) 170 | 171 | instance Bool.sampleableExt : SampleableExt Bool := 172 | mkSelfContained $ chooseAny Bool 173 | 174 | /-- This can be specialized into customized `SampleableExt Char` instances. 175 | The resulting instance has `1 / length` chances of making an unrestricted choice of characters 176 | and it otherwise chooses a character from `chars` with uniform probabilities. -/ 177 | def Char.sampleable (length : Nat) (chars : Array Char) : SampleableExt Char := 178 | mkSelfContained do 179 | let x ← choose Nat 0 length 180 | if x == 0 then 181 | let n ← interpSample Nat 182 | pure $ Char.ofNat n 183 | else 184 | elements chars 185 | 186 | instance Char.sampleableDefault : SampleableExt Char := 187 | Char.sampleable 3 188 | #[' ', '0', '1', '2', '3', 'a', 'b', 'c', 'A', 'B', 'C', ':', ',', ';', '`', '\\', '/'] 189 | 190 | instance Prod.sampleableExt {α β : Type u} [SampleableExt α] [SampleableExt β] : 191 | SampleableExt (α × β) where 192 | proxy := Prod (proxy α) (proxy β) 193 | proxyRepr := inferInstance 194 | shrink := inferInstance 195 | sample := prodOf sample sample 196 | interp := Prod.map interp interp 197 | 198 | instance Prop.sampleableExt : SampleableExt Prop where 199 | proxy := Bool 200 | proxyRepr := inferInstance 201 | sample := interpSample Bool 202 | shrink := inferInstance 203 | interp := Coe.coe 204 | 205 | end Samplers 206 | 207 | /-- An annotation for values that should never get shrinked. -/ 208 | def NoShrink (α : Type u) := α 209 | 210 | namespace NoShrink 211 | 212 | def mk (x : α) : NoShrink α := x 213 | def get (x : NoShrink α) : α := x 214 | 215 | instance inhabited [inst : Inhabited α] : Inhabited (NoShrink α) := inst 216 | instance repr [inst : Repr α] : Repr (NoShrink α) := inst 217 | 218 | instance shrinkable : Shrinkable (NoShrink α) where 219 | shrink := fun _ => [] 220 | 221 | instance sampleableExt [SampleableExt α] [Repr α] : SampleableExt (NoShrink α) := 222 | SampleableExt.mkSelfContained $ (NoShrink.mk ∘ SampleableExt.interp) <$> SampleableExt.sample 223 | 224 | end NoShrink 225 | 226 | end SlimCheck 227 | -------------------------------------------------------------------------------- /LSpec/Testing.lean: -------------------------------------------------------------------------------- 1 | import LSpec 2 | 3 | open LSpec 4 | 5 | #lspec 6 | test "Nat equality" (4 = 5) $ 7 | test "Nat inequality" (4 ≠ 5) $ 8 | test "bool equality" (42 == 42) $ 9 | test "list length" ([42].length = 1) $ 10 | test "list nonempty" ¬ [42].isEmpty 11 | -- × Nat equality 12 | -- Expected to be equal: '4' and '5' 13 | -- ✓ Nat inequality 14 | -- ✓ bool equality 15 | -- ✓ list length 16 | -- ✓ list nonempty 17 | 18 | -- Testing a test group. Indents are important! 19 | def tGroup : TestSeq := group "test group test" $ 20 | test "Nat inequality" (4 ≠ 5) $ 21 | test "Nat inequality" (3 ≠ 5) $ 22 | test "Nat equality" (42 == 42) 23 | 24 | #lspec (tGroup ++ tGroup ++ test "Nat equality" (42 = 42)) 25 | #lspec ( 26 | test "Nat equality" (42 = 42) $ 27 | group "manual group" ( 28 | test "Nat equality inside group" (4 = 4)) $ 29 | tGroup 30 | ) 31 | 32 | /-- 33 | Testing using `#lspec` with something of type `LSpec`. 34 | -/ 35 | def test1 : TestSeq := 36 | test "Nat equality" (4 = 4) $ 37 | test "Nat inequality" (4 ≠ 5) $ 38 | test "bool equality" (42 == 42) $ 39 | test "list length" ([42].length = 1) $ 40 | test "list nonempty" ¬ [42].isEmpty 41 | 42 | #lspec test1 43 | 44 | #eval lspecIO test1 45 | 46 | /-- 47 | Testing using `#lspec` with something of type `LSpecTest`. 48 | -/ 49 | def test2 := test "true" true 50 | 51 | #lspec test2 52 | 53 | #lspec test "true" <| true 54 | 55 | #lspec 56 | test "a" (4 = 4) $ 57 | test "b" (4 ≠ 5) 58 | 59 | #lspec 60 | test "array eq" <| #[1,2,3] = (List.range 3).toArray 61 | -- × array eq 62 | -- Expected to be equal: '#[1, 2, 3]' and '#[0, 1, 2]' 63 | 64 | 65 | def fourIO : IO Nat := 66 | return 4 67 | 68 | def fiveIO : IO Nat := 69 | return 5 70 | 71 | def main := do 72 | let four ← fourIO 73 | let five ← fiveIO 74 | lspecIO $ 75 | tGroup ++ ( 76 | test "fourIO equals 4" (four = 4) $ 77 | test "fiveIO equals 5" (five = 5)) 78 | 79 | #eval main 80 | -- ✓ fourIO equals 4 81 | -- ✓ fiveIO equals 5 82 | -- 0 83 | 84 | #lspec test "all lt" $ ∀ n, n < 10 → n - 5 < 5 85 | -- ✓ all lt 86 | 87 | #lspec test "all lt" $ ∀ n, n < 15 → n - 10 = 0 88 | -- × all lt 89 | -- Fails on input 11. Expected to be equal: '1' and '0' 90 | 91 | section slimcheck_tests 92 | 93 | #lspec check "add_comm" (∀ n m : Nat, n + m = m + n) 94 | -- ? add_comm 95 | 96 | #lspec check "add_comm" (∀ n m : Nat, n + m = m + m) $ check "mul_comm" $ ∀ n m : Nat, n * m = m * n 97 | -- × add_comm 98 | 99 | -- =================== 100 | -- Found problems! 101 | -- n := 1 102 | -- m := 0 103 | -- issue: 1 = 0 does not hold 104 | -- (0 shrinks) 105 | ------------------- 106 | -- ? mul_comm 107 | 108 | end slimcheck_tests 109 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # LSpec 2 | 3 | A testing framework for Lean 4, inspired by Haskell's [Hspec](https://hspec.github.io/) package. 4 | 5 | ## Usage 6 | 7 | ### Composing tests 8 | 9 | Sequences of tests are represented by the `TestSeq` datatype. 10 | In order to instantiate terms of `TestSeq`, use the `test` helper function: 11 | 12 | ```lean 13 | #check 14 | test "Nat equality" (4 = 4) $ 15 | test "Nat inequality" (4 ≠ 5) 16 | -- test "Nat equality" (4 = 4) (test "Nat inequality" (4 ≠ 5)) : TestSeq 17 | ``` 18 | 19 | `test` consumes a description a proposition and a next test 20 | The proposition, however, must have its own instance of `Testable`. 21 | 22 | You can also collect `TestSeq` into conceptual test groups by using the 23 | helper function `group`: 24 | 25 | ```lean 26 | #check 27 | test "Nat equality" (42 = 42) $ 28 | group "manual group" $ 29 | test "Nat equality inside group" (4 = 4) 30 | ``` 31 | 32 | ### The `Testable` class 33 | 34 | `Testable` is how Lean is instructed to decide whether certain propositions are resolved as `true` or `false`. 35 | 36 | This is an example of a simple instance for decidability of equalities: 37 | 38 | ```lean 39 | instance (x y : α) [DecidableEq α] [Repr α] : Testable (x = y) := 40 | if h : x = y then 41 | .isTrue h 42 | else 43 | .isFalse h s!"Not equal: {repr x} and {repr y}" 44 | ``` 45 | 46 | The custom failure message is optional. 47 | 48 | There are more examples of `Testable` instances in [LSpec/Instances.lean](LSpec/Instances.lean). 49 | 50 | The user is, of course, free to provide their own instances. 51 | 52 | ### Actually running the tests 53 | 54 | #### The `#lspec` command 55 | 56 | The `#lspec` command allows you to test interactively in a file. 57 | 58 | Examples: 59 | 60 | ```lean 61 | #lspec 62 | test "four equals four" (4 = 4) $ 63 | test "five equals five" (5 = 5) 64 | -- ✓ four equals four 65 | -- ✓ five equals five 66 | ``` 67 | 68 | An important note is that a failing test will raise an error, interrupting the building process. 69 | 70 | #### The `lspecIO` function 71 | 72 | `lspecIO` is meant to be used in files to be compiled and integrated in a testing infrastructure, as shown below. 73 | 74 | ```lean 75 | def aaSuite := [ 76 | test "four equals four" (4 = 4) 77 | ] 78 | 79 | def bbSuite := [ 80 | test "five equals five" (5 = 5) 81 | ] 82 | 83 | def main := lspecIO $ .ofList [ 84 | ("aa", aaSuite), 85 | ("bb", bbSuite) 86 | ] 87 | ``` 88 | 89 | Once such `main` function is defined, its respective executable can be tagged as the `@[test_driver]` in the lakefile. 90 | For further information, inspect the docstring of `lspecIO`. 91 | 92 | ## Integration with `SlimCheck` 93 | 94 | There are 3 main typeclasses associated with any `SlimCheck` test: 95 | 96 | * `Shrinkable` : The typeclass that takes a type `a : α` and returns a `List α` of elements which 97 | should be thought of as being "smaller" than `a` (in some sense dependent on the type `α` being 98 | considered). 99 | * `SampleableExt` : The typeclass of a . 100 | This is roughly equivalent to `QuickCheck`'s `Arbitrary` typeclass. 101 | * `Checkable` : The property to be checked by `SlimCheck` must have a `Checkable` instance. 102 | 103 | In order to use `SlimCheck` tests for custom data types, the user will need to implement 104 | instances of the typeclasses `Shrinkable` and `SampleableExt` for the custom types appearing 105 | in the properties being tested. 106 | 107 | The module [LSpec.SlimCheck.Checkable](LSpec/SlimCheck/Checkable.lean) contains may of 108 | the useful definitions and instances that can be used to derive a Checkable instance 109 | for a wide variety of properties given just the instances above. If all else fails, the user can 110 | also define the Checkable instance by hand. 111 | 112 | Once this is done a `Slimcheck` test is evaluated in a similar way to 113 | `LSpec` tests: 114 | 115 | ```lean 116 | #lspec check "add_comm" $ ∀ n m : Nat, n + m = m + n 117 | 118 | #lspec check "add_comm" $ ∀ n m : Nat, n + m = m + m 119 | -- × add_comm 120 | 121 | -- =================== 122 | -- Found problems! 123 | -- n := 1 124 | -- m := 0 125 | -- issue: 1 = 0 does not hold 126 | -- (0 shrinks) 127 | -- ------------------- 128 | ``` 129 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-parts": { 4 | "inputs": { 5 | "nixpkgs-lib": "nixpkgs-lib" 6 | }, 7 | "locked": { 8 | "lastModified": 1743550720, 9 | "narHash": "sha256-hIshGgKZCgWh6AYJpJmRgFdR3WUbkY04o82X05xqQiY=", 10 | "owner": "hercules-ci", 11 | "repo": "flake-parts", 12 | "rev": "c621e8422220273271f52058f618c94e405bb0f5", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "hercules-ci", 17 | "repo": "flake-parts", 18 | "type": "github" 19 | } 20 | }, 21 | "flake-parts_2": { 22 | "inputs": { 23 | "nixpkgs-lib": "nixpkgs-lib_2" 24 | }, 25 | "locked": { 26 | "lastModified": 1743550720, 27 | "narHash": "sha256-hIshGgKZCgWh6AYJpJmRgFdR3WUbkY04o82X05xqQiY=", 28 | "owner": "hercules-ci", 29 | "repo": "flake-parts", 30 | "rev": "c621e8422220273271f52058f618c94e405bb0f5", 31 | "type": "github" 32 | }, 33 | "original": { 34 | "owner": "hercules-ci", 35 | "repo": "flake-parts", 36 | "type": "github" 37 | } 38 | }, 39 | "lean4-nix": { 40 | "inputs": { 41 | "flake-parts": "flake-parts_2", 42 | "nixpkgs": [ 43 | "nixpkgs" 44 | ] 45 | }, 46 | "locked": { 47 | "lastModified": 1744206621, 48 | "narHash": "sha256-17kctQIIENhliHEQzzM06OlzrF4uyq6w7KOXSeNbZc4=", 49 | "owner": "argumentcomputer", 50 | "repo": "lean4-nix", 51 | "rev": "f798c4f818301c3dd3f5ffa1b667f824b72921a4", 52 | "type": "github" 53 | }, 54 | "original": { 55 | "owner": "argumentcomputer", 56 | "repo": "lean4-nix", 57 | "type": "github" 58 | } 59 | }, 60 | "nixpkgs": { 61 | "locked": { 62 | "lastModified": 1744098102, 63 | "narHash": "sha256-tzCdyIJj9AjysC3OuKA+tMD/kDEDAF9mICPDU7ix0JA=", 64 | "owner": "nixos", 65 | "repo": "nixpkgs", 66 | "rev": "c8cd81426f45942bb2906d5ed2fe21d2f19d95b7", 67 | "type": "github" 68 | }, 69 | "original": { 70 | "owner": "nixos", 71 | "ref": "nixos-unstable", 72 | "repo": "nixpkgs", 73 | "type": "github" 74 | } 75 | }, 76 | "nixpkgs-lib": { 77 | "locked": { 78 | "lastModified": 1743296961, 79 | "narHash": "sha256-b1EdN3cULCqtorQ4QeWgLMrd5ZGOjLSLemfa00heasc=", 80 | "owner": "nix-community", 81 | "repo": "nixpkgs.lib", 82 | "rev": "e4822aea2a6d1cdd36653c134cacfd64c97ff4fa", 83 | "type": "github" 84 | }, 85 | "original": { 86 | "owner": "nix-community", 87 | "repo": "nixpkgs.lib", 88 | "type": "github" 89 | } 90 | }, 91 | "nixpkgs-lib_2": { 92 | "locked": { 93 | "lastModified": 1743296961, 94 | "narHash": "sha256-b1EdN3cULCqtorQ4QeWgLMrd5ZGOjLSLemfa00heasc=", 95 | "owner": "nix-community", 96 | "repo": "nixpkgs.lib", 97 | "rev": "e4822aea2a6d1cdd36653c134cacfd64c97ff4fa", 98 | "type": "github" 99 | }, 100 | "original": { 101 | "owner": "nix-community", 102 | "repo": "nixpkgs.lib", 103 | "type": "github" 104 | } 105 | }, 106 | "root": { 107 | "inputs": { 108 | "flake-parts": "flake-parts", 109 | "lean4-nix": "lean4-nix", 110 | "nixpkgs": "nixpkgs" 111 | } 112 | } 113 | }, 114 | "root": "root", 115 | "version": 7 116 | } 117 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "LSpec Nix Flake"; 3 | 4 | inputs = { 5 | nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; 6 | flake-parts.url = "github:hercules-ci/flake-parts"; 7 | lean4-nix = { 8 | url = "github:argumentcomputer/lean4-nix"; 9 | inputs.nixpkgs.follows = "nixpkgs"; 10 | }; 11 | }; 12 | 13 | outputs = inputs @ { 14 | nixpkgs, 15 | flake-parts, 16 | lean4-nix, 17 | ... 18 | }: 19 | flake-parts.lib.mkFlake {inherit inputs;} { 20 | systems = [ 21 | "aarch64-darwin" 22 | "aarch64-linux" 23 | "x86_64-darwin" 24 | "x86_64-linux" 25 | ]; 26 | 27 | perSystem = { 28 | system, 29 | pkgs, 30 | self', 31 | config, 32 | ... 33 | }: 34 | { 35 | _module.args.pkgs = import nixpkgs { 36 | inherit system; 37 | overlays = [(lean4-nix.readToolchainFile ./lean-toolchain)]; 38 | }; 39 | 40 | # Build the library with `nix build` 41 | packages.default = ((lean4-nix.lake {inherit pkgs;}).mkPackage { 42 | src = ./.; 43 | roots = ["LSpec"]; 44 | }).modRoot; 45 | 46 | devShells.default = pkgs.mkShell { 47 | packages = with pkgs.lean; [lean lean-all]; 48 | }; 49 | }; 50 | }; 51 | } 52 | -------------------------------------------------------------------------------- /lake-manifest.json: -------------------------------------------------------------------------------- 1 | {"version": "1.1.0", 2 | "packagesDir": ".lake/packages", 3 | "packages": [], 4 | "name": "LSpec", 5 | "lakeDir": ".lake"} 6 | -------------------------------------------------------------------------------- /lakefile.toml: -------------------------------------------------------------------------------- 1 | name = "LSpec" 2 | version = "2.0.0" 3 | defaultTargets = ["LSpec"] 4 | 5 | [[lean_lib]] 6 | name = "LSpec" 7 | -------------------------------------------------------------------------------- /lean-toolchain: -------------------------------------------------------------------------------- 1 | leanprover/lean4:v4.18.0 2 | --------------------------------------------------------------------------------