├── .gitignore ├── CHANGELOG.org ├── LICENSE ├── README.org ├── doc ├── queue.org ├── race-conditions.org └── specification.org ├── project.clj ├── src └── stateful_check │ ├── command_utils.clj │ ├── core.clj │ ├── generator.clj │ ├── runner.clj │ ├── shrink_strategies.clj │ └── symbolic_values.clj └── test └── stateful_check ├── atomic_set_test.clj ├── core_test.clj ├── deadlock_test.clj ├── exception_test.clj ├── java_map_test.clj ├── java_queue_test.clj ├── mutation_test.clj ├── postcondition_is_test.clj ├── queue_test.clj └── symbolic_values_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | -------------------------------------------------------------------------------- /CHANGELOG.org: -------------------------------------------------------------------------------- 1 | * 0.4.4 2 | 3 | - Return results using ~test.check~'s ~Result~ protocol, rather than custom exceptions. (Thanks to @r0man for doing the hard work here.) 4 | 5 | - Make mutation detection optional, through the ~:run~ ~:assume-immutable-results~ option. This delays converting command results into strings until the end of the test run, which may make it easier to provoke some race conditions. 6 | 7 | To demonstrate the difference between in output, let's look at this test case: 8 | 9 | #+begin_src clojure 10 | (def test-atom (atom 0)) 11 | (deftest returning-atom-as-result 12 | (is (specification-correct? 13 | {:commands {:inc {:command #(do (swap! test-atom inc) 14 | test-atom) 15 | :next-state (fn [s _ _] (inc s)) 16 | :postcondition (fn [_ ns _ result] 17 | (is (= ns @result)))}} 18 | :setup #(reset! test-atom 0) 19 | :initial-state (constantly 0)}))) 20 | #+end_src 21 | 22 | With the default of ~:assume-immutable-results~ as ~false~ we see this output: 23 | 24 | #+begin_example 25 | Sequential prefix: 26 | #<4> = (:inc) = #atom[1 0x71f8eaa9] 27 | >> object may have been mutated later into #atom[2 0x71f8eaa9] << 28 | 29 | expected: (= ns @result) 30 | actual: (not (= 1 2)) 31 | #<5> = (:inc) = #atom[2 0x71f8eaa9] 32 | #+end_example 33 | 34 | With ~:assume-immutable-results~ set to ~true~ we see this output: 35 | 36 | #+begin_example 37 | Sequential prefix: 38 | #<4> = (:inc) = #atom[2 0x71f8eaa9] 39 | expected: (= ns @result) 40 | actual: (not (= 1 2)) 41 | #<5> = (:inc) = #atom[2 0x71f8eaa9] 42 | #+end_example 43 | 44 | If you compare the result of command ~#<4>~ in both cases you can see the difference in output. The assertions in both cases reflect the final value (i.e. ~actual~ is ~2~ in both cases) because postconditions run after the execution phase. 45 | 46 | - Make the ~:command-frequency?~ table include a ~0~ count for commands that were not run. 47 | 48 | * 0.4.3 49 | 50 | - Add equals/hashCode methods to LookupVars, to allow using the result of ~get~ on a symbolic value to be a key in a hash map 51 | 52 | - Resolve symbolic values within arguments, not just at the top level. This allows you to use arguments which are partially generated, and partially results from previous commands. For example: 53 | 54 | #+begin_src clojure 55 | (def create-user-command 56 | {:args (fn [{:keys [user-ids]}] 57 | [{:id (gen/elements user-ids), :name gen/string-ascii}]) 58 | :command #(update-user %)}) 59 | #+end_src 60 | 61 | - Fix shrinking of parallel command sequences. Due to a bug, shrinking of parallel command sequences only explored removing a single command, rather than removing pairs of commands. This may have led to poorer shrinks for parallel test cases. 62 | 63 | - Add the ability to customise the shrink strategy for a run. The default shrink strategy is the same as before, but you can use the ~:gen~ ~:shrink-strategies~ option to tune shrinking for your use case. See ~stateful-check.shrink-strategies~ for the currently available strategies, or you can write your own (although this is undocumented). 64 | 65 | - Add the ability to use ~is~ in postconditions to get more specific feedback about failures. The expected/actual values from failing assertions will be captured and printed alongside the command trace, to aid in debugging failures. For example: 66 | 67 | #+begin_src clojure 68 | (def get-command 69 | {:requires (fn [state] (seq state)) 70 | :args (fn [state] [(gen/elements test-keys)]) 71 | :command #(.get system-under-test %1) 72 | :postcondition (fn [prev-state _ [k] val] 73 | (is (= (get prev-state k) val) (str "Looking up " (pr-str k) " matches the model")))}) 74 | #+end_src 75 | 76 | This command from [[file:test/stateful_check/postcondition_is_test.clj][the associated test file]] will give a trace that looks like this: 77 | 78 | #+begin_example 79 | FAIL in (postcondition-prints-in-parallel-case) (core.clj:211) 80 | Sequential prefix: 81 | 82 | Thread a: 83 | #<2a> = (:put "" 0) = nil 84 | 85 | Thread b: 86 | #<1b> = (:put "a" 0) = nil 87 | #<4b> = (:get "a") = nil 88 | Looking up "a" matches the model 89 | expected: (= (get prev-state k) val) 90 | actual: (not (= 0 nil)) 91 | 92 | Seed: 1620654751933 93 | Note: Test cases with multiple threads are not deterministic, so using the 94 | same seed does not guarantee the same result. 95 | 96 | expected: all executions to match specification 97 | actual: the above execution did not match the specification 98 | #+end_example 99 | 100 | If the postcondition makes any assertions then the return value is not used. This means that the following postcondition will always pass. 101 | 102 | #+begin_src clojure 103 | {:postcondition 104 | (fn [_ _ _ _] 105 | (is true) 106 | false)} 107 | #+end_src 108 | 109 | When performing tests with multiple threads, postcondition failures are a bit tricky to interpret. The postcondition may result from any one (or more) of the interleavings of the commands in the parallel threads. 110 | 111 | - Add ~:command-frequency?~ to the ~:report~ options, to print out a table of how often the test runner executed each command. 112 | 113 | * 0.4.2 114 | 115 | - Fix printing of exceptions within postconditions ([[https://github.com/czan/stateful-check/issues/12][#12]]). 116 | 117 | * 0.4.1 118 | 119 | - Print out failing seed ([[https://github.com/czan/stateful-check/issues/8][#8]]). 120 | 121 | - Add ~:timeout-ms~ option to fail a test after a certain amount of time (suggestion made after Clj-Syd presentation). 122 | 123 | - Add forward compatibility for ~clojure.test.check~ version ~0.10.0-alpha4~. 124 | 125 | * 0.4.0 126 | 127 | Many, many, many changes. I'll try to go through them. 128 | 129 | - Change to the MIT license. 130 | 131 | - Remove ~real/~ and ~model/~ prefixes from keys. They don't mean as much, given the other changes that will be explained below. 132 | 133 | - Remove the specification ~:real/postcondition~ function. It doesn't really fit in the context of parallel tests. 134 | 135 | - The command execution phase is now separate to the trace verification stage. This means that ~:postcondition~ functions on commands no longer run interleaves with runs of ~:command~ functions. Now all the ~:command~ functions are run in a sequence, which is then /checked/ by the ~:postcondition~ functions. In particular this means that ~:postcondition~ shouldn't interact with the SUT at all! 136 | 137 | - Re-work the options map. It now has three parts: ~:gen~, ~:run~, and ~:report~. 138 | 139 | - Add support for running parallel tests, to try to find race conditions. Use ~{:gen {:threads 2}}~ to generate threads with two parallel threads, and ~{:run {:max-tries 10}}~ to try 10 times to provoke the race condition on each test. 140 | 141 | - Removed deprecated functions. 142 | 143 | * 0.3.1 144 | 145 | - ~:model/args~ now coerces the returned values into a generator. 146 | Coercion works like the following: 147 | + if it's a generator: return it 148 | + if it's a sequential collection: coerce each element into a 149 | generator, then use ~gen/tuple~ to combine them 150 | + if it's a map: coerce each value into a generator, then use 151 | ~gen/hash-map~ to combine each key/value-gen pair 152 | + anything else: return it using ~gen/return~ 153 | 154 | - ~:model/generate-command~ now has a default implementation. If you 155 | don't provide an implementation then it will select a command at 156 | random (effectively: ~(gen/elements (:commands spec))~). 157 | 158 | - If a value in the ~:command~ map is a var then dereference it (to 159 | facilitate breaking up specs a bit more). 160 | 161 | - Command results are now printed properly when the results of 162 | commands are mutated. Previously it would print the command results 163 | in their state at the end of the test, irrespective of where they 164 | actually were returned. Now the results will be printed prior to 165 | running the next command in the sequence. 166 | 167 | It used to print something like this: 168 | #+BEGIN_EXAMPLE 169 | #<0> = (:new) => #{10} 170 | #<1> = (:contains? #<0> 10) => false 171 | #<2> = (:add #<0> 10) => true 172 | #<3> = (:contains? #<0> 10) => true 173 | #+END_EXAMPLE 174 | 175 | This incorrectly shows the state of the test (at the point when it 176 | was created) to have the element ~10~ in it. The ~10~ wasn't added 177 | until command ~#<2>~, however, so that output is incorrect. This 178 | could cause us to think the set's implementation is wrong when it is 179 | actually a quirk of ~stateful-check~ causing this problem. 180 | 181 | It will now print something like this: 182 | #+BEGIN_EXAMPLE 183 | #<0> = (:new) => #{} 184 | #<1> = (:contains? #<0> 10) => false 185 | #<2> = (:add #<0> 10) => true 186 | #<3> = (:contains? #<0> 10) => true 187 | #+END_EXAMPLE 188 | 189 | - ~:real/setup~ and ~:real/cleanup~ had some major issues (not running 190 | being prime among them) which are now fixed. A test has been added 191 | to hopefully avoid this happening again in future. 192 | 193 | - Add a ~:tries~ argument to the ~specification-correct?~ options map. 194 | This runs each test a number of times, with any failure causing the 195 | run to fail. (Useful for non-deterministic tests.) 196 | 197 | - Shrinking is now a bit more aggressive. In particular, now it will 198 | start by trying to shrink single commands (whether by removing the 199 | command or by shrinking its arguments), but then it will also try to 200 | shrink pairs of commands (removing/shrinking both at the same time). 201 | This can lead to dramatically better shrinks in some situations. 202 | 203 | * 0.3.0 204 | 205 | - *Breaking!* Add ~next-state~ to the ~:real/postcondition~ function 206 | arguments in commands. 207 | 208 | Any command preconditions will need to be modified to take an extra 209 | argument. 210 | #+BEGIN_SRC clojure 211 | (fn [state args result] 212 | arbitrary-logic-for-postcondition) 213 | ;; needs to change to 214 | (fn [prev-state next-state args result] 215 | arbitrary-logic-for-postcondition) 216 | #+END_SRC 217 | 218 | - *Breaking!* Change ~reality-matches-model?~ to be called 219 | ~reality-matches-model~ (it's not a predicate, so it shouldn't have 220 | a ~?~ in its name). This function is now deprecated, though, in 221 | favour of using ~deftest~ with our custom ~is~ form (see the next point). 222 | 223 | - Add support for a custom test.check ~is~ form: 224 | #+BEGIN_SRC clojure 225 | (is (specification-correct? some-spec)) 226 | (is (specification-correct? some-spec {:num-tests 1000, :max-size 10, :seed 123456789})) 227 | #+END_SRC 228 | 229 | - Make the command generator use the same size for all commands. 230 | 231 | - Rewrite the command verifier/runner to make it a whole lot cleaner 232 | (including breaking out extra namespaces). 233 | 234 | - Upgrade to test.check 0.7.0. 235 | 236 | - Tweak the format of ~print-test-results~. 237 | 238 | * 0.2.0 239 | 240 | - Add namespaces to some keys which didn't have them before 241 | - ~:generate-command~ is now ~:model/generate-command~ 242 | - ~:setup~ is now ~:real/setup~ 243 | - ~:cleanup~ is now ~:real/cleanup~ 244 | 245 | - Add some more keys to the top-level spec object: 246 | - ~:model/initial-state~, ~:real/initial-state~, ~:initial-state~ 247 | for setting the initial state of the system 248 | - ~:real/postcondition~ on the top-level spec, to check for global 249 | invariants 250 | 251 | - Make symbolic values implement ~ILookup~ (to work with ~get~) 252 | 253 | - Clean up exception handling during command runs 254 | 255 | * 0.1.0 256 | 257 | Initial release. 258 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Carlo Zancanaro 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 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: stateful-check 2 | 3 | #+PROPERTY: header-args :results silent :session example 4 | 5 | A [[http://clojure.org][Clojure]] library designed to help with testing stateful systems with [[https://github.com/clojure/test.check/][test.check]]. 6 | 7 | By writing a specification of how our system behaves (when you do ~X~, expect ~Y~), we can generate test cases to check that our implementation matches our specification. We can even detect the presence of some race conditions, by running commands in parallel. When a failure is encountered, shrinking can help us to see what went wrong with as few distractions as possible. 8 | 9 | #+BEGIN_HTML 10 | 11 | Clojars Project 13 | 14 | #+END_HTML 15 | 16 | * Example 17 | 18 | As an example, let's write a specification for Java's ~java.util.TreeMap~ implementation. This will allow us to find the (already known) race conditions present in its implementation. 19 | 20 | This will be the final result, once we have assembled our specification: 21 | 22 | #+BEGIN_SRC clojure :results replace output 23 | ;; no output, because our specification is correct when run sequentially 24 | (is (specification-correct? java-map-specification)) 25 | ;; => true 26 | 27 | ;; but a failure when run on multiple threads 28 | (is (specification-correct? java-map-specification 29 | {:gen {:threads 2} 30 | :run {:max-tries 100}})) 31 | ;; FAIL in () (form-init4244174681303601076.clj:54) 32 | ;; Sequential prefix: 33 | ;; 34 | ;; Thread a: 35 | ;; #<4a> = (:put "" 0) = nil 36 | ;; 37 | ;; Thread b: 38 | ;; #<2b> = (:put "tree" 0) = nil 39 | ;; #<4b> = (:get "tree") = nil 40 | ;; 41 | ;; expected: all executions to match specification 42 | ;; actual: the above execution did not match the specification 43 | ;; => false 44 | #+END_SRC 45 | 46 | ~TreeMap~ fails to meet our specification (presented below) because it is possible to generate command lists which do not correspond to a sequential execution. In this case, there are three possible ways for these commands to be organised: 47 | - ~4a~, ~2b~, then ~4b~ 48 | - ~2b~, ~4a~, then ~4b~ 49 | - ~2b~, ~4b~, then ~4a~ 50 | but none of these sequential executions match the output that we have seen. In any of them, we would expect ~4b~ to have returned ~0~ instead of ~nil~. Thus, we have found a race condition in ~java.util.TreeMap~. 51 | 52 | ** Setup 53 | 54 | To start off with we'll need to require some namespaces that we'll need later: 55 | #+BEGIN_SRC clojure 56 | (require '[clojure.test :refer [is]] 57 | '[clojure.test.check.generators :as gen] 58 | '[stateful-check.core :refer [specification-correct?]]) 59 | #+END_SRC 60 | 61 | We'll be testing a ~TreeMap~, so let's allocate one in a global variable that we'll access during our tests. 62 | #+BEGIN_SRC clojure 63 | (def system-under-test (java.util.TreeMap.)) 64 | #+END_SRC 65 | 66 | We're also going to need some keys, to insert into the map. We use a small set of keys to try to encourage the generated commands to act on the same keys. We could use a larger set (even infinitely large, such as ~gen/string~), but then we potentially lower the chance of us provoking a bug. 67 | #+BEGIN_SRC clojure 68 | (def test-keys ["" "a" "house" "tree" "λ"]) 69 | #+END_SRC 70 | 71 | ** Commands 72 | 73 | Our command to ~put~ things into the map is fairly simple. It chooses one of the keys at random, and a random integer. The ~:command~ key defines the behaviour of this command, which is to call ~.put~ on our map. We then modify our test's state to associate the key with the value. This state will then be read during ~get~ commands, so we know what to expect. 74 | 75 | #+BEGIN_SRC clojure 76 | (def put-command 77 | {:args (fn [state] [(gen/elements test-keys) gen/int]) 78 | :command #(.put system-under-test %1 %2) 79 | :next-state (fn [state [k v] _] 80 | (assoc state k v))}) 81 | #+END_SRC 82 | 83 | Our command to ~get~ things out of the map is also fairly simple. It requires that we think there's something in the map (because the test's state says so). It chooses one of the keys at random, and gets it out. The postcondition requires that the value we got out of the map matches what our state contains for that key. 84 | 85 | #+BEGIN_SRC clojure 86 | (def get-command 87 | {:requires (fn [state] (seq state)) 88 | :args (fn [state] [(gen/elements test-keys)]) 89 | :command #(.get system-under-test %1) 90 | :postcondition (fn [prev-state _ [k] val] 91 | (= (get prev-state k) val))}) 92 | #+END_SRC 93 | 94 | ** Specification 95 | 96 | Now we have to put these commands together into a specification. We also include a ~:setup~ function, which restores the map to a known state (no values). The test's state is implicitly ~nil~. 97 | 98 | #+BEGIN_SRC clojure 99 | (def java-map-specification 100 | {:commands {:put #'put-command 101 | :get #'get-command} 102 | :setup #(.clear system-under-test)}) 103 | #+END_SRC 104 | 105 | ** Running 106 | 107 | We can now run the test, as shown above. 108 | 109 | #+BEGIN_SRC clojure 110 | (is (specification-correct? java-map-specification)) 111 | 112 | ;; note that this call can take a long time, and may need to be run 113 | ;; multiple times to provoke a failure 114 | (is (specification-correct? java-map-specification 115 | {:gen {:threads 2} 116 | :run {:max-tries 100}})) 117 | ;; there are a few ways this can fail; the most fun failure thus far 118 | ;; was an NPE! 119 | #+END_SRC 120 | 121 | To view this example in one file, see [[file:test/stateful_check/java_map_test.clj][the relevant test file]]. 122 | 123 | If you'd like to read more, you can read [[file:doc/queue.org][a more complete of testing a queue]]. Alternatively you can try running the above test with a ~java.util.HashMap~ instead. Is it easier, or harder, to make it fail than the ~TreeMap~? Are the failures that you see different to the ~TreeMap~? 124 | 125 | * Specifications 126 | 127 | For a detailed description of how a ~stateful-check~ specification has to be structured, see [[file:doc/specification.org][the specification document]]. 128 | 129 | * Race condition detection 130 | 131 | For more information about how the race condition detection works, see [[file:doc/race-conditions.org][the notes on ~stateful-check~'s race condition detection]]. 132 | 133 | * Related work 134 | 135 | - [[https://github.com/clojure/test.check/][test.check]] (generative testing for Clojure, on which ~stateful-check~ is built) 136 | - [[http://www.quviq.com/index.html][QuviQ Quickcheck]] (commercial generative testing for Erlang) 137 | - [[http://proper.softlab.ntua.gr/index.html][PropEr]] (open source generative testing for Erlang) 138 | 139 | * Related talks 140 | 141 | - [[https://www.youtube.com/watch?v=zi0rHwfiX1Q][Testing the Hard Stuff and Staying Sane]] - John Hughes, 2014, the inspiration for this library 142 | - [[https://www.youtube.com/watch?v=xw8ZFU8CGdA][How to do Stateful Property Testing in Clojure]] - Magnus Kvalevåg, 2019, (~stateful-check~ is mentioned starting at [[https://www.youtube.com/watch?v=xw8ZFU8CGdA&t=571][9:31]]) 143 | 144 | * Future work 145 | 146 | - hook into JVM scheduler/debugger to control scheduling to make tests reproducible 147 | 148 | * License 149 | 150 | Copyright © 2014-2024 Carlo Zancanaro 151 | 152 | Distributed under the MIT Licence. 153 | 154 | # Local Variables: 155 | # org-confirm-babel-evaluate: nil 156 | # nrepl-sync-request-timeout: nil 157 | # End: 158 | -------------------------------------------------------------------------------- /doc/queue.org: -------------------------------------------------------------------------------- 1 | #+TITLE: A simple queue example 2 | 3 | #+PROPERTY: header-args :session example :results silent 4 | 5 | As an example, let's test a mutable queue (a ~PersistentQueue~ in an 6 | atom). Our queue will have three operations: ~new~, ~push~ and 7 | ~pop~. Before we get started, though, let's import some things which 8 | we'll need later. 9 | 10 | #+BEGIN_SRC clojure 11 | (ns stateful-check.example 12 | (:require [clojure.test :refer [is]] 13 | [clojure.test.check.generators :as gen] 14 | [stateful-check.core :refer [specification-correct?]])) 15 | #+END_SRC 16 | 17 | * Defining 18 | 19 | ** ~new-queue~ 20 | 21 | The implementation for the ~new-queue~ function is quite simple: 22 | 23 | #+BEGIN_SRC clojure 24 | (defn new-queue [] (atom clojure.lang.PersistentQueue/EMPTY)) 25 | #+END_SRC 26 | 27 | In order to use it with ~stateful-check~ we also need to model its 28 | semantics: 29 | 30 | #+BEGIN_SRC clojure 31 | (def new-queue-specification 32 | {:requires (fn [state] (nil? state)) 33 | :command #'new-queue 34 | :next-state (fn [state _ result] {:queue result, :elements []})}) 35 | #+END_SRC 36 | 37 | This specification contains three elements: 38 | 39 | - ~:requires~ specifies that this command is only valid if the 40 | state of the system is ~nil~ (which in this case means: nothing has 41 | been done to the system yet) 42 | 43 | - ~:command~ specifies what to do to actually run this command. 44 | For this command we want to allocate a new queue. 45 | 46 | - ~:next-state~ denotes the effect that running this command will have 47 | on the state of the system. In this case running the ~new-queue~ 48 | function will initialise the state. ~:elements~ is set to the empty 49 | vector because our queue starts off empty. ~:queue~ is set to the 50 | result of calling the ~:command~ function to store it for later 51 | operations. 52 | 53 | In this instance the ~:next-state~ function is called when performing 54 | both the abstract and the real evaluation. This means that ~:result~ 55 | could be a symbolic value, and thus cannot be operated on directly in 56 | ~:next-state~. When a symbolic value is used as an argument to a later 57 | command, however, it will be replaced by its corresponding concrete 58 | value (as can be seen below, where ~:queue~ is used as an argument to 59 | ~push-queue~ and ~pop-queue~). 60 | 61 | ** ~push-queue~ 62 | 63 | Similarly, ~push-queue~ is fairly simple to implement. 64 | 65 | #+BEGIN_SRC clojure 66 | (defn push-queue [queue val] 67 | (swap! queue conj val) 68 | nil) 69 | #+END_SRC 70 | 71 | Then its semantics: 72 | 73 | #+BEGIN_SRC clojure 74 | (def push-queue-specification 75 | {:requires (fn [state] state) 76 | :args (fn [state] [(:queue state) gen/nat]) 77 | :command #'push-queue 78 | :next-state (fn [state [_ val] _] (update-in state [:elements] conj val))}) 79 | #+END_SRC 80 | 81 | This specification has one additional element over 82 | ~new-queue-specification~: 83 | 84 | - ~:args~ specifies a function which will provide a generator to 85 | generate arguments for ~push-queue~. What we pass is converted into 86 | a generator where possible. In this case we are returning the queue 87 | under test (~(:queue state)~) as well as a generated natural number 88 | (~gen/nat~). 89 | 90 | In addition to this, we can see that ~:requires~ merely requires 91 | that there be something truthy in the state, and ~:next-state~ simply 92 | adds the command to the end of the ~:elements~ vector in the ~state~ 93 | map. 94 | 95 | ** ~pop-queue~ 96 | 97 | Lastly, ~pop-queue~: 98 | 99 | #+BEGIN_SRC clojure 100 | (defn pop-queue [queue] 101 | (swap! queue pop)) 102 | #+END_SRC 103 | 104 | #+BEGIN_SRC clojure 105 | (def pop-queue-specification 106 | {:requires (fn [state] (seq (:elements state))) 107 | :args (fn [state] [(:queue state)]) 108 | :command #'pop-queue 109 | :next-state (fn [state [queue] _] (update-in state [:elements] (comp vec next))) 110 | :postcondition (fn [state _ [_] val] (= (first (:elements state)) val))}) 111 | #+END_SRC 112 | 113 | This specification has one more element from ~push-queue-specification~: 114 | 115 | - ~:postcondition~ determines whether the result of performing 116 | this action correctly matches the expectation (from the abstract 117 | state). In our case: we expect the value returned by ~pop-queue~ to 118 | be the first value in the ~:elements~ vector. 119 | 120 | * Running 121 | 122 | Now we want to run our specification. In order to do this we first 123 | need to assemble each of our command specifications into a full model 124 | specification. 125 | 126 | #+BEGIN_SRC clojure 127 | (def queue-spec 128 | {:commands {:new #'new-queue-specification 129 | :push #'push-queue-specification 130 | :pop #'pop-queue-specification}}) 131 | #+END_SRC 132 | 133 | The ~:commands~ key just contains a map of each command spec we are 134 | using for this model. 135 | 136 | Let's see what happens when we run this specification: 137 | 138 | #+BEGIN_SRC clojure :results replace output 139 | (is (specification-correct? queue-spec {:run {:seed 1438362541481}})) 140 | ;; 141 | ;; FAIL in () (form-init4764932752973424260.clj:1) 142 | ;; Sequential prefix: 143 | ;; #<1> = (:new) = #atom[#object[clojure.lang.PersistentQueue 0x9060190 "clojure.lang.PersistentQueue@1"] 0x766dbf8c] 144 | ;; #<2> = (:push #<1> 0) = nil 145 | ;; #<3> = (:pop #<1>) = #object[clojure.lang.PersistentQueue 0x13952b4e "clojure.lang.PersistentQueue@1"] 146 | ;; 147 | ;; expected: all executions to match specification 148 | ;; actual: the above execution did not match the specification 149 | #+END_SRC 150 | 151 | #+RESULTS: 152 | : 153 | : FAIL in () (form-init4764932752973424260.clj:1) 154 | : Sequential prefix: 155 | : #<1> = (:new) = #atom[#object[clojure.lang.PersistentQueue 0x9060190 "clojure.lang.PersistentQueue@1"] 0x566e5b63] 156 | : #<2> = (:push #<1> 0) = nil 157 | : #<3> = (:pop #<1>) = #object[clojure.lang.PersistentQueue 0x550a43d8 "clojure.lang.PersistentQueue@1"] 158 | : 159 | : expected: all executions to match specification 160 | : actual: the above execution did not match the specification 161 | 162 | Whoops! It failed! We must have a bug somewhere. 163 | 164 | Okay, we seem to have an error when we create a queue, then push a 165 | value into it, then pop the value back out. So it could be a problem 166 | with any of our operations. 167 | 168 | Looking at the return value of the ~:pop~ step, though, we can see 169 | that it's returning the wrong thing! It's returning us a queue, not a 170 | value from the queue. We have a bug! 171 | 172 | So, let's fix our error. 173 | 174 | #+BEGIN_SRC clojure 175 | (defn pop-queue [queue] 176 | (let [val (peek @queue)] 177 | (swap! queue pop) 178 | val)) 179 | #+END_SRC 180 | 181 | Now let's try running our tests again. 182 | 183 | #+BEGIN_SRC clojure :results replace output 184 | (is (specification-correct? queue-spec)) 185 | #+END_SRC 186 | 187 | #+RESULTS: 188 | 189 | No output? That means the test passed! Success! 190 | 191 | * Running tests to find race conditions 192 | 193 | Now that we've fixed our tests in the sequential case, let's check to see if we have any race conditions in our data structure! To do this, we just add a few more options to our command. We're going to add a ~:gen~ option to change the behaviour of our command generator to generate two threads, and we'll add a ~:run~ option to run each tests a maximum of ten times, in an attempt to provoke an error. 194 | 195 | #+BEGIN_SRC clojure :results replace output :timeout 30 196 | (is (specification-correct? queue-spec {:gen {:threads 2} 197 | :run {:max-tries 10}})) 198 | ;; 199 | ;; FAIL in () (form-init4764932752973424260.clj:1) 200 | ;; Sequential prefix: 201 | ;; #<1> = (:new) = #atom[#object[clojure.lang.PersistentQueue 0x9060190 "clojure.lang.PersistentQueue@1"] 0x48cf3d4c] 202 | ;; #<2> = (:push #<1> 0) = nil 203 | ;; #<3> = (:push #<1> 1) = nil 204 | ;; 205 | ;; Thread a: 206 | ;; #<1a> = (:pop #<1>) = 0 207 | ;; 208 | ;; Thread b: 209 | ;; #<1b> = (:pop #<1>) = 0 210 | ;; 211 | ;; expected: all executions to match specification 212 | ;; actual: the above execution did not match the specification 213 | #+END_SRC 214 | 215 | #+RESULTS: 216 | #+begin_example 217 | 218 | FAIL in () (form-init4764932752973424260.clj:1) 219 | Sequential prefix: 220 | #<1> = (:new) = #atom[#object[clojure.lang.PersistentQueue 0x9060190 "clojure.lang.PersistentQueue@1"] 0x48cf3d4c] 221 | #<2> = (:push #<1> 0) = nil 222 | #<3> = (:push #<1> 1) = nil 223 | 224 | Thread a: 225 | #<1a> = (:pop #<1>) = 0 226 | 227 | Thread b: 228 | #<1b> = (:pop #<1>) = 0 229 | 230 | expected: all executions to match specification 231 | actual: the above execution did not match the specification 232 | #+end_example 233 | 234 | One again, our test is failing! We have a race condition! 235 | 236 | The above output tells us that the race condition can be provoked by allocating a new queue and pushing a ~0~ and a ~1~ into it. Then, in two parallel threads, pop the top value of the thread. Now there are two possible ways this should go: either ~Thread a~ should get a ~0~ and ~Thread b~ should get a ~1~, or the other way around. We can see in the output above that /both/ threads got a ~0~ when they popped the queue. That's not right! 237 | 238 | If you run this test multiple times, you'll notice that it gives a different output. This is because race condition tests are non-deterministic (at least at the moment). They attempt to reproduce failures by trying many times (hence the ~:max-tries~ option), but this isn't reliable. You may need to experiment to find values which work for your use-case. 239 | 240 | Given we have shown that our queue is correct when we tested it sequentially, this should make us suspicious of our ~pop~ operation. Let's have a look at its implementation again: 241 | 242 | #+BEGIN_SRC clojure 243 | (defn pop-queue [queue] 244 | (let [val (peek @queue)] 245 | (swap! queue pop) 246 | val)) 247 | #+END_SRC 248 | 249 | In our haste to fix the earlier problem that we had with ~pop-queue~, we accidentally introduced a race condition. It's possible for two threads to each execute ~(peek @queue)~ before either of them has run ~(swap! queue pop)~. This will result the first value in the queue being returned in two separate threads, and one being silently dropped. 250 | 251 | To fix this we're going to have to use a lower level operation: ~compare-and-set!~. The details of this are beyond the scope of this example, so I will provide an implementation without further explanation. 252 | 253 | #+BEGIN_SRC clojure 254 | (defn pop-queue [queue] 255 | (let [value @queue] 256 | (if (compare-and-set! queue value (pop value)) 257 | (peek value) 258 | (recur queue)))) 259 | #+END_SRC 260 | 261 | Re-running our tests, we can see that ~stateful-check~ is no longer able to find a counterexample: 262 | 263 | #+BEGIN_SRC clojure :results replace output :timeout 60 264 | (is (specification-correct? queue-spec {:gen {:threads 2} 265 | :run {:max-tries 10}})) 266 | #+END_SRC 267 | 268 | # Local Variables: 269 | # org-confirm-babel-evaluate: nil 270 | # cider-buffer-ns: "stateful-check.example" 271 | # nrepl-sync-request-timeout: 60 272 | # End: 273 | -------------------------------------------------------------------------------- /doc/race-conditions.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Race conditions 2 | 3 | We now have the ability to detect race conditions with ~stateful-check~! This relies on one fundamental assumption, and comes with lots of caveats. 4 | 5 | *Assumption:* each command is /atomic/. Or, in other words, a parallel execution of ~n~ threads can be /serialised/ into a single sequential series of commands with the same observable output. 6 | 7 | This assumption is now something that ~stateful-check~ can test, by attempting to find an example where this assumption does not hold. It does this by generating a random series of commands to run in ~n~ threads, just as it does in the sequential case. 8 | 9 | Unlike the sequential case, though, we can't rely on the test failing every time we run it. This leads us to *caveat 1:* in the absence of an easy way to replace the JVM's scheduler, we must run the test multiple times to try to provoke a race condition. To do this, we supply an options map to ~specification-correct?~, like this: 10 | 11 | #+BEGIN_EXAMPLE 12 | (is (specification-correct? specification {:gen {:threads 2} 13 | :run {:max-tries 10}})) 14 | #+END_EXAMPLE 15 | 16 | With this specification each test case will consist of a number of commands run sequentially (the "sequential prefix"), followed by ~2~ threads worth of commands, run at the same time (the "parallel suffixes"). Each test-case ~10~ times, in an attempt to provoke a failure. If the test passes all ~10~ times then it will be considered a valid execution. 17 | 18 | But what is a "valid execution", in a parallel context? It means that the result of each command matches /at least one/ serialisation of those commands. This leads us to *caveat number 2:* it is expensive to check whether a command is valid. The number of potential serialisations for two threads is ~(2k)!/(k!^2)~, where ~k~ is the number of commands per thread. In order to validate an execution trace we may need to run our postconditions for /every/ potential serialisation. For more than two threads it grows even more quickly. In general, for ~n~ threads I think it's ~(nk)!/(k!^n)~ (based on observation and [[https://oeis.org/][OEIS]], I haven't proven it). This means that we want to keep the number of threads low, and the each thread's command list short. We can do this with some options: 19 | 20 | #+BEGIN_EXAMPLE 21 | (is (specification-correct? specification {:gen {:threads 2 22 | :max-length 5} 23 | :run {:max-tries 10}})) 24 | #+END_EXAMPLE 25 | 26 | This will now run the tests using at most ~2~ threads, with each thread (as well as the sequential prefix) restricted to at most ~5~ commands. We can control the ~:max-length~ of the sequential prefix separately to the sequential suffixes by using this: 27 | 28 | #+BEGIN_EXAMPLE 29 | (is (specification-correct? specification {:gen {:threads 2 30 | :max-length {:sequential 10 31 | :parallel 5}} 32 | :run {:max-tries 10}})) 33 | #+END_EXAMPLE 34 | 35 | Unfortunately ~stateful-check~ is fairly limited. While it can find bugs, it is not guaranteed to do so. A properly formed specification will never give a false positive: if the test failed then there is a bug somewhere - either in your specification or in your system. Unfortunately it is possible to give false negatives: tests which pass despite the presence of bugs. 36 | -------------------------------------------------------------------------------- /doc/specification.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Specifications 2 | 3 | ~stateful-check~ executions happen in three stages: command generation, command execution, and trace verification. 4 | 5 | First, commands are generated. In this stage, ~stateful-check~ uses your specification to generate a sequence of actions to perform, followed by a configurable number of parallel sequences to run (which defaults to zero). These commands are generated in-line with your specification such that the ~:requires~ and ~:preconditions~ for each command are valid. See below for more information about these attributes. 6 | 7 | Once a sequence of commands has been generated it is executed on a real system. This essentially consists of running each action in turn (i.e. the ~:command~ key), and storing its result. Note that no verification of the results is done until the execution has completed. If an exception is thrown then execution stops at that point. 8 | 9 | Finally, the results are verified. To do this, ~stateful-check~ will invoke each of the ~:postcondition~ functions in order to verify that they all return true. In the parallel case this is more difficult, but ~stateful-check~ will check to make sure that the observed results match /at least one/ of the expected execution orders (assuming each command is atomic). 10 | 11 | This clear separation of stages during execution means that no functions should interact with the System Under Test (SUT) /except/ for the ~:command~ function of each command, and the ~:setup~ and ~:cleanup~ functions of the specification. It may still be necessary to generate commands where the results of previous commands are re-used as arguments to later commands. To facilitate this ~stateful-check~ uses "symbolic values" which are replaced with real values during the execution phase. 12 | 13 | * Commands 14 | 15 | A command is a single action which the ~stateful-test~ runner may perform on the system. It specifies the command's expected semantics, which are then checked by random trials. 16 | 17 | ** Required 18 | 19 | Commands have one required function: 20 | 21 | | Key | Arguments | 22 | | ~:command~ | see optional ~:args~ function | 23 | 24 | The ~:command~ key specifies what to do when executing this command on the SUT. The arguments to this function are determined by the ~:args~ function (specified below). This is the /only/ function in a command specification that can interact with the SUT. 25 | 26 | ** Optional 27 | 28 | Commands have a number of optional functions: 29 | 30 | | Key | Arguments | Default value | 31 | | ~:requires~ | ~[state]~ | ~(constantly true)~ | 32 | 33 | The ~:requires~ key specifies a predicate that must be true in order for this command to be generated. If this function returns a falsey value then this command is not valid to generate with the provided ~state~. 34 | 35 | | Key | Arguments | Default value | 36 | | ~:args~ | ~[state]~ | ~(constantly nil)~ | 37 | 38 | The ~:args~ key specifies a function from the abstract state of the system to a generator. Values generated by the generator are then used as the arguments to this function (so the generated value must be ~seq~-able). The value returned by this function is converted into a generator with the following rules: 39 | - objects matching ~gen/generator?~ are left unmodified 40 | - vectors are turned into a ~gen/tuple~ of their contents, after each if converted into a generator 41 | - maps are turned into a ~gen/hash-map~ with the keys held constant, and the values are converted into generators 42 | - all other values are wrapped in ~gen/return~ (that is: generated themselves) 43 | 44 | During command execution, any "symbolic values" in the arguments for a command are replaced by the real value that they represent. 45 | 46 | | Key | Arguments | Default value | 47 | | ~:precondition~ | ~[state args]~ | ~(constantly true)~ | 48 | 49 | The ~:precondition~ is very similar to the ~:requires~ key, except that it runs after the command's arguments have been generated, and thus can test a relationship between the state and the generated arguments. If this function returns falsey then this command is not valid to generate with the provided ~state~ and ~args~. 50 | 51 | | Key | Arguments | Default value | 52 | | ~:next-state~ | ~[state args result]~ | ~(fn [state _ _] state)~ | 53 | 54 | The ~:next-state~ function denotes the effect of this command on the state. This command is called during command generation, but also during trace verification. 55 | 56 | During command generation the ~result~ provided to this function is an abstract object used as a "symbolic value" representing the return value of the ~:command~ function. These objects do not permit introspection of the return value, but they may be added to the state and used during argument generation for other commands. See the end of this document for some more information about symbolic values. 57 | 58 | During trace verification the ~result~ provided to this function is the value that was returned during command execution. It is important that the behaviour of the ~:next-state~ function is the same whether or not it is given a symbolic value or its real equivalent. If the ~:next-state~ function has different behaviours then it may create an inconsistent state object. To guard against this, you should not interact with the ~result~ object in any way, except those which are mentioned at the end of this document in the symbolic values section. 59 | 60 | | Key | Arguments | Default value | 61 | | ~:postcondition~ | ~[prev-state next-state args result]~ | ~(constantly true)~ | 62 | 63 | The ~:postcondition~ function is how test assertions are performed. This function is provided with the state before (~prev-state~) and after (~next-state~) this command's ~:next-state~ function is called. There are two ways for a postcondition to signal success/failure: 64 | 65 | - they can use ~clojure.test/is~, where a failed assertion means the command did not perform as expected on the SUT; or 66 | 67 | - if there are no ~clojure.test/is~ assertions, then they can return a falsey value to indicate the command did not perform as expected on the SUT. 68 | 69 | If a failure is indicated on a given command, the execution containing it is recorded as a failure. If an assertion has failed, then the expected/actual values will be printed to aid in debugging. 70 | 71 | Everything provided to the ~:postcondition~ function is a "real" value. All symbolic values will be replaced before the ~:postcondition~ function is called. 72 | 73 | Be aware that ~:postcondition~ functions run after the execution has completed, and thus any objects which have been mutated or otherwise changed may cause your test to fail. If you are planning to use a postcondition, ensure that your ~:command~ function returns an immutable value! 74 | 75 | * System Specifications 76 | 77 | System specifications are a representation of a number of commands which can be performed on an actual system. They specify setup/cleanup operations, initial state, and any extra rules around command generation. 78 | 79 | When running ~stateful-check~ it always expects a system specification to be provided at the top level. 80 | 81 | #+BEGIN_SRC clojure 82 | (is (specification-correct? system-specification)) 83 | #+END_SRC 84 | 85 | ** Required 86 | 87 | Specifications have one required key: 88 | 89 | | Key | Shape | 90 | | ~:commands~ | map of names to commands | 91 | 92 | The ~:commands~ key specifies all of the commands that can be used in this specification. Each command needs a "name", which will be used in the command output to identify which command is being run. 93 | 94 | The values of the map may either be a command map (see above section on their structure), or they may be a var which holds a reference to a command map. If the value is a var then it will be dereferenced whenever the command is generated (this permits the var to be redefined without needing to also redefine the spec). 95 | 96 | #+BEGIN_EXAMPLE 97 | {:new #'new-command 98 | :pop #'pop-command 99 | :push #'push-command} 100 | #+END_EXAMPLE 101 | 102 | ** Optional 103 | 104 | Specifications also have a number of optional functions: 105 | 106 | | Key | Arguments | Default value | 107 | | ~:generate-command~ | ~[state]~ | ~(gen/elements (:keys system-specification))~ | 108 | 109 | The ~:generate-command~ function is used to determine which command to add to the command list next. The generator returned by ~:generate-command~ is used to generate the name of the next command (which then goes through ordinary command generation). 110 | 111 | In general, if your commands are set up appropriately then you will not need to declare a ~:generate-command~ function. It can be helpful for changing the distribution of generated commands, or for increasing the efficiency of generation in some cases. 112 | 113 | | Key | Arguments | Default value | 114 | | ~:setup~ | none | ~nil~ | 115 | | ~:cleanup~ | ~[setup]~ or none | ~nil~ | 116 | 117 | The ~:setup~ function is run prior to the real execution phase. It should perform any one-time setup tasks which are necessary to prepare the SUT. 118 | 119 | The ~:cleanup~ function is run immediately after the real execution phase. It is always run (irrespective of the pass/fail state of the test) and should clean up any necessary resources. If you have declared a ~:setup~ function, then ~:cleanup~ will be called with its return value as an argument. If you have not declared a ~:setup~ function then ~:cleanup~ will be called with no arguments. 120 | 121 | | Key | Arguments | Default value | 122 | | ~:initial-state~ | none or ~[setup]~ | ~(constantly nil)~ | 123 | 124 | The ~:initial-state~ function is used to seed the ~state~ value, which is then used extensively throughout command generation and execution. 125 | 126 | If a ~:setup~ function has been provided then the ~:initial-state~ function will be passed a symbolic value representing the result of the setup. During execution the symbolic value will be replaced with the value that ~:setup~ returned for that execution. 127 | 128 | * Symbolic values 129 | 130 | Symbolic values are used during the abstract model phase in order to represent the results of real executions of commands. When they are used as the arguments to a command they are replaced by their concrete values. 131 | 132 | The only operation permitted on symbolic values is to lookup a key within them. During the real execution phase the corresponding key will be looked up in the concrete value (so ~(:key symbolic-value)~ will, during real execution, be replaced with ~(:key concrete-value)~). 133 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojars.czan/stateful-check "0.4.4" 2 | :description "Stateful generative testing in clojure" 3 | :url "https://github.com/czan/stateful-check" 4 | :license {:name "MIT" 5 | :url "https://opensource.org/licenses/MIT"} 6 | :dependencies [[org.clojure/clojure "1.8.0"] 7 | [org.clojure/test.check "1.1.0"]] 8 | :test-selectors {:default #(not (:interactive %)) 9 | :interactive :interactive} 10 | :repositories [["releases" {:url "https://clojars.org/repo" 11 | :creds :gpg}]]) 12 | -------------------------------------------------------------------------------- /src/stateful_check/command_utils.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.command-utils 2 | (:require [clojure.test :refer [report]] 3 | [clojure.test.check.generators :as gen])) 4 | 5 | (defn to-generator 6 | "Convert a value into a generator, recursively. This means: 7 | + generator? -> the value 8 | + sequential? -> gen/tuple with each sub-value already processed 9 | + map? -> gen/hash-map with each value (not keys) already processed 10 | + otherwise -> gen/return the value" 11 | [value] 12 | (cond (gen/generator? value) value 13 | (sequential? value) (apply gen/tuple (map to-generator value)) 14 | (map? value) (apply gen/hash-map (mapcat (fn [[k v]] 15 | [k (to-generator v)]) 16 | value)) 17 | :else (gen/return value))) 18 | 19 | (defn args-gen 20 | "Generate the arguments for a command, taking into account whether 21 | or not the command declares a :args function." 22 | [command state] 23 | (to-generator (when-let [args (:args command)] 24 | (args state)))) 25 | 26 | (defn check-requires 27 | "Check the requirements for a command to be generated at all, taking 28 | into account whether or not the command declares a :requires 29 | function." 30 | [command state] 31 | (if-let [requires (:requires command)] 32 | (requires state) 33 | true)) 34 | 35 | (defn check-precondition 36 | "Check the precondition for a command, taking into account whether 37 | or not the command declares a :precondition function." 38 | [command state args] 39 | (if-let [precondition (:precondition command)] 40 | (precondition state args) 41 | true)) 42 | 43 | (defn make-next-state 44 | "Make the next state for a command, taking into account whether or 45 | not the command declares a :next-state function." 46 | [command state args result] 47 | (if-let [next-state (:next-state command)] 48 | (next-state state args result) 49 | state)) 50 | 51 | (defn check-postcondition 52 | "Check the postcondition for a command, taking into account whether or 53 | not the command declares a :postcondition function. Returns nil if 54 | the postcondition passes, otherwise returns a map with a :message 55 | key describing the failure. If the postcondition made any 56 | clojure.test assertions, events of type :fail and :error are added 57 | to the result under the :events key." 58 | [command prev-state next-state args result] 59 | (if-let [postcondition (:postcondition command)] 60 | (let [events (atom [])] 61 | (binding [report (fn [event] (swap! events conj event))] 62 | (let [postcondition-result (postcondition prev-state next-state args result) 63 | all-events @events 64 | pass-events (filter (comp #{:pass} :type) all-events) 65 | failure-events (filter (comp #{:fail :error} :type) all-events)] 66 | (cond 67 | ;; If we have explicit failure events, fail the 68 | ;; postcondition. 69 | (seq failure-events) {:message "Postcondition reported failures." 70 | :events failure-events} 71 | ;; If we have explicit pass events, and no failure events, 72 | ;; then pass the test. 73 | (seq pass-events) nil 74 | ;; If we don't have pass or fail events, then just use the 75 | ;; postcondition result by itself. 76 | postcondition-result nil 77 | :else {:message "Postcondition returned falsey."})))) 78 | nil)) 79 | -------------------------------------------------------------------------------- /src/stateful_check/core.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.core 2 | (:require [clojure.pprint :as pp] 3 | [clojure.string :as str] 4 | [clojure.test :as t] 5 | [clojure.test.check :refer [quick-check]] 6 | [clojure.test.check.properties :refer [for-all] :as p] 7 | [clojure.test.check.results :refer [Result pass? result-data]] 8 | [stateful-check.generator :as g] 9 | [stateful-check.runner :as r]) 10 | (:import [stateful_check.runner CaughtException])) 11 | 12 | (def default-num-tests 200) 13 | (def default-max-tries 1) 14 | (def default-timeout-ms 0) 15 | (def default-assume-immutable-results false) 16 | 17 | (defrecord TestResult [pass? result-data] 18 | Result 19 | (pass? [this] pass?) 20 | (result-data [this] result-data)) 21 | 22 | (defn- failures 23 | "Return a map mapping from a command handle to a set of failures 24 | indicating failures that occurred during all the interleavings of a 25 | command set." 26 | [spec commands results bindings] 27 | (let [interleavings (g/every-interleaving (mapv vector 28 | (:sequential commands) 29 | (:sequential results)) 30 | (mapv (partial mapv vector) 31 | (:parallel commands) 32 | (:parallel results))) 33 | init-state-fn (or (:initial-state spec) 34 | (constantly nil)) 35 | init-state (if (:setup spec) 36 | (init-state-fn (get bindings g/setup-var)) 37 | (init-state-fn)) 38 | failures (map #(r/failure % init-state bindings) interleavings)] 39 | (when (every? some? failures) ;; if all paths failed 40 | (->> failures 41 | (map (fn [[handle failure]] 42 | {handle #{failure}})) 43 | (apply merge-with into))))) 44 | 45 | (defn combine-cmds-with-traces [command result result-str] 46 | [command 47 | (cond 48 | (= ::r/unevaluated result) result 49 | (instance? CaughtException result) result 50 | :else (if (nil? result-str) 51 | (pr-str result) 52 | (let [last-str (pr-str result)] 53 | (if (= result-str last-str) 54 | result-str 55 | (str result-str 56 | "\n >> object may have been mutated later into " last-str " <<\n")))))]) 57 | 58 | (def ^:dynamic *run-commands* nil) 59 | 60 | (defn build-test-runner [specification commands timeout-ms assume-immutable-results] 61 | "Return a function to execute each of `commands` and report a `TestResult`." 62 | (let [runners (r/commands->runners commands)] 63 | (fn [] 64 | (let [setup-result (when-let [setup (:setup specification)] 65 | (setup))] 66 | (try 67 | (let [bindings (if (:setup specification) 68 | {g/setup-var setup-result} 69 | {}) 70 | results (r/runners->results runners bindings timeout-ms assume-immutable-results)] 71 | (if-let [failures (failures specification commands results bindings)] 72 | (->TestResult false 73 | {:message "Test failed." 74 | :failures failures 75 | :sequential (mapv combine-cmds-with-traces 76 | (:sequential commands) 77 | (:sequential results) 78 | (:sequential-strings results)) 79 | :parallel (mapv (partial mapv combine-cmds-with-traces) 80 | (:parallel commands) 81 | (:parallel results) 82 | (:parallel-strings results))}) 83 | (->TestResult true {}))) 84 | (catch clojure.lang.ExceptionInfo ex 85 | (->TestResult 86 | false 87 | (if (= (.getMessage ex) "Timed out") 88 | (let [results (ex-data ex)] 89 | {:message "Test timed out." 90 | :failures {nil {:message (format "Test timed out after %sms" timeout-ms)}} 91 | :sequential (mapv combine-cmds-with-traces 92 | (:sequential commands) 93 | (:sequential results) 94 | (:sequential-strings results)) 95 | :parallel (mapv (partial mapv combine-cmds-with-traces) 96 | (:parallel commands) 97 | (:parallel results) 98 | (:parallel-strings results))}) 99 | ;; Any other type of exception is re-thrown, because it's 100 | ;; unexpected. The command runners catch exceptions where they 101 | ;; are expected, so any other exceptions represent programmer 102 | ;; error and should fail the test immediately. 103 | (throw ex)))) 104 | (finally 105 | (when-let [cleanup (:cleanup specification)] 106 | (if (:setup specification) 107 | (cleanup setup-result) 108 | (cleanup))))))))) 109 | 110 | (defn spec->property 111 | "Turn a specification into a testable property." 112 | ([spec] (spec->property spec nil)) 113 | ([spec options] 114 | (for-all [commands (g/commands-gen spec (:gen options))] 115 | (when *run-commands* 116 | (doseq [cmds (cons (:sequential commands) 117 | (:parallel commands))] 118 | (->> cmds 119 | (into {} (map (fn [[_ {:keys [name]} _]] 120 | [name 1]))) 121 | (swap! *run-commands* #(merge-with + %1 %2))))) 122 | (let [run-test (build-test-runner spec 123 | commands 124 | (get-in options [:run :timeout-ms] default-timeout-ms) 125 | (get-in options [:run :assume-immutable-results] default-assume-immutable-results))] 126 | (loop [tries-left (get-in options [:run :max-tries] default-max-tries)] 127 | (if (zero? tries-left) 128 | (->TestResult true {:commands commands, :options options, :specification spec}) 129 | (let [try-result (run-test)] 130 | (if (pass? try-result) 131 | (recur (dec tries-left)) 132 | (update try-result :result-data 133 | merge {:commands commands, :options options, :specification spec}))))))))) 134 | 135 | (defn- print-failures [handle failures] 136 | (doseq [{:keys [message events]} (get failures handle)] 137 | (if (seq events) 138 | (doseq [{:keys [message] :as event} events] 139 | (when message 140 | (println " " message)) 141 | (doseq [detail [:expected :actual]] 142 | (->> (str/split (with-out-str (pp/pprint (get event detail))) #"\n") 143 | (remove str/blank?) 144 | (str/join "\n ") 145 | (str (format "%12s: " (name detail))) 146 | (println)))) 147 | (println " " message)))) 148 | 149 | (defn- print-sequence [commands stacktrace? failures] 150 | (doseq [[[handle cmd & args] trace] commands] 151 | (printf " %s = %s %s\n" 152 | (pr-str handle) 153 | (cons (:name cmd) 154 | args) 155 | (if (= ::r/unevaluated trace) 156 | "" 157 | (str " = " 158 | (if (instance? CaughtException trace) 159 | (if stacktrace? 160 | (with-out-str 161 | (.printStackTrace ^Throwable (:exception trace) 162 | (java.io.PrintWriter. *out*))) 163 | (.toString ^Object (:exception trace))) 164 | trace)))) 165 | (print-failures handle failures))) 166 | 167 | (defn print-execution [{:keys [message sequential parallel failures]} stacktrace?] 168 | (printf "Sequential prefix:\n") 169 | (print-sequence sequential stacktrace? failures) 170 | (doseq [[i thread] (map vector (range) parallel)] 171 | (printf "\nThread %s:\n" (g/index->letter i)) 172 | (print-sequence thread stacktrace? failures)) 173 | (print-failures nil failures)) 174 | 175 | (defn run-specification 176 | "Run a specification. This will convert the spec into a property and 177 | run it using clojure.test.check/quick-check. This function then 178 | returns the full quick-check result." 179 | ([specification] (run-specification specification nil)) 180 | ([specification options] 181 | (quick-check (get-in options [:run :num-tests] default-num-tests) 182 | (spec->property specification options) 183 | :seed (get-in options [:run :seed] (System/currentTimeMillis)) 184 | :max-size (get-in options [:gen :max-size] g/default-max-size)))) 185 | 186 | (defn specification-correct? 187 | "Test whether or not the specification matches reality. This 188 | generates test cases and runs them. If run with in an `is`, it will 189 | report details (and pretty-print them) if it fails. 190 | 191 | The `options` map consists of three potential keys: `:gen`, `:run`, 192 | and `:report`, each of which influence a different part of the test. 193 | 194 | `:gen` has four sub-keys: 195 | - `:threads` specifies how many parallel threads to execute 196 | - `:max-length` specifies a max length for command sequences 197 | - `:max-size` specifies a maximum size for generated values 198 | - `:shrink-strategies` specifies a sequence of shrink strategies 199 | that should be tried (in order) to reduce the size of a failing 200 | test (see `stateful-check.generator/default-shrink-strategies` 201 | and `stateful-check.shrink-strategies`) 202 | 203 | `:run` has three sub-keys: 204 | - `:max-tries` specifies how attempts to make to fail a test 205 | - `:num-tests` specifies how many tests to run 206 | - `:seed` specifies the initial seed to use for generation 207 | - `:timeout-ms` specifies the maximum number of milliseconds that a 208 | test is permitted to run for - taking longer is considered a 209 | failure (default: 0, meaning no timeout; see NOTE below for more 210 | details) 211 | - `:assume-immutable-results` specifies whether the runner should 212 | assume that the results of running commands are immutable, and 213 | thus delay string converstions until the end of the test run 214 | (default: false) 215 | 216 | `:report` has two sub-keys, but only works within an `is`: 217 | - `:first-case?` specifies whether to print the first failure 218 | - `:stacktrace?` specifies whether to print exception stacktraces 219 | - `:command-frequency?` specifies whether to print information 220 | about how often each command was run 221 | 222 | The `:timeout-ms` option is unsafe in general, but may be helpful in 223 | some circumstances. It allows you to categorise a test as a failure 224 | if it takes more than a given time, but each of the threads must 225 | respond to being interrupted by completing and shutting down. If 226 | these threads do not shut themselves down then they may continue to 227 | consume system resources (CPU and memory, among other things), 228 | impacting other tests." 229 | ([specification] (specification-correct? specification nil)) 230 | ([specification options] 231 | (:pass? (run-specification specification options)))) 232 | ;; We need this to be a separate form, for some reason. The attr-map 233 | ;; in defn doesn't work if you use the multi-arity form. 234 | (alter-meta! #'specification-correct? assoc :arglists 235 | `([~'specification] 236 | [~'specification {:gen {:threads ~g/default-threads 237 | :max-length ~g/default-max-length 238 | :max-size ~g/default-max-size 239 | :shrink-strategies g/default-shrink-strategies} 240 | :run {:max-tries ~default-max-tries 241 | :num-tests ~default-num-tests 242 | :seed (System/currentTimeMillis) 243 | :timeout-ms ~default-timeout-ms} 244 | :report {:first-case? false 245 | :stacktrace? false 246 | :command-frequency? false}}])) 247 | 248 | (defn report-result [msg _ options results frequencies] 249 | (let [result-data (:result-data results) 250 | smallest-result-data (get-in results [:shrunk :result-data])] 251 | (when (get-in options [:report :command-frequency?] false) 252 | (print "Command execution counts:") 253 | (pp/print-table (->> frequencies 254 | (sort-by val) 255 | reverse ;; big numbers on top 256 | (map #(hash-map :command (key %) 257 | :count (val %)))))) 258 | (cond 259 | (::p/error result-data) 260 | (t/do-report {:type :error, 261 | :fault :true 262 | :message msg 263 | :expected nil, 264 | :actual (::p/error result-data)}) 265 | 266 | (:pass? results) 267 | (t/do-report {:type :pass, 268 | :message msg, 269 | :expected true, 270 | :actual true}) 271 | 272 | :else 273 | (t/do-report {:type :fail, 274 | :message (with-out-str 275 | (binding [*out* (java.io.PrintWriter. *out*)] 276 | (when msg 277 | (println msg)) 278 | (when (get-in options [:report :first-case?] false) 279 | (println " First failing test case") 280 | (println " -----------------------------") 281 | (print-execution result-data 282 | (get-in options [:report :stacktrace?] false)) 283 | (println) 284 | (println " Smallest case after shrinking") 285 | (println " -----------------------------")) 286 | (if (::p/error smallest-result-data) 287 | (.printStackTrace ^Throwable (::p/error smallest-result-data) 288 | ^java.io.PrintWriter *out*) 289 | (print-execution smallest-result-data 290 | (get-in options [:report :stacktrace?] false))) 291 | (println) 292 | (println "Seed:" (:seed results)) 293 | (when (> (get-in options [:gen :threads] 0) 1) 294 | (println (str " Note: Test cases with multiple threads are not deterministic, so using the\n" 295 | " same seed does not guarantee the same result."))))) 296 | :expected (symbol "all executions to match specification"), 297 | :actual (symbol "the above execution did not match the specification")})) 298 | (:pass? results))) 299 | 300 | (defmethod t/assert-expr 'specification-correct? 301 | [msg [_ specification options]] 302 | `(let [spec# ~specification 303 | options# ~options 304 | run-commands# (->> spec# :commands keys (into {} (map #(vector % 0)))) 305 | [results# frequencies#] (binding [*run-commands* (atom run-commands#)] 306 | [(run-specification spec# options#) 307 | @*run-commands*])] 308 | (report-result ~msg spec# options# results# frequencies#))) 309 | -------------------------------------------------------------------------------- /src/stateful_check/generator.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.generator 2 | (:require [clojure.test.check.generators :as gen] 3 | [clojure.test.check.rose-tree :as rose] 4 | [stateful-check.symbolic-values :as sv] 5 | [stateful-check.command-utils :as u] 6 | [stateful-check.shrink-strategies :as shrink])) 7 | 8 | (def default-max-length 5) 9 | (def default-threads 0) 10 | (def default-max-size 200) 11 | (def default-shrink-strategies 12 | [(shrink/remove-n-commands-from-sequential-prefix 1) 13 | (shrink/remove-n-commands-from-sequential-prefix 2) 14 | (shrink/pull-parallel-into-sequential) 15 | (shrink/remove-n-commands-from-parallel-threads 1) 16 | (shrink/remove-n-commands-from-parallel-threads 2)]) 17 | 18 | (def setup-var (sv/->RootVar "setup")) 19 | 20 | (defn- command-obj-gen [spec state] 21 | (let [unwrap #(if (var? %) @% %)] 22 | (if-let [generate-command (:generate-command spec)] 23 | (gen/such-that #(u/check-requires % state) 24 | (gen/fmap (fn [name] 25 | (assoc (unwrap (get (:commands spec) name)) 26 | :name name)) 27 | (generate-command state))) 28 | (let [valid-commands (->> (:commands spec) 29 | (map (fn [[name cmd-obj]] 30 | (assoc (unwrap cmd-obj) 31 | :name name))) 32 | (filter #(u/check-requires % state)))] 33 | (assert (seq valid-commands) 34 | (str "At least one command must pass :requires with state: " (prn-str state))) 35 | (gen/elements valid-commands))))) 36 | 37 | (defn- command-gen [spec state] 38 | (gen/gen-bind (command-obj-gen spec state) 39 | (fn [cmd-obj-rose] 40 | (let [cmd-obj (rose/root cmd-obj-rose)] 41 | (gen/fmap #(cons cmd-obj %) 42 | (u/args-gen cmd-obj state)))))) 43 | 44 | (defn- command-sequence-tree-gen [spec state vars] 45 | (gen/gen-bind (gen/choose 0 (count vars)) 46 | (fn [choice] 47 | (if (zero? (rose/root choice)) 48 | (gen/gen-pure [[] state]) 49 | (gen/gen-bind (command-gen spec state) 50 | (fn [cmd-and-args-tree] 51 | (let [[cmd-obj & args] (rose/root cmd-and-args-tree) 52 | result (first vars)] 53 | (if (u/check-precondition cmd-obj state args) 54 | (let [next-state (u/make-next-state cmd-obj state args result)] 55 | (gen/gen-bind (command-sequence-tree-gen spec next-state (next vars)) 56 | (fn [[cmd-list-tail-tree next-next-state]] 57 | (gen/gen-pure [(cons (rose/fmap #(cons result %) 58 | cmd-and-args-tree) 59 | cmd-list-tail-tree) 60 | next-next-state])))) 61 | (command-sequence-tree-gen spec state vars))))))))) 62 | 63 | ;; if the test requires more than 26 threads then I am impressed 64 | (def ^:private thread-names "abcdefghijklmnopqrstuvwxzy") 65 | 66 | (defn index->letter [n] 67 | (nth thread-names n)) 68 | 69 | (defn make-vars [length thread-id] 70 | (map (fn [i] (sv/->RootVar (str (inc i) 71 | (when thread-id 72 | (index->letter thread-id))))) 73 | (range length))) 74 | 75 | (defn- parallel-command-sequence-gen [spec state {:keys [max-length threads]}] 76 | (let [[seq-length par-length] (if (map? max-length) 77 | ((juxt :sequential :parallel) max-length) 78 | [max-length max-length]) 79 | seq-length (or seq-length default-max-length) 80 | par-length (or par-length default-max-length)] 81 | (letfn [(parallel-commands-gen [n state] 82 | (if (zero? n) 83 | (gen/gen-pure []) 84 | (gen/gen-bind (command-sequence-tree-gen spec state (make-vars par-length (dec n))) 85 | (fn [[tree state]] 86 | (gen/gen-bind (parallel-commands-gen (dec n) state) 87 | (fn [other-trees] 88 | (gen/gen-pure (conj other-trees (vec tree)))))))))] 89 | (gen/gen-bind (command-sequence-tree-gen spec state (make-vars seq-length nil)) 90 | (fn [[sequential-trees state]] 91 | (gen/gen-bind (parallel-commands-gen threads state) 92 | (fn [parallel-trees] 93 | (gen/gen-pure {:sequential (vec sequential-trees) 94 | :parallel parallel-trees})))))))) 95 | 96 | (defn- shrink-parallel-command-sequence 97 | ([strategies {:keys [sequential parallel]}] 98 | (shrink-parallel-command-sequence strategies sequential parallel)) 99 | ([strategies sequential parallel] 100 | (let [parallel (filterv seq parallel)] 101 | (rose/make-rose {:sequential (mapv rose/root sequential) 102 | :parallel (mapv #(mapv rose/root %) parallel)} 103 | (for [shrink (or strategies default-shrink-strategies) 104 | [seq par] (shrink sequential parallel)] 105 | (shrink-parallel-command-sequence strategies seq par)))))) 106 | 107 | (defn- valid-commands? [cmd-objs state bindings] 108 | (boolean (reduce (fn [[state bindings] [handle cmd-obj & args]] 109 | (if (and (u/check-requires cmd-obj state) 110 | (every? #(sv/valid? % bindings) args) 111 | (u/check-precondition cmd-obj state args)) 112 | [(u/make-next-state cmd-obj state args handle) 113 | (conj bindings handle)] 114 | (reduced false))) 115 | [state bindings] cmd-objs))) 116 | 117 | (defn every-interleaving 118 | ([{:keys [sequential parallel]}] (every-interleaving sequential parallel)) 119 | ([sequential parallel] 120 | (let [parallel (filterv seq parallel)] 121 | (if (empty? parallel) 122 | (list sequential) 123 | (mapcat (fn [i thread] 124 | (every-interleaving (conj sequential (first thread)) 125 | (update parallel i (comp vec next)))) 126 | (range) parallel))))) 127 | 128 | (defn commands-gen [spec {:keys [threads max-length shrink-strategies]}] 129 | (let [init-state-fn (or (:initial-state spec) 130 | (constantly nil)) 131 | init-state (if (:setup spec) 132 | (init-state-fn setup-var) 133 | (init-state-fn)) 134 | init-bindings (if (:setup spec) 135 | #{setup-var} 136 | #{})] 137 | (->> (parallel-command-sequence-gen spec init-state {:max-length max-length 138 | :threads (or threads default-threads)}) 139 | (gen/gen-fmap (partial shrink-parallel-command-sequence shrink-strategies)) 140 | (gen/such-that (fn [cmds] 141 | ;; we need to generate lists of commands 142 | ;; that are valid no matter how they're 143 | ;; executed (assuming each command is 144 | ;; atomic), that way we know that no matter 145 | ;; how the execution goes, we'll be able to 146 | ;; tell the difference between a failure and 147 | ;; a success 148 | (every? #(valid-commands? % init-state init-bindings) 149 | (every-interleaving cmds))))))) 150 | -------------------------------------------------------------------------------- /src/stateful_check/runner.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.runner 2 | (:require [stateful-check.command-utils :as u] 3 | [stateful-check.symbolic-values :as sv])) 4 | 5 | (defn make-sequential-runners [cmd-objs] 6 | (mapv (fn [[handle cmd-obj & args]] 7 | (if-let [function (:command cmd-obj)] 8 | [handle #(apply function (sv/get-real-value args %))] 9 | (throw (AssertionError. (str "No :command function found for " 10 | (:name cmd-obj) 11 | " command"))))) 12 | cmd-objs)) 13 | 14 | (defrecord CaughtException [exception]) 15 | 16 | (defn run-sequential-runners [runners bindings assume-immutable-results] 17 | (reduce (fn [[bindings trace str-trace] [handle f]] 18 | (try 19 | (let [value (f bindings)] 20 | [(assoc bindings handle value) 21 | (conj trace value) 22 | (if assume-immutable-results 23 | (conj str-trace nil) 24 | (conj str-trace (pr-str value)))]) 25 | (catch Exception exception 26 | (reduced [bindings 27 | (conj trace (->CaughtException exception)) 28 | (if assume-immutable-results 29 | (conj str-trace nil) 30 | (conj str-trace exception)) 31 | exception])))) 32 | [bindings [] []] 33 | runners)) 34 | 35 | (defn commands->runners [{:keys [sequential parallel]}] 36 | {:sequential (make-sequential-runners sequential) 37 | :parallel (mapv make-sequential-runners parallel)}) 38 | 39 | (defmacro with-timeout [timeout-ms & body] 40 | `(let [timeout-ms# ~timeout-ms] 41 | (if (<= timeout-ms# 0) 42 | (do ~@body) 43 | (let [f# (future ~@body) 44 | v# (deref f# timeout-ms# ::timeout)] 45 | (if (= v# ::timeout) 46 | (do (future-cancel f#) 47 | (throw (InterruptedException. "Timed out"))) 48 | v#))))) 49 | 50 | (defn runners->results [{:keys [sequential parallel]} bindings timeout-ms assume-immutable-results] 51 | (try 52 | (with-timeout timeout-ms 53 | (let [[bindings trace str-trace exception] (run-sequential-runners sequential bindings assume-immutable-results) 54 | latch (java.util.concurrent.atomic.AtomicBoolean. true) 55 | futures (when-not exception 56 | (mapv #(future 57 | (while (.get latch) 58 | ;; spin until all the futures have been 59 | ;; created (this is probably unnecessary, 60 | ;; but just in case) 61 | ) 62 | (run-sequential-runners % bindings assume-immutable-results)) 63 | parallel))] 64 | (try 65 | (.set latch false) 66 | (let [values (mapv deref futures)] 67 | {:sequential trace 68 | :sequential-strings str-trace 69 | :parallel (mapv #(nth % 1) values) 70 | :parallel-strings (mapv #(nth % 2) values)}) 71 | (catch InterruptedException ex 72 | (mapv future-cancel futures))))) 73 | (catch InterruptedException ex 74 | (throw (ex-info "Timed out" 75 | {:sequential (mapv (constantly ::unevaluated) sequential) 76 | :sequential-strings (mapv (constantly "???") sequential) 77 | :parallel (mapv #(mapv (constantly ::unevaluated) %) parallel) 78 | :parallel-strings (mapv #(mapv (constantly "???") %) parallel)}))))) 79 | 80 | (defn failure 81 | "Return a vector of [handle failure] representing which command 82 | failed, and why. Returns nil if no command has failed. 83 | 84 | The failure entry is a map with a :message key and an 85 | optional :events key, which contains clojure.test report events of 86 | type :error and :fail that were emitted during the evaluation of the 87 | postcondition." 88 | [cmds-and-traces state bindings] 89 | (first (reduce (fn [[_ state bindings] [[handle cmd-obj & args] result]] 90 | (if (instance? CaughtException result) 91 | (reduced [[handle {:message "Unexpected exception thrown."}]]) 92 | (let [replaced-args (sv/get-real-value args bindings) 93 | next-state (u/make-next-state cmd-obj state replaced-args result)] 94 | (if-let [failure (u/check-postcondition cmd-obj state next-state replaced-args result)] 95 | (reduced [[handle failure]]) 96 | [nil 97 | next-state 98 | (assoc bindings handle result)])))) 99 | [nil state bindings] cmds-and-traces))) 100 | -------------------------------------------------------------------------------- /src/stateful_check/shrink_strategies.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.shrink-strategies 2 | (:require [clojure.test.check.rose-tree :as rose])) 3 | 4 | ;; Within this file: 5 | ;; 6 | ;; - sequential is a vector of rose trees that represents the 7 | ;; sequential prefix of a command execution 8 | ;; 9 | ;; - parallel is a vector of vectors of rose trees that represents 10 | ;; several parallel threads of command execution 11 | 12 | (defn remove-n-commands-from-sequential-prefix 13 | "Return a shrink strategy that will remove `n` commands from the 14 | sequential prefix." 15 | [n] 16 | (fn [sequential parallel] 17 | (map #(vector (vec %) parallel) 18 | (reduce (fn [sequentials _] 19 | (mapcat rose/remove sequentials)) 20 | [sequential] (range n))))) 21 | 22 | (defn remove-n-commands-from-parallel-threads 23 | "Return a shrink strategy that will remove `n` commands from a 24 | parallel thread, trying each thread in sequence." 25 | [n] 26 | (fn [sequential parallel] 27 | (map #(vector sequential %) 28 | (reduce (fn [parallels _] 29 | (for [parallel parallels 30 | [i thread] (map vector (range) parallel) 31 | thread (rose/remove thread)] 32 | (assoc parallel i thread))) 33 | [parallel] (range n))))) 34 | 35 | (defn pull-parallel-into-sequential 36 | "Return a shrink strategy that will move the first command from a 37 | parallel thread to be the last command in the sequential prefix. 38 | This may lead to further opportunities to shrink the sequential 39 | prefix." 40 | [] 41 | (fn [sequential parallel] 42 | (for [[i thread] (map vector (range) parallel)] 43 | ;; pull one of the first parallel commands into the sequential prefix 44 | [(conj sequential (first thread)) 45 | (update parallel i (comp vec next))]))) 46 | -------------------------------------------------------------------------------- /src/stateful_check/symbolic_values.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.symbolic-values 2 | (:require [clojure.walk :as walk])) 3 | 4 | (defprotocol SymbolicValue 5 | (get-real-value* [this real-values] 6 | "Lookup the value of this symbolic value in a real-values map") 7 | (valid?* [this results] 8 | "Detemine whether this symbolic value can be legally looked up in the results map")) 9 | 10 | (defn get-real-value [argument real-values] 11 | ;; This is a prewalk, in case substituting a symbolic value leads to 12 | ;; more opportunities to substitute symbolic values. 13 | (walk/prewalk (fn [value] 14 | (if (satisfies? SymbolicValue value) 15 | (get-real-value* value real-values) 16 | value)) 17 | argument)) 18 | 19 | (defonce invalid-exception (Exception.)) 20 | 21 | (defn valid? [argument results] 22 | (try 23 | ;; This is a postwalk, so returning nil from the walk function 24 | ;; doesn't prune the tree. 25 | (walk/postwalk (fn [value] 26 | (when (and (satisfies? SymbolicValue value) 27 | (not (valid?* value results))) 28 | (throw invalid-exception))) 29 | argument) 30 | true 31 | (catch Exception e 32 | (if (identical? e invalid-exception) 33 | false 34 | (throw e))))) 35 | 36 | 37 | 38 | (deftype LookupVar [root-var key not-found] 39 | SymbolicValue 40 | (get-real-value* [this real-values] 41 | (get (get-real-value* root-var real-values) 42 | key 43 | not-found)) 44 | (valid?* [this results] 45 | (valid?* root-var results)) 46 | 47 | Object 48 | (equals [this other] 49 | (and (instance? LookupVar other) 50 | (= (.-root-var this) 51 | (.-root-var ^LookupVar other)) 52 | (= (.-key this) 53 | (.-key ^LookupVar other)) 54 | (= (.-not-found this) 55 | (.-not-found ^LookupVar other)))) 56 | (hashCode [this] 57 | (java.util.Objects/hash (into-array Object [root-var key not-found]))) 58 | 59 | clojure.lang.ILookup 60 | (valAt [this key] 61 | (LookupVar. this key nil)) 62 | (valAt [this key not-found] 63 | (LookupVar. this key not-found)) 64 | 65 | (toString [this] 66 | (str "(get " root-var " " (pr-str key) 67 | (when-not (nil? not-found) 68 | (str " " (pr-str not-found))) 69 | ")"))) 70 | 71 | (defmethod print-method LookupVar 72 | [^LookupVar v, ^java.io.Writer writer] 73 | (.write writer (.toString v))) 74 | 75 | 76 | 77 | (deftype RootVar [name] 78 | SymbolicValue 79 | (get-real-value* [this real-values] 80 | (get real-values this)) 81 | (valid?* [this results] 82 | (contains? results this)) 83 | 84 | Object 85 | (equals [this other] 86 | (and (instance? RootVar other) 87 | (= (.-name this) 88 | (.-name ^RootVar other)))) 89 | (hashCode [this] 90 | (.hashCode name)) 91 | 92 | clojure.lang.ILookup 93 | (valAt [this key] 94 | (->LookupVar this key nil)) 95 | (valAt [this key not-found] 96 | (->LookupVar this key not-found)) 97 | 98 | (toString [this] 99 | (str "#<" (.-name this) ">"))) 100 | 101 | (defmethod print-method RootVar 102 | [^RootVar v, ^java.io.Writer writer] 103 | (.write writer (.toString v))) 104 | -------------------------------------------------------------------------------- /test/stateful_check/atomic_set_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.atomic-set-test 2 | (:require [clojure.test :refer :all] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer :all])) 5 | 6 | ;; 7 | ;; Implementation 8 | ;; 9 | 10 | (def global-state (atom #{})) 11 | 12 | ;; 13 | ;; Generative commands 14 | ;; 15 | 16 | (def add-command 17 | {:args (fn [_] [gen/nat]) 18 | :command #(swap! global-state conj %) 19 | :next-state (fn [state [arg] _] 20 | (conj (or state #{}) arg))}) 21 | 22 | (def remove-command 23 | {:requires (fn [state] (seq state)) 24 | :args (fn [state] [(gen/elements state)]) 25 | :command #(swap! global-state disj %) 26 | :next-state (fn [state [arg] _] 27 | (disj state arg))}) 28 | 29 | (def contains?-command 30 | {:requires (fn [state] (seq state)) 31 | :args (fn [state] [(gen/one-of [(gen/elements state) gen/nat])]) 32 | :command #(contains? @global-state %) 33 | :postcondition (fn [state _ [value] result] 34 | (= (contains? state value) result))}) 35 | 36 | (def empty?-command 37 | {:command #(empty? @global-state) 38 | :postcondition (fn [state _ _ result] 39 | (= (empty? state) result))}) 40 | 41 | (def empty-command 42 | {:command (fn [] (reset! global-state #{})) 43 | :next-state (fn [state _ _] #{})}) 44 | 45 | ;; 46 | ;; Generative specification 47 | ;; 48 | 49 | (def specification 50 | {:commands {:add #'add-command 51 | :remove #'remove-command 52 | :contains? #'contains?-command 53 | :empty? #'empty?-command 54 | :empty #'empty-command} 55 | :initial-state (constantly #{}) 56 | :setup #(reset! global-state #{})}) 57 | 58 | (deftest atomic-set-test 59 | (is (specification-correct? specification))) 60 | -------------------------------------------------------------------------------- /test/stateful_check/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.core-test 2 | (:require [clojure 3 | [set :as set] 4 | [string :as str] 5 | [test :refer :all]] 6 | [clojure.test.check.generators :as gen] 7 | [stateful-check.core :refer :all])) 8 | 9 | (defn ticker-init [] (atom 0)) 10 | (defn ticker-zero [ticker] (reset! ticker 0)) 11 | (defn ticker-take [ticker] (swap! ticker inc)) 12 | 13 | (def ticker-spec {:commands {:alloc-ticker {:next-state (fn [state _ ticker] 14 | (assoc state ticker 0)) 15 | :command ticker-init} 16 | 17 | :zero {:args (fn [state] 18 | [(gen/elements (keys state))]) 19 | :precondition (fn [state _] state) 20 | :next-state (fn [state [ticker] _] 21 | (assoc state ticker 0)) 22 | :command ticker-zero} 23 | 24 | :take-ticket {:args (fn [state] 25 | [(gen/elements (keys state))]) 26 | :precondition (fn [state _] state) 27 | :next-state (fn [state [ticker] _] 28 | (assoc state 29 | ticker (inc (get state ticker)))) 30 | :command ticker-take 31 | :postcondition (fn [state _ [ticker] result] 32 | (= result (inc (get state ticker))))}} 33 | :generate-command (fn [state] 34 | (gen/elements (if (nil? state) 35 | [:alloc-ticker] 36 | [:alloc-ticker :zero :take-ticket])))}) 37 | 38 | (deftest ticker-test 39 | (is (specification-correct? ticker-spec))) 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | (defn alist-get [alist key] 54 | (some (fn [[k v]] 55 | (if (identical? k key) 56 | v)) 57 | alist)) 58 | 59 | (defn alist-update [alist key f & args] 60 | (mapv (fn [[k v]] 61 | (if (identical? k key) 62 | [k (apply f v args)] 63 | [k v])) 64 | alist)) 65 | 66 | (def new-set-command 67 | {:next-state (fn [state _ result] 68 | (if state 69 | (conj state [result #{}]) 70 | [[result #{}]])) 71 | :command #(java.util.HashSet. [])}) 72 | 73 | (defn set-and-item [state] 74 | [(gen/elements (map first state)) 75 | gen/int]) 76 | (defn set-update-op [action] 77 | {:requires (fn [state] 78 | (seq state)) 79 | :args set-and-item 80 | :next-state (fn [state [set item] _] 81 | (alist-update state set action item)) 82 | :postcondition (fn [state _ [set item] result] 83 | (= result 84 | (not= (alist-get state set) 85 | (action (alist-get state set) item))))}) 86 | 87 | (def add-set-command 88 | (merge (set-update-op conj) 89 | {:command #(.add %1 %2)})) 90 | 91 | (def remove-set-command 92 | (merge (set-update-op disj) 93 | {:command #(.remove %1 %2)})) 94 | 95 | (def contains?-set-command 96 | {:requires (fn [state] 97 | (seq state)) 98 | :args set-and-item 99 | :command #(.contains %1 %2) 100 | :postcondition (fn [state _ [set item] result] 101 | (= result (contains? (alist-get state set) item)))}) 102 | 103 | 104 | 105 | (def clear-set-command 106 | {:requires (fn [state] 107 | (seq state)) 108 | :args (fn [state] 109 | [(gen/elements (map first state))]) 110 | :next-state (fn [state [set] _] 111 | (alist-update state set (constantly #{}))) 112 | :command #(.clear %1)}) 113 | 114 | (def empty?-set-command 115 | {:requires (fn [state] 116 | (seq state)) 117 | :args (fn [state] 118 | [(gen/elements (map first state))]) 119 | :command #(.isEmpty %1) 120 | :postcondition (fn [state _ [set] result] 121 | (= result (empty? (alist-get state set))))}) 122 | 123 | 124 | 125 | (defn binary-set-command [combiner] 126 | {:requires (fn [state] 127 | (seq state)) 128 | :args (fn [state] 129 | [(gen/elements (map first state)) 130 | (gen/elements (map first state))]) 131 | :next-state (fn [state [set1 set2] _] 132 | (alist-update state set1 133 | combiner (alist-get state set2))) 134 | :postcondition (fn [state _ [set1 set2] result] 135 | (= result 136 | (not= (combiner (alist-get state set1) 137 | (alist-get state set2)) 138 | (alist-get state set1))))}) 139 | 140 | (def add-all-set-command 141 | (merge (binary-set-command set/union) 142 | {:command #(.addAll %1 %2)})) 143 | 144 | (def remove-all-set-command 145 | (merge (binary-set-command set/difference) 146 | {:command #(.removeAll %1 %2)})) 147 | 148 | (def retain-all-set-command 149 | (merge (binary-set-command set/intersection) 150 | {:command #(.retainAll %1 %2)})) 151 | 152 | 153 | (def small-set-spec {:commands {:add add-set-command 154 | :remove remove-set-command 155 | :contains? contains?-set-command} 156 | :initial-state (fn [set] [[set #{}]]) 157 | :setup #(java.util.HashSet.)}) 158 | 159 | (deftest small-set-test 160 | (is (specification-correct? small-set-spec))) 161 | 162 | (def full-set-spec {:commands {:new new-set-command 163 | :add add-set-command 164 | :remove remove-set-command 165 | :contains? contains?-set-command 166 | :clear clear-set-command 167 | :empty? empty?-set-command 168 | :add-all add-all-set-command 169 | :remove-all remove-all-set-command 170 | :retain-all retain-all-set-command}}) 171 | 172 | (deftest full-set-test 173 | (is (specification-correct? full-set-spec))) 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | (def throwing-postcondition-command 183 | {:command (constantly nil) 184 | :postcondition (fn [prev-state next-state args result] 185 | (throw (Exception. "this is an unfortunate error")))}) 186 | 187 | (def throwing-postcondition-spec 188 | {:commands {:run #'throwing-postcondition-command}}) 189 | 190 | (defmacro capturing-test-output [& body] 191 | `(let [message# (volatile! nil)] 192 | (with-redefs [clojure.test/do-report 193 | (fn [details#] 194 | (assert (= (:type details#) :error)) 195 | (vreset! message# (str (:actual details#))))] 196 | ~@body 197 | @message#))) 198 | 199 | (deftest throwing-postcondition-test 200 | (is (str/includes? 201 | (capturing-test-output 202 | (is (specification-correct? throwing-postcondition-spec))) 203 | "this is an unfortunate error"))) 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | (def cons-command 214 | {:args (fn [state] [gen/int [(gen/return state)]]) 215 | :command (fn [num [tail]] 216 | (cons num tail)) 217 | :next-state (fn [_ _ result] result) 218 | :postcondition (fn [prev-state _ [num _] result] 219 | (and (= (first result) num) 220 | (= (next result) prev-state)))}) 221 | 222 | (deftest wrapped-symbolic-values-get-resolved-correctly 223 | (is (specification-correct? {:commands {:cons #'cons-command}}))) 224 | 225 | 226 | (def make-tree-command 227 | {:args (fn [trees] 228 | (let [subtree-gen (gen/one-of 229 | `[~gen/int 230 | ~@(when trees 231 | [(gen/elements trees)])])] 232 | [subtree-gen 233 | subtree-gen])) 234 | :command vector 235 | :next-state (fn [trees _ result] 236 | (conj (or trees #{}) result)) 237 | :postcondition (fn [_ _ _ result] 238 | (every? some? result))}) 239 | 240 | (deftest nested-symbolic-values-get-resolved-correctly 241 | (is (specification-correct? {:commands {:make-tree #'make-tree-command}}))) 242 | 243 | (deftest report-zero-frequencies-test 244 | (let [output (with-out-str 245 | (is (specification-correct? 246 | (assoc-in small-set-spec [:commands :never] 247 | {:command #(assert false) 248 | :requires (constantly false)}) 249 | {:report {:command-frequency? true}})))] 250 | (is (re-matches #"(?s).*|\s+:never\s+|\s+0\s+|.*" output)))) 251 | -------------------------------------------------------------------------------- /test/stateful_check/deadlock_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.deadlock-test 2 | (:require [clojure.test :refer [is deftest]] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer :all])) 5 | 6 | (def alloc 7 | {:command #(Object.) 8 | :next-state (fn [objects _ new-object] 9 | (conj objects new-object))}) 10 | 11 | (def lock-two-objects 12 | {:requires #(>= (count %) 2) 13 | :args (juxt gen/elements gen/elements) 14 | :precondition #(apply not= %2) 15 | :command #(locking %1 16 | (locking %2 17 | (Thread/sleep 1)))}) 18 | 19 | (def deadlock-spec 20 | {:commands {:alloc #'alloc 21 | :lock-two-objects #'lock-two-objects}}) 22 | 23 | (deftest object-locking-passes-sequentially 24 | (is (specification-correct? deadlock-spec))) 25 | 26 | (deftest object-locking-fails-concurrently-with-timeout 27 | (is (not (specification-correct? deadlock-spec {:gen {:threads 2} 28 | :run {:max-tries 100 29 | :timeout-ms 50}})))) 30 | -------------------------------------------------------------------------------- /test/stateful_check/exception_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.exception-test 2 | (:require [clojure.test :refer [deftest is]] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer :all])) 5 | 6 | (def counter (atom 0)) 7 | 8 | (def inc-command 9 | {:args (fn [state] 10 | [gen/int]) 11 | :command #(swap! counter + %) 12 | :next-state (fn [state [arg] _] 13 | (+ state arg))}) 14 | 15 | (def throw-command 16 | {:command #(when (> @counter 13) 17 | (throw (RuntimeException. "I don't like numbers bigger than 13!")))}) 18 | 19 | (def spec 20 | {:commands {:inc #'inc-command 21 | :throw #'throw-command} 22 | :initial-state (constantly 0) 23 | :setup (fn [] (reset! counter 0)) 24 | :cleanup (fn [_] (reset! counter nil))}) 25 | 26 | (deftest throw-test 27 | (is (not (specification-correct? spec {:gen {:max-size 20} 28 | :run {:num-tests 500}}))) 29 | (is (= @counter nil))) 30 | -------------------------------------------------------------------------------- /test/stateful_check/java_map_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.java-map-test 2 | (:require [clojure.test :refer [deftest is]] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer [specification-correct?]])) 5 | 6 | (def ^java.util.Map system-under-test (java.util.TreeMap.)) 7 | 8 | (def test-keys ["" "a" "house" "tree" "λ"]) 9 | 10 | (def put-command 11 | {:args (fn [state] [(gen/elements test-keys) gen/int]) 12 | :command #(.put system-under-test %1 %2) 13 | :next-state (fn [state [k v] _] 14 | (assoc state k v))}) 15 | 16 | (def get-command 17 | {:requires (fn [state] (seq state)) 18 | :args (fn [state] [(gen/elements test-keys)]) 19 | :command #(.get system-under-test %1) 20 | :postcondition (fn [prev-state _ [k] val] 21 | (= (get prev-state k) val))}) 22 | 23 | (def java-map-specification 24 | {:commands {:put #'put-command 25 | :get #'get-command} 26 | :setup #(.clear system-under-test)}) 27 | 28 | (deftest java-map-passes-sequentially 29 | (is (specification-correct? java-map-specification))) 30 | 31 | (deftest java-map-fails-concurrently 32 | (is (not (specification-correct? java-map-specification 33 | {:gen {:threads 2} 34 | :run {:max-tries 100}})))) 35 | -------------------------------------------------------------------------------- /test/stateful_check/java_queue_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.java-queue-test 2 | (:refer-clojure :exclude [peek pop count]) 3 | (:require [clojure.test :refer :all] 4 | [clojure.test.check.generators :as gen] 5 | [stateful-check.core :refer :all]) 6 | (:import [java.util.concurrent ArrayBlockingQueue])) 7 | 8 | (defprotocol Queue 9 | (push [this val]) 10 | (peek [this]) 11 | (pop [this]) 12 | (count [this])) 13 | 14 | (deftype ArrayQueue [buffer ^:volatile-mutable read-i ^:volatile-mutable write-i] 15 | Queue 16 | (push [this val] 17 | (aset buffer write-i val) 18 | (set! write-i (mod (inc write-i) (alength buffer))) 19 | this) 20 | (peek [this] 21 | (aget buffer read-i)) 22 | (pop [this] 23 | (let [val (aget buffer read-i)] 24 | (set! read-i (mod (inc read-i) (alength buffer))) 25 | val)) 26 | (count [this] 27 | (mod (- write-i read-i) (alength buffer)))) 28 | 29 | (def array (atom clojure.lang.PersistentQueue/EMPTY)) 30 | 31 | (deftype SharedArrayQueue [length] 32 | Queue 33 | (push [this val] 34 | (let [add (fn [q v] 35 | (let [result (conj q v)] 36 | (if (> (clojure.core/count result) length) 37 | (clojure.core/pop result) 38 | result)))] 39 | (swap! array add val)) 40 | this) 41 | (peek [this] 42 | (clojure.core/peek @array)) 43 | (pop [this] 44 | (let [val (clojure.core/peek @array)] 45 | (swap! array clojure.core/pop) 46 | val)) 47 | (count [this] 48 | (clojure.core/count @array))) 49 | 50 | (defn new-shared-queue [n] 51 | (reset! array clojure.lang.PersistentQueue/EMPTY) 52 | (SharedArrayQueue. n)) 53 | 54 | (defn new-array-queue [n] 55 | (ArrayQueue. (int-array (inc n)) 0 0)) 56 | 57 | ;; 58 | ;; Generative testing commands 59 | ;; 60 | 61 | (def new-shared-queue-command 62 | {:args (fn [_] [gen/nat]) 63 | :precondition (fn [_ [size]] (pos? size)) 64 | :command #'new-shared-queue 65 | :next-state (fn [state [size] queue] 66 | (assoc state queue 67 | {:elements [] 68 | :size size}))}) 69 | 70 | (def new-array-queue-command 71 | {:args (fn [_] [gen/nat]) 72 | :precondition (fn [_ [size]] (pos? size)) 73 | :command #'new-array-queue 74 | :next-state (fn [state [size] queue] 75 | (assoc state queue 76 | {:elements [] 77 | :size size}))}) 78 | 79 | (def push-queue-command 80 | {:requires (complement nil?) 81 | :args (fn [state] 82 | [(gen/elements (keys state)) 83 | gen/nat]) 84 | :precondition (fn [state [queue _]] 85 | (let [{:keys [elements size]} (get state queue)] 86 | (< (clojure.core/count elements) size))) 87 | :command #'push 88 | :next-state (fn [state [queue val] _] 89 | (update-in state [queue :elements] conj val))}) 90 | 91 | (def peek-queue-command 92 | {:requires (complement nil?) 93 | :args (fn [state] 94 | [(gen/elements (keys state))]) 95 | :precondition (fn [state [queue]] 96 | (seq (get-in state [queue :elements]))) 97 | :command #'peek 98 | :postcondition (fn [state _ [queue] val] 99 | (= val (first (get-in state [queue :elements]))))}) 100 | 101 | (def pop-queue-command 102 | {:requires (complement nil?) 103 | :args (fn [state] 104 | [(gen/elements (keys state))]) 105 | :precondition (fn [state [queue]] 106 | (seq (get-in state [queue :elements]))) 107 | :command #'pop 108 | :next-state (fn [state [queue] _] 109 | (update-in state [queue :elements] (comp vec next))) 110 | :postcondition (fn [state _ [queue] val] 111 | (= val (first (get-in state [queue :elements]))))}) 112 | 113 | (def count-queue-command 114 | {:requires (complement nil?) 115 | :args (fn [state] 116 | [(gen/elements (keys state))]) 117 | :command #'count 118 | :postcondition (fn [state _ [queue] val] 119 | (= val (clojure.core/count (get-in state [queue :elements]))))}) 120 | 121 | ;; 122 | ;; Generative testing specification 123 | ;; 124 | 125 | (def shared-queue-specification 126 | {:commands {:new #'new-shared-queue-command 127 | :push #'push-queue-command 128 | :peek #'peek-queue-command 129 | :pop #'pop-queue-command 130 | :count #'count-queue-command} 131 | :setup #(reset! array clojure.lang.PersistentQueue/EMPTY) 132 | :generate-command (fn [state] 133 | (if (nil? state) 134 | (gen/return :new) 135 | (gen/frequency [[1 (gen/return :new)] 136 | [5 (gen/return :push)] 137 | [5 (gen/return :peek)] 138 | [5 (gen/return :pop)] 139 | [5 (gen/return :count)]])))}) 140 | 141 | (def array-queue-specification 142 | {:commands {:new #'new-array-queue-command 143 | :push #'push-queue-command 144 | :peek #'peek-queue-command 145 | :pop #'pop-queue-command 146 | :count #'count-queue-command} 147 | :generate-command (fn [state] 148 | (if (nil? state) 149 | (gen/return :new) 150 | (gen/frequency [[1 (gen/return :new)] 151 | [5 (gen/return :push)] 152 | [5 (gen/return :peek)] 153 | [5 (gen/return :pop)] 154 | [5 (gen/return :count)]])))}) 155 | 156 | (deftest shared-queue-test 157 | (is (not (specification-correct? shared-queue-specification)))) 158 | (deftest array-queue-test 159 | (is (specification-correct? array-queue-specification))) 160 | -------------------------------------------------------------------------------- /test/stateful_check/mutation_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.mutation-test 2 | (:require [clojure.test :refer [is deftest]] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer :all])) 5 | 6 | (def system-under-test (atom nil)) 7 | 8 | (def add-command 9 | {:command #(swap! system-under-test conj 1) 10 | :next-state (fn [expect _ _] 11 | (conj expect 1))}) 12 | 13 | (def observe-command 14 | {:command #(do system-under-test) 15 | :postcondition (fn [expect _ _ result] 16 | (is (= expect @result)))}) 17 | 18 | (def mutation-spec 19 | {:commands {:add #'add-command 20 | :observe #'observe-command} 21 | :initial-state (constantly []) 22 | :setup #(reset! system-under-test [])}) 23 | 24 | (deftest ^:interactive catches-mutation 25 | ;; This test is marked as "interactive" because we want to see the 26 | ;; output of it. The test should fail, but check to see whether you 27 | ;; get a warning about an object being mutated. You should see 28 | ;; something indicating that the object was mutated later in the 29 | ;; test, and showing the most recent value for it. 30 | (is (specification-correct? mutation-spec))) 31 | 32 | (deftest ^:interactive does-not-catch-mutation 33 | ;; The test should also fail, but its output should not mention the 34 | ;; mutation, and the result should be printed using the final value. 35 | (is (specification-correct? mutation-spec {:run {:assume-immutable-results true}}))) 36 | -------------------------------------------------------------------------------- /test/stateful_check/postcondition_is_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.postcondition-is-test 2 | (:require [clojure.test :refer [is deftest]] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer :all] 5 | [stateful-check.generator :refer [default-shrink-strategies ]] 6 | [stateful-check.shrink-strategies :as shrink] 7 | [stateful-check.queue-test :as q])) 8 | 9 | (deftest ^:interactive postcondition-prints-in-parallel-case 10 | ;; This test is marked as "interactive" because we want to see the 11 | ;; output of it. The test should fail, but check to see whether you 12 | ;; can see the postcondition assertion output (expected and actual, 13 | ;; along with the message). 14 | (is (specification-correct? (-> q/parallel-failing-queue-specification 15 | (assoc-in [:commands :push :postcondition] 16 | (fn [_ _ _ result] (is (nil? result)))) 17 | (assoc-in [:commands :peek :postcondition] 18 | (fn [state _ _ val] (is (= (first (:elements state)) val)))) 19 | (assoc-in [:commands :pop :postcondition] 20 | (fn [state _ _ val] (is (= (first (:elements state)) val)))) 21 | (assoc-in [:commands :count :postcondition] 22 | (fn [state _ _ val] (is (= (count (:elements state)) val))))) 23 | {:gen {:threads 2} 24 | :run {:max-tries 10}}))) 25 | 26 | 27 | (deftest ^:interactive failed-assertion-is-printed 28 | (is (specification-correct? 29 | {:commands {:cmd {:command (constantly true) 30 | :postcondition (fn [_ _ _ _] 31 | (is (= 1 0)))}}}))) 32 | 33 | (deftest ^:interactive exception-in-assertion-is-printed 34 | (is (specification-correct? 35 | {:commands {:cmd {:command (constantly true) 36 | :postcondition (fn [_ _ _ _] 37 | (is (throw (ex-info "An exception!" {:oh "no"}))))}}}))) 38 | 39 | (deftest assertion-is-used-instead-of-return-value-is-printed 40 | (is (specification-correct? 41 | {:commands {:cmd {:command (constantly true) 42 | :postcondition (fn [_ _ _ _] 43 | (is (= 1 1)) 44 | ;; falsey return value, but 45 | ;; ignored becuase of the 46 | ;; above assertion (which 47 | ;; passes) 48 | false)}}}))) 49 | -------------------------------------------------------------------------------- /test/stateful_check/queue_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.queue-test 2 | (:require [clojure.test :refer :all] 3 | [clojure.test.check.generators :as gen] 4 | [stateful-check.core :refer :all])) 5 | 6 | ;; 7 | ;; Simple mutable queue implementation 8 | ;; 9 | 10 | (defn new-queue [] 11 | (atom (clojure.lang.PersistentQueue/EMPTY))) 12 | 13 | (defn push-queue [queue val] 14 | (swap! queue conj val) 15 | nil) 16 | 17 | (defn push-queue-with-race-condition [queue val] 18 | (let [q @queue] 19 | ;; look, a race condition! 20 | ;; this is equivalent to (swap! queue conj val) 21 | ;; except with a race condition 22 | (reset! queue (conj q val))) 23 | nil) 24 | 25 | (defn peek-queue [queue] 26 | (peek @queue)) 27 | 28 | (defn pop-queue [queue] 29 | (let [value @queue] 30 | (if (compare-and-set! queue value (pop value)) 31 | (peek value) 32 | (recur queue)))) 33 | 34 | (defn count-queue [queue] 35 | (count @queue)) 36 | 37 | (defn count-queue-constantly-zero [queue] 38 | 0) 39 | 40 | ;; 41 | ;; Generative testing commands 42 | ;; 43 | 44 | (def push-queue-command 45 | {:args (fn [state] [(:queue state) gen/nat]) 46 | :command #'push-queue 47 | :next-state (fn [state [_ val] _] 48 | (update-in state [:elements] conj val)) 49 | :postcondition (fn [_ _ _ result] 50 | (nil? result))}) 51 | 52 | (def push-queue-command-with-race-condition 53 | (assoc push-queue-command :command #'push-queue-with-race-condition)) 54 | 55 | (def peek-queue-command 56 | {:args (fn [state] [(:queue state)]) 57 | :precondition (fn [state _] (seq (:elements state))) 58 | :command #'peek-queue 59 | :postcondition (fn [state _ args val] 60 | (= val (first (:elements state))))}) 61 | 62 | (def pop-queue-command 63 | {:requires (fn [state] (seq (:elements state))) 64 | :args (fn [state] [(:queue state)]) 65 | :command #'pop-queue 66 | :next-state (fn [state _ _] 67 | (update-in state [:elements] (comp vec next))) 68 | :postcondition (fn [state _ args val] 69 | (= val (first (:elements state))))}) 70 | 71 | (def count-queue-command 72 | {:args (fn [state] [(:queue state)]) 73 | :command #'count-queue 74 | :postcondition (fn [state _ _ val] 75 | (= val (count (:elements state))))}) 76 | 77 | (def count-queue-constantly-zero-command 78 | (assoc count-queue-command :command #'count-queue-constantly-zero)) 79 | 80 | ;; 81 | ;; Generative testing specification 82 | ;; 83 | 84 | (def queues-in-use (atom 0)) 85 | 86 | (def queue-specification 87 | {:commands {:push push-queue-command 88 | :peek peek-queue-command 89 | :pop pop-queue-command 90 | :count count-queue-command} 91 | :initial-state (fn [queue] 92 | {:queue queue, 93 | :elements []}) 94 | :setup (fn [] 95 | (swap! queues-in-use inc) 96 | (new-queue)) 97 | :cleanup (fn [state] 98 | (swap! queues-in-use dec))}) 99 | 100 | (def failing-queue-specification 101 | (assoc-in queue-specification 102 | [:commands :count] count-queue-constantly-zero-command)) 103 | 104 | (def parallel-failing-queue-specification 105 | (assoc-in queue-specification 106 | [:commands :push] push-queue-command-with-race-condition)) 107 | 108 | (deftest correct-queue-test 109 | (let [val @queues-in-use] 110 | (is (specification-correct? queue-specification)) 111 | (is (specification-correct? queue-specification {:gen {:threads 2 112 | :max-length 4} 113 | :run {:max-tries 10}})) 114 | (is (= val @queues-in-use) "setup/cleanup should both be run for all tests (pass and fail)"))) 115 | 116 | (deftest failing-queue-test 117 | (let [val @queues-in-use] 118 | (is (not (specification-correct? failing-queue-specification))) 119 | (is (= val @queues-in-use) "setup/cleanup should both be run for all tests (pass and fail)"))) 120 | 121 | (deftest parallel-failing-queue-test 122 | (let [val @queues-in-use] 123 | (is (specification-correct? parallel-failing-queue-specification)) 124 | (is (not (specification-correct? parallel-failing-queue-specification {:gen {:threads 2} 125 | :run {:max-tries 10}}))) 126 | (is (= val @queues-in-use) "setup/cleanup should both be run for all tests (pass and fail)"))) 127 | -------------------------------------------------------------------------------- /test/stateful_check/symbolic_values_test.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-check.symbolic-values-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [stateful-check.symbolic-values :as sv])) 4 | 5 | (deftest test-lookup-var-representation 6 | (let [root-var (sv/->RootVar "1")] 7 | (testing "lookup var" 8 | (let [lookup-var (sv/->LookupVar root-var :x nil)] 9 | (testing "printed representation" 10 | (is (= "(get #<1> :x)" (pr-str lookup-var)))) 11 | (testing "string representation" 12 | (is (= "(get #<1> :x)" (.toString lookup-var)))))) 13 | (testing "lookup var with not found value" 14 | (let [lookup-var (sv/->LookupVar root-var :x :not-found)] 15 | (testing "printed representation" 16 | (is (= "(get #<1> :x :not-found)" (pr-str lookup-var)))) 17 | (testing "string representation" 18 | (is (= "(get #<1> :x :not-found)" (.toString lookup-var)))))))) 19 | 20 | (deftest test-root-var-representation 21 | (testing "root-var" 22 | (let [root-var (sv/->RootVar "1")] 23 | (testing "printed representation" 24 | (is (= "#<1>" (pr-str root-var)))) 25 | (testing "string representation" 26 | (is (= "#<1>" (.toString root-var))))))) 27 | --------------------------------------------------------------------------------