├── .gitignore ├── README.md ├── project.clj ├── src └── stateful_testing │ ├── core.clj │ ├── fsm_test_utils.clj │ └── web_crud.clj └── test └── stateful_testing ├── fsm_tests.clj ├── fsm_tests2.clj ├── fsm_tests3.clj ├── fsm_tests4.clj ├── states_lib_tests.clj └── web_crud_tests.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 | .hgignore 11 | .hg/ 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Stateful Generative testing using Spec Models 2 | 3 | Illustrates how to use Clojure Spec to test a webapp that stores data. 4 | 5 | This was used as a talk at Clojure Sydney Meetup on Sep 26th, 2017. 6 | 7 | ## TL;DR 8 | 9 | Clone and run tests using `lein test` 10 | 11 | Look at [web-crud.clj](https://github.com/stevebuik/stateful-generative-tests/blob/master/src/stateful_testing/web_crud.clj) and use the comments at the bottom to start the ring server to see the UI 12 | 13 | Look at [web-crud-tests.clj](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/web_crud_tests.clj) to see how to use generated commands to test Add/Delete in the webapp. 14 | 15 | This test combines Kerodon, Clojure Spec and custom generators to generate valid sequences of *commands* for a web-app. 16 | 17 | ## The Long Version..... 18 | 19 | Generative testing reduces the need for example-based unit tests. 20 | Clojure Spec takes this further by automatically providing generators to test clojure functions. 21 | 22 | **Question**: the generated data is stateless. Webapps are stateful. How can these two ideas be combined? 23 | 24 | **Answer**: search the interwebs....and find... 25 | 26 | **Stateful Generator Libraries** 27 | 28 | https://github.com/jstepien/states 29 | 30 | https://github.com/czan/stateful-check 31 | 32 | **Blog Posts** 33 | 34 | [Verifying FSMs using test.check by Guillermo Winkler](http://blog.guillermowinkler.com/blog/2015/04/12/verifying-state-machine-behavior-using-test-dot-check/) 35 | 36 | **Videos** 37 | 38 | [Customising Generators by Stu Halloway](https://www.youtube.com/watch?v=WoFkhE92fqc) 39 | 40 | [Teleport Testing by Antonio Montiero & Mike Kaplinskiy](https://www.youtube.com/watch?v=qijWBPYkRAQ) 41 | 42 | Thanks to all these people for sharing such valuable work. It inspired this presentation. 43 | 44 | The blog post provides a great explanation and sample code for stateful testing. 45 | It could even be written as portable (cljc) Clojure - sweet! It would be great to see tests running in this readme. 46 | 47 | In the blog post, the section on shrinking and Rose Trees is really interesting. 48 | 49 | Stu's video demonstrates the idea of generator models to make Spec generators smarter. 50 | Maybe using the code from the blog as a spec model could work? Let's try. 51 | 52 | ### To the REPL.... 53 | 54 | (follow the links and/or run the tests in your IDE) 55 | 56 | [Experiment #1](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/states_lib_tests.clj) 57 | : run the sample code for the *states* library. 58 | 59 | Works well but is not portable Clojure. Leaving this path alone for now. 60 | 61 | [Experiment #2](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/fsm_tests.clj) 62 | : run the FSM sample code from the blog post 63 | 64 | * observe see the two phases: 65 | * cmd-seq is the generation phase 66 | * prop/for-all is the application phase 67 | * exec fn is used in the generation phase to maintain the state. 68 | this means that the generation state system is different from the state of the system under test. Could having two state implementations be a source of bugs as complexity grows? 69 | * the test invariant in this example is not a good example 70 | * Clojure Spec is not used anywhere (because the blog was written before Spec) 71 | 72 | [Experiment #3](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/fsm_tests2.clj) 73 | : changed the FSM sample to test a set (like the *states* test) instead of vector 74 | 75 | * added a :clear-cmd for emptying the set 76 | * still have different code for gen vs application phase 77 | * test.check invariant more like a real world example 78 | * deftest ensures that *true* is the result since test.check puts exceptions in the :result 79 | 80 | [Experiment #4](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/fsm_tests3.clj) 81 | : changed the FSM sample to use same state mgmt fn for gen and application phase 82 | 83 | * easier to read, DRY code 84 | * still not using Spec 85 | 86 | [Experiment #5](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/fsm_tests4.clj) 87 | : changed the FSM sample to use a Spec for the commands 88 | 89 | * play with the spec by running the code in the comments. compare the stateless vs the stateful generated commands 90 | * using a spec for the *apply-commands* fn which means that prop/for-all invariants are no longer required. 91 | this is the driver fn for the generative tests. 92 | * uncomment the two *pprint* lines to see what was tested 93 | 94 | ### Testing a Web-app instead of a Set 95 | 96 | Load the [web-crud.clj](https://github.com/stevebuik/stateful-generative-tests/blob/master/src/stateful_testing/web_crud.clj) 97 | file and run the two expressions in the comment at the bottom, then browse `http://localhost:8080/list` 98 | and play with the app to understand it 99 | 100 | Load the [web-crud-tests.clj](https://github.com/stevebuik/stateful-generative-tests/blob/master/test/stateful_testing/web_crud_tests.clj) 101 | file and run: 102 | 103 | 1. the expressions in comments 104 | 2. the example-based unit test 105 | 3. the generative test 106 | 4. try breaking it by changing the default id in the add/exec fn 107 | 108 | and observe.... 109 | 110 | * Kerodon is awesome. Like a fast Selenium 111 | * Add commands don't include an :id since the webapp generates the id 112 | * Use a multi-spec since now commands have different keys 113 | * Using a spec'd driver fn, like in Experiment #5 114 | * The :ret spec for the driver fn is a map, allowing N assertions with a clear path to false values 115 | * It's fast! Even running 50 generated command sequences is sub-second. 116 | 117 | Originally I used the web-app for the generation and the application phase. 118 | This did not work because each generated command sequence retained state from previous sequences. 119 | The solution was to go back to two systems for state, one for each phase. 120 | 121 | When this test is run, the number of assertions is high. This is because every CRUD operation asserts that status = 200 etc when the command is applied. 122 | This is the power of generative tests, many combinations generated, applied and asserted. 123 | 124 | ### Conclusions 125 | 126 | Although there are two good libraries for stateful testing, I prefer the blog posts solution because the generated commands are pure data (no fns as values). 127 | This makes them easier to read, easier to send over a wire for remote invocation and the code could easily be portable (cljc). 128 | 129 | The combination of Kerodon and generated commands is a Selenium killer. Happy days! 130 | That said, there is no browser so Selenium is better if you are seeking cross-browser testing. 131 | 132 | This testing technique replaces test.check with Specs and test.check underneath. 133 | The amount of code is approx the same but, with Specs, you also have command DSL that can be used for other purposes 134 | e.g. 135 | * runtime request validation 136 | * remote command(s) execution 137 | 138 | These are powerful benefits so testing this way is a valuable investment. 139 | 140 | ### Future 141 | 142 | * A server endpoint could accept an EDN sequence of commands and run them as a live test i.e. generative Selenium 143 | * Single Page Apps are stateful and can be tested the same way (see the Teleport video for more) 144 | * Convert Set tests to portable Clojure and run using Klipse 145 | 146 | 147 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject stateful-testing "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.9.0-beta1"] 7 | [org.clojure/spec.alpha "0.1.123"] 8 | ;[org.clojure/test.check "0.10.0-alpha2"] 9 | [states "0.1.0"] 10 | [compojure "1.6.0"] 11 | [hiccup "1.0.5"] 12 | [ring/ring-core "1.6.2"] 13 | [ring/ring-jetty-adapter "1.6.2"] 14 | [javax.servlet/javax.servlet-api "4.0.0"] 15 | [kerodon "0.9.0"] 16 | [peridot "0.5.0" :exclusions [commons-codec]]]) 17 | -------------------------------------------------------------------------------- /src/stateful_testing/core.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.core) 2 | 3 | (defn set-contains [set elem] 4 | (.contains set elem)) 5 | 6 | (defn set-add [set elem] 7 | (.add set elem)) 8 | 9 | (defn set-remove [set elem] 10 | (.remove set elem)) 11 | 12 | (defn new-set [class] 13 | (.newInstance class)) 14 | -------------------------------------------------------------------------------- /src/stateful_testing/fsm_test_utils.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.fsm-test-utils 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [clojure.test.check.generators :as gen])) 5 | 6 | (defprotocol Command 7 | (precondition [this state] "Returns true if command can be applied in current system state") 8 | (postcondition [this state cmd] "Returns true if cmd can be applied on specified state") 9 | (exec [this state cmd] "Applies command in the specified system state, returns new state") 10 | (generate [this state] "Generates command given the current system state, returns command")) 11 | 12 | 13 | (defn valid-sequence? 14 | [commands state-seq cmd-seq sub-seq-idxs] 15 | (when (seq sub-seq-idxs) 16 | (map? (reduce (fn [curr-state state-idx] 17 | (let [cmd (get cmd-seq state-idx) 18 | command (get commands (:type cmd))] 19 | (if (postcondition command curr-state cmd) 20 | (exec command curr-state cmd) 21 | (reduced false)))) 22 | (first state-seq) 23 | sub-seq-idxs)))) 24 | 25 | (defn remove-seq 26 | [s] 27 | (map-indexed (fn [index _] 28 | (#'clojure.test.check.rose-tree/exclude-nth index s)) 29 | s)) 30 | 31 | (defn shrink-sequence 32 | [cmd-seq state-seq commands] 33 | (letfn [(shrink-subseq [s] 34 | (when (seq s) 35 | [(map #(get cmd-seq %) s) 36 | (->> (remove-seq s) 37 | (filter (partial valid-sequence? commands state-seq cmd-seq)) 38 | (mapv shrink-subseq))]))] 39 | (shrink-subseq (range 0 (count cmd-seq))))) 40 | 41 | (defn cmd-seq-helper 42 | [state commands size] 43 | (gen/bind (gen/one-of (->> (vals commands) 44 | (filter #(precondition % state)) 45 | (map #(generate % state)))) 46 | (fn [cmd] 47 | (if (zero? size) 48 | (gen/return [[cmd state]]) 49 | (gen/fmap 50 | (partial concat [[cmd state]]) 51 | (cmd-seq-helper (exec (get commands (:type cmd)) state cmd) 52 | commands 53 | (dec size))))))) 54 | 55 | (defn cmd-seq 56 | "generate up to 5 stateful commands using a map of possible commands" 57 | [state commands] 58 | (gen/bind (gen/choose 0 5) 59 | (fn [num-elements] 60 | (gen/bind (cmd-seq-helper state commands num-elements) 61 | (fn [cmd-seq] 62 | (let [shrinked (shrink-sequence (mapv first cmd-seq) 63 | (mapv second cmd-seq) 64 | commands)] 65 | (gen/gen-pure shrinked))))))) 66 | 67 | -------------------------------------------------------------------------------- /src/stateful_testing/web_crud.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.web-crud 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [compojure.core :refer [routes GET POST]] 5 | [compojure.route :as route] 6 | [compojure.handler :as handler] 7 | [hiccup.core :refer [html]] 8 | [ring.adapter.jetty :refer [run-jetty]])) 9 | 10 | (defn list-page 11 | [database req] 12 | {:status 200 13 | :headers {"Content-Type" "text/html"} 14 | :body (html 15 | [:head 16 | [:style {} 17 | "table, th, td { border: 1px solid grey; }"]] 18 | [:body 19 | [:div {} "Skateboard Inventory" 20 | [:br] [:br] 21 | [:form {:action "/new" :method "POST"} 22 | (vec (concat [:table {} 23 | [:tr [:th "Type"] [:th "Rating"] [:th "Actions"]]] 24 | (map (fn [{:keys [id type rating]}] 25 | [:tr {:class "board"} 26 | [:td type] 27 | [:td rating] 28 | [:td [:a {:class "delete" :id id :href (str "/delete?id=" id)} "Delete"]]]) 29 | (vals @database)) 30 | [[:tr 31 | [:td [:input {:type "text" :name "type" :placeholder "Enter Type"}]] 32 | [:td [:input {:type "text" :name "rating" :placeholder "Enter Rating"}]] 33 | [:td [:button {:type "submit"} "Add board"]]]]))] 34 | ]])}) 35 | 36 | (defn delete-record 37 | [database req] 38 | (let [id (get-in req [:params :id])] 39 | (swap! database (fn [db] 40 | (reduce-kv (fn [m k v] 41 | (if (= (Integer/parseInt id) k) 42 | m 43 | (assoc m k v))) 44 | {} 45 | db))) 46 | {:status 303 47 | :headers {"Location" "/list"}})) 48 | 49 | (defn new-record 50 | [database req] 51 | (let [{:keys [type rating]} (:params req)] 52 | (swap! database (fn [db] 53 | (let [id (if (seq @database) 54 | (inc (apply max (keys @database))) 55 | 1)] 56 | (assoc db id {:id id 57 | :type type 58 | :rating rating})))) 59 | {:status 303 60 | :headers {"Location" "/list"}})) 61 | 62 | (defn app 63 | [db] 64 | (let [database (or db (atom {1 {:id 1 65 | :type "Onewheel" 66 | :rating "Sweet As Bro!"} 67 | 2 {:id 2 68 | :type "Old Skull" 69 | :rating "Old school ride"}}))] 70 | (handler/site 71 | (routes 72 | (GET "/list" [] (partial list-page database)) 73 | (GET "/delete" [] (partial delete-record database)) 74 | (POST "/new" [] (partial new-record database)) 75 | (route/not-found "Page not found"))))) 76 | 77 | (comment 78 | (def server (atom nil)) 79 | (do 80 | (when-let [s @server] 81 | (.stop s)) 82 | (reset! server (run-jetty (app nil) {:port 8080 :join? false})))) -------------------------------------------------------------------------------- /test/stateful_testing/fsm_tests.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.fsm-tests 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [clojure.test :refer :all] 5 | [clojure.test.check :as tc] 6 | [clojure.test.check.generators :as gen] 7 | [clojure.test.check.properties :as prop] 8 | [clojure.test.check.rose-tree :as rose] 9 | [stateful-testing.fsm-test-utils :as fsm] 10 | [clojure.spec.alpha :as s])) 11 | 12 | (def add-cmd 13 | (reify 14 | fsm/Command 15 | (precondition [_ state] 16 | (vector? (:people state))) 17 | 18 | (postcondition [_ state cmd] 19 | ;;add only valid if no other person with same id 20 | (->> (:people state) 21 | (filter #(= (:id %) (:id cmd))) 22 | seq 23 | nil?)) 24 | 25 | (exec [_ state cmd] 26 | (update-in state [:people] (fn [people] 27 | (conj people 28 | (dissoc cmd :type))))) 29 | 30 | (generate [_ state] 31 | (gen/fmap (partial zipmap [:type :name :id]) 32 | (gen/tuple (gen/return :add-cmd) 33 | (gen/not-empty gen/string-alphanumeric) 34 | (gen/such-that #(-> (mapv :id (:people state)) 35 | (contains? %) 36 | not) 37 | gen/int)))))) 38 | 39 | (def delete-cmd 40 | (reify 41 | fsm/Command 42 | (precondition [_ state] 43 | (seq (:people state))) 44 | 45 | (postcondition [_ state cmd] 46 | ;;delete only valid if existing person with id 47 | (->> (:people state) 48 | (filter #(= (:id %) (:id cmd))) 49 | seq)) 50 | 51 | (exec [_ state cmd] 52 | (update-in state [:people] (fn [people] 53 | (vec (filter #(not= (:id %) 54 | (:id cmd)) 55 | people))))) 56 | 57 | (generate [_ state] 58 | (gen/fmap (partial zipmap [:type :id]) 59 | (gen/tuple (gen/return :delete-cmd) 60 | (gen/elements (mapv :id (:people state)))))))) 61 | 62 | (defn not-many-deletes 63 | "returns true when there are < 2 delete commands" 64 | [commands] 65 | (->> commands 66 | (filter #(= :delete-cmd (:type %))) 67 | count 68 | (> 2))) 69 | 70 | (def commands-will-not-fail 71 | (prop/for-all [commands (fsm/cmd-seq {:people []} {:add-cmd add-cmd 72 | :delete-cmd delete-cmd})] 73 | (true? (not-many-deletes commands)))) 74 | 75 | 76 | (deftest apply-commands-fails 77 | (let [result (tc/quick-check 100 commands-will-not-fail)] 78 | ;(pprint result) ; <<<<< uncomment this to see the failing case 79 | (is (-> result :result false?) 80 | "commands fail because generator will eventually generate 2 deletes"))) -------------------------------------------------------------------------------- /test/stateful_testing/fsm_tests2.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.fsm-tests2 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [clojure.test :refer :all] 5 | [clojure.test.check :as tc] 6 | [clojure.test.check.generators :as gen] 7 | [clojure.test.check.properties :as prop] 8 | [clojure.test.check.rose-tree :as rose] 9 | [stateful-testing.fsm-test-utils :as fsm])) 10 | 11 | (def add-cmd 12 | (reify 13 | fsm/Command 14 | (precondition [_ state] 15 | true) 16 | 17 | (postcondition [_ state cmd] 18 | true) 19 | 20 | (exec [_ state cmd] 21 | (update-in state [:ids] conj (:id cmd))) 22 | 23 | (generate [_ state] 24 | (gen/fmap (partial zipmap [:type :id]) 25 | (gen/tuple (gen/return :add-cmd) 26 | (gen/such-that #(not (contains? (:ids state) %)) 27 | gen/int)))))) 28 | 29 | (def delete-cmd 30 | (reify 31 | fsm/Command 32 | (precondition [_ state] 33 | (seq (:ids state))) 34 | 35 | (postcondition [_ state cmd] 36 | ;;delete only valid if present in the set 37 | (->> (:ids state) 38 | (filter #(= % (:id cmd))) 39 | seq)) 40 | 41 | (exec [_ state cmd] 42 | (update-in state [:ids] (fn [ids] 43 | (disj ids (:id cmd))))) 44 | 45 | (generate [_ state] 46 | (gen/fmap (partial zipmap [:type :id]) 47 | (gen/tuple (gen/return :delete-cmd) 48 | (gen/elements (:ids state))))))) 49 | 50 | (def clear-cmd 51 | (reify 52 | fsm/Command 53 | (precondition [_ state] 54 | true) 55 | 56 | (postcondition [_ state cmd] 57 | true) 58 | 59 | (exec [_ state cmd] 60 | (update-in state [:ids] (constantly #{}))) 61 | 62 | (generate [_ state] 63 | (gen/fmap (partial zipmap [:type]) 64 | (gen/tuple (gen/return :clear-cmd)))))) 65 | 66 | (defn apply-commands 67 | [commands] 68 | (reduce (fn [ids {:keys [id type] :as cmd}] 69 | (case type 70 | :add-cmd (conj ids id) 71 | :delete-cmd (set (remove #{id} ids)) 72 | :clear-cmd #{})) 73 | #{} 74 | commands)) 75 | 76 | (def commands-return-a-set 77 | (prop/for-all [tx-log (fsm/cmd-seq {:ids #{}} {:add-cmd add-cmd 78 | :delete-cmd delete-cmd 79 | :clear-cmd clear-cmd})] 80 | (set? (apply-commands tx-log)))) 81 | 82 | (deftest set-operations-pass 83 | (let [result (tc/quick-check 100 commands-return-a-set)] 84 | ;(pprint result) 85 | (is (true? (:result result))))) -------------------------------------------------------------------------------- /test/stateful_testing/fsm_tests3.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.fsm-tests3 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [clojure.test :refer :all] 5 | [clojure.test.check :as tc] 6 | [clojure.test.check.generators :as gen] 7 | [clojure.test.check.properties :as prop] 8 | [stateful-testing.fsm-test-utils :as fsm])) 9 | 10 | (defn apply-command 11 | "translate a command map into an operation and invoke it, with any required args" 12 | [state cmd] 13 | (update-in state [:ids] 14 | (fn [ids] 15 | (case (:type cmd) 16 | :add-cmd (conj ids (:id cmd)) 17 | :delete-cmd (disj ids (:id cmd)) 18 | :clear-cmd #{})))) 19 | 20 | (def add-cmd 21 | (reify 22 | fsm/Command 23 | (precondition [_ state] 24 | true) 25 | 26 | (postcondition [_ state cmd] 27 | true) 28 | 29 | (exec [_ state cmd] 30 | (apply-command state cmd)) 31 | 32 | (generate [_ state] 33 | (gen/fmap (partial zipmap [:type :id]) 34 | (gen/tuple (gen/return :add-cmd) 35 | (gen/such-that #(not (contains? (:ids state) %)) 36 | gen/int)))))) 37 | 38 | (def delete-cmd 39 | (reify 40 | fsm/Command 41 | (precondition [_ state] 42 | ; must be values present for a delete to be possible 43 | (seq (:ids state))) 44 | 45 | (postcondition [_ state cmd] 46 | ;;delete only valid if present in the set 47 | (->> (:ids state) 48 | (filter #(= % (:id cmd))) 49 | seq)) 50 | 51 | (exec [_ state cmd] 52 | (apply-command state cmd)) 53 | 54 | (generate [_ state] 55 | (gen/fmap (partial zipmap [:type :id]) 56 | (gen/tuple (gen/return :delete-cmd) 57 | (gen/elements (:ids state))))))) 58 | 59 | (def clear-cmd 60 | (reify 61 | fsm/Command 62 | (precondition [_ state] 63 | true) 64 | 65 | (postcondition [_ state cmd] 66 | true) 67 | 68 | (exec [_ state cmd] 69 | (apply-command state cmd)) 70 | 71 | (generate [_ state] 72 | (gen/fmap (partial zipmap [:type]) 73 | (gen/tuple (gen/return :clear-cmd)))))) 74 | 75 | ;;----------------------------------------------------- 76 | ;;property definition 77 | 78 | (defn apply-commands 79 | [commands] 80 | (reduce apply-command 81 | {:ids #{}} 82 | commands)) 83 | 84 | (comment 85 | (gen/sample (fsm/cmd-seq {:ids #{}} {:add-cmd add-cmd 86 | :delete-cmd delete-cmd 87 | :clear-cmd clear-cmd}) 88 | 3)) 89 | 90 | (def commands-consistent-apply 91 | (prop/for-all [commands (fsm/cmd-seq {:ids #{}} {:add-cmd add-cmd 92 | :delete-cmd delete-cmd 93 | :clear-cmd clear-cmd})] 94 | (set? (:ids (apply-commands commands))))) 95 | 96 | (deftest set-operations-pass 97 | (is (true? (:result (tc/quick-check 100 commands-consistent-apply))))) -------------------------------------------------------------------------------- /test/stateful_testing/fsm_tests4.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.fsm-tests4 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [clojure.test :refer :all] 5 | [clojure.test.check :as tc] 6 | [clojure.test.check.generators :as gen] 7 | [clojure.test.check.properties :as prop] 8 | [stateful-testing.fsm-test-utils :as fsm] 9 | [clojure.spec.alpha :as s] 10 | [clojure.spec.test.alpha :as st])) 11 | 12 | (defn apply-command 13 | "translate a command map into an operation and invoke it, with any required args" 14 | [state cmd] 15 | (update-in state [:ids] 16 | (fn [ids] 17 | (case (:type cmd) 18 | :add-cmd (conj ids (:id cmd)) 19 | :delete-cmd (disj ids (:id cmd)) 20 | :clear-cmd #{})))) 21 | 22 | (def add-cmd 23 | (reify 24 | fsm/Command 25 | (precondition [_ state] true) 26 | (postcondition [_ state cmd] true) 27 | (exec [_ state cmd] 28 | (apply-command state cmd)) 29 | (generate [_ state] 30 | (gen/fmap (partial zipmap [:type :id]) 31 | (gen/tuple (gen/return :add-cmd) 32 | (gen/such-that #(not (contains? (:ids state) %)) 33 | gen/int)))))) 34 | 35 | (def delete-cmd 36 | (reify 37 | fsm/Command 38 | (precondition [_ state] 39 | ; must be values present for a delete to be possible 40 | (seq (:ids state))) 41 | (postcondition [_ state cmd] 42 | ;;delete only valid if present in the set 43 | (->> (:ids state) 44 | (filter #(= % (:id cmd))) 45 | seq)) 46 | (exec [_ state cmd] 47 | (apply-command state cmd)) 48 | (generate [_ state] 49 | (gen/fmap (partial zipmap [:type :id]) 50 | (gen/tuple (gen/return :delete-cmd) 51 | (gen/elements (:ids state))))))) 52 | 53 | (def clear-cmd 54 | (reify 55 | fsm/Command 56 | (precondition [_ state] true) 57 | (postcondition [_ state cmd] true) 58 | (exec [_ state cmd] 59 | (apply-command state cmd)) 60 | (generate [_ state] 61 | (gen/fmap (partial zipmap [:type]) 62 | (gen/tuple (gen/return :clear-cmd)))))) 63 | 64 | (s/def ::id (s/with-gen int? #(gen/choose 1 10))) 65 | (s/def ::type #{:add-cmd :delete-cmd :clear-cmd}) 66 | (s/def ::command (s/keys :req-un [::id ::type])) 67 | (s/def ::commands-stateless (s/coll-of ::command :min-count 1)) 68 | (s/def ::commands-stateful (s/with-gen ::commands-stateless 69 | (constantly 70 | (fsm/cmd-seq {:ids #{}} {:add-cmd add-cmd 71 | :delete-cmd delete-cmd 72 | :clear-cmd clear-cmd})))) 73 | 74 | (comment 75 | (gen/sample (fsm/cmd-seq {:ids #{}} {:add-cmd add-cmd 76 | :delete-cmd delete-cmd 77 | :clear-cmd clear-cmd}) 78 | 3) 79 | (s/exercise ::command 3) 80 | (s/exercise ::commands-stateless 3) 81 | (s/exercise ::commands-stateful 3)) 82 | 83 | (defn apply-commands 84 | [commands] 85 | ;(pprint commands) 86 | (let [result (reduce apply-command 87 | {:ids #{}} 88 | commands)] 89 | (map? result))) 90 | (s/fdef apply-commands 91 | :args (s/cat :tx-log ::commands-stateful) 92 | :ret true?) 93 | 94 | (comment 95 | (s/exercise-fn `apply-commands 3) 96 | (st/check `apply-commands {:clojure.spec.test.check/opts {:num-tests 100}})) 97 | 98 | (deftest set-operations-pass 99 | (let [result (st/check `apply-commands)] 100 | ;(pprint result) 101 | (is (true? (get-in (first result) [:clojure.spec.test.check/ret :result])) 102 | "stateful generative tests all succeeded"))) -------------------------------------------------------------------------------- /test/stateful_testing/states_lib_tests.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.states-lib-tests 2 | (:require 3 | [clojure.test :refer :all] 4 | [clojure.pprint :refer [pprint]] 5 | [clojure.test.check :refer [quick-check]] 6 | [clojure.test.check.generators :as gen] 7 | [states.core :refer [run-commands]] 8 | [stateful-testing.core :refer :all])) 9 | 10 | ; NOTES : uses a parallel clj structure to track state 11 | 12 | (defn commands [{:keys [set class]}] 13 | (if set 14 | (gen/tuple (gen/elements `[set-contains set-add set-remove]) 15 | (gen/return set) 16 | (gen/fmap #(mod % 10) gen/int)) 17 | (gen/return [`new-set class]))) 18 | 19 | (defn next-step [state var [fn _ elem]] 20 | (condp = fn 21 | `set-remove (update-in state [:elems] disj elem) 22 | `set-add (update-in state [:elems] conj elem) 23 | `new-set (assoc state :set var) 24 | state)) 25 | 26 | (defn postcondition [{:keys [elems]} [fn _ elem] value] 27 | (if (= fn `set-contains) 28 | (= value (contains? elems elem)) 29 | true)) 30 | 31 | (deftest states-lib 32 | (let [result (quick-check 1000 (run-commands commands next-step postcondition 33 | {:init-state {:elems #{} 34 | :class java.util.HashSet}}))] 35 | (is (true? (:result result))) 36 | (when-not (true? (:result result)) 37 | (pprint result)))) 38 | 39 | 40 | -------------------------------------------------------------------------------- /test/stateful_testing/web_crud_tests.clj: -------------------------------------------------------------------------------- 1 | (ns stateful-testing.web-crud-tests 2 | (:require 3 | [clojure.pprint :refer [pprint]] 4 | [clojure.test :refer :all] 5 | [clojure.spec.test.alpha :as st] 6 | [kerodon.test :as t] 7 | [kerodon.core :as k] 8 | [net.cgrand.enlive-html :as html] 9 | [stateful-testing.web-crud :as app] 10 | [net.cgrand.enlive-html :as enlive] 11 | [clojure.spec.alpha :as s] 12 | [clojure.test.check.generators :as gen] 13 | [stateful-testing.fsm-test-utils :as fsm])) 14 | 15 | ;;; DOM MANIPULATION FNS 16 | 17 | (defn add 18 | "add a board using the webapp" 19 | [session type rating] 20 | (-> session 21 | (k/visit "/list") 22 | (t/has (t/status? 200)) 23 | (k/fill-in [:input (html/attr= :name "type")] type) 24 | (k/fill-in [:input (html/attr= :name "rating")] rating) 25 | ; NOTE: button must have {:type "submit"} to be found by Kerodon 26 | (k/press [:button]) 27 | (t/has (t/status? 303)) 28 | k/follow-redirect)) 29 | 30 | (defn delete 31 | "delete a board (by id) using the webapp" 32 | [session id] 33 | (-> session 34 | (k/visit "/list") 35 | (t/has (t/status? 200)) 36 | (k/follow [[:a.delete (html/attr= :id (str id))]]) 37 | (t/has (t/status? 303)) 38 | k/follow-redirect)) 39 | 40 | ; test the webapp using a traditional kerodon example-based test 41 | (deftest crud-unit-test 42 | (let [db (atom {1 {:id 1 43 | :type "Onewheel" 44 | :rating "Sweet As Bro!"}}) 45 | session (k/session (app/app db))] 46 | 47 | (-> session 48 | (k/visit "/list") 49 | (t/has (t/some-text? "Onewheel") "initial record visible in list") 50 | (t/has (t/missing? [(enlive/text-pred #{"Skull Board"})]) "new record not visible") 51 | 52 | (add "Skull Board" "Flintstones motor") 53 | (t/has (t/some-text? "Onewheel") "initial record visible in list") 54 | (t/has (t/some-text? "Skull Board") "added record visible in list") 55 | 56 | (add "Boosted Board" "good for roads") 57 | (t/has (t/some-text? "Onewheel") "initial record visible in list") 58 | (t/has (t/some-text? "Skull Board") "added record visible in list") 59 | (t/has (t/some-text? "Boosted Board") "added record visible in list") 60 | 61 | (delete 2) 62 | (t/has (t/some-text? "Onewheel") "initial record visible in list") 63 | (t/has (t/missing? [(enlive/text-pred #{"Skull Board"})]) "deleted record not visible") 64 | (t/has (t/some-text? "Boosted Board") "added record visible in list")))) 65 | 66 | ;;; SPEC BASED COMMAND GENERATION TESTS 67 | 68 | (s/def ::id (s/with-gen int? #(gen/pos-int))) 69 | (s/def ::type #{:add-cmd :delete-cmd}) 70 | (s/def ::board-type string?) 71 | (s/def ::board-rating string?) 72 | 73 | ; use a multi-spec since keys are different for add vs delete 74 | 75 | (defmulti command :type) 76 | (s/def ::command (s/multi-spec command ::type)) 77 | 78 | (defmethod command :add-cmd 79 | [_] 80 | (s/keys :req-un [::type ::board-type ::board-rating])) 81 | 82 | (defmethod command :delete-cmd 83 | [_] 84 | (s/keys :req-un [::type ::id])) 85 | 86 | (s/def ::commands-stateless (s/coll-of ::command :min-count 1)) 87 | 88 | (def add-cmd 89 | (reify 90 | fsm/Command 91 | (precondition [_ state] true) 92 | (postcondition [_ state cmd] true) 93 | (exec [_ state cmd] 94 | (conj state (if (seq state) ; this emulates the db generating ids 95 | (inc (apply max state)) 96 | 1))) 97 | (generate [_ state] 98 | (gen/fmap (partial zipmap [:type :board-type :board-rating]) 99 | (gen/tuple (gen/return :add-cmd) 100 | gen/string 101 | gen/string))))) 102 | 103 | (def delete-cmd 104 | (reify 105 | fsm/Command 106 | (precondition [_ state] 107 | ; must be values present for a delete to be possible 108 | (seq state)) 109 | (postcondition [_ state cmd] 110 | ;;delete only valid if present 111 | (->> state 112 | (filter #(= % (:id cmd))) 113 | seq)) 114 | (exec [_ state cmd] 115 | (disj state (:id cmd))) 116 | (generate [_ state] 117 | (gen/fmap (partial zipmap [:type :id]) 118 | (gen/tuple (gen/return :delete-cmd) 119 | (gen/elements state)))))) 120 | 121 | (comment 122 | ; TODO generator errors from multi-spec supplied generator. ignoring because using custom generator 123 | (s/exercise ::command 1) 124 | (s/exercise ::commands-stateless 3) 125 | 126 | ; can ignore errors from above because we are using a custom/stateful generator instead 127 | (gen/sample (fsm/cmd-seq #{} {:add-cmd add-cmd 128 | :delete-cmd delete-cmd}) 129 | 3) 130 | (s/exercise ::commands-stateless 3 131 | {::commands-stateless #(fsm/cmd-seq #{} {:add-cmd add-cmd 132 | :delete-cmd delete-cmd})})) 133 | 134 | (s/def ::commands-stateful (s/with-gen ::commands-stateless 135 | #(fsm/cmd-seq #{} {:add-cmd add-cmd 136 | :delete-cmd delete-cmd}))) 137 | 138 | ; this fn translates from a command into a kerodon fn call i.e. this is the command adaptor 139 | (defn apply-command 140 | "apply a cmd to a running webapp using a Kerodon session" 141 | [session cmd] 142 | (case (:type cmd) 143 | :add-cmd (add session (:board-type cmd) (:board-rating cmd)) 144 | :delete-cmd (delete session (:id cmd)))) 145 | 146 | ; this fn is the main test driver. because it is spec'd, it can be automatically tested 147 | (defn apply-commands 148 | [commands] 149 | ;(pprint commands) ; <<< uncomment this to see the generated commands 150 | (let [db (atom {}) 151 | web-app (app/app db) 152 | stateful-kerodon-session (k/session web-app) 153 | result (reduce apply-command 154 | stateful-kerodon-session 155 | commands)] 156 | {:atom-is-map (map? @db) ; state atom not corrupted 157 | :last-response-ok (= 200 (get-in result [:response :status])) ; the final cmd in the seq was OK 158 | :cmds (pos-int? (count commands)) ; at least 1 cmd was applied 159 | })) 160 | (s/fdef apply-commands 161 | :args (s/cat :cmds ::commands-stateful) 162 | :ret (s/map-of keyword? true?)) 163 | 164 | (comment 165 | (s/exercise ::commands-stateful 3) 166 | (s/exercise-fn `apply-commands 3) 167 | (st/check `apply-commands {:clojure.spec.test.check/opts {:num-tests 20}})) 168 | 169 | (deftest generative-and-stateful 170 | (let [result (st/check `apply-commands 171 | {:clojure.spec.test.check/opts {:num-tests 50}})] 172 | ;(pprint result) ; uncomment to see failure details i.e. shrunk cmd seq 173 | (is (-> result 174 | first 175 | (get-in [:clojure.spec.test.check/ret :result]) 176 | ; any exception will be in :result so only allow boolean true 177 | true?) 178 | "generative tests passed without errors"))) 179 | 180 | (deftest example-test-found 181 | ; uncomment to run a shrunk command seq that fails. 182 | ; found/fixed bug during dev where gen phase model used wrong initial id i.e. webapp uses 1 for first id 183 | #_(let [db (atom {}) 184 | session (k/session (app/app db))] 185 | (reduce apply-command 186 | session 187 | [{:type :add-cmd, :board-type "", :board-rating ""} 188 | {:type :add-cmd, :board-type "", :board-rating ""} 189 | {:type :delete-cmd, :id 0}]))) 190 | --------------------------------------------------------------------------------