mirrors/garage
1
0
Fork 0
mirror of https://git.deuxfleurs.fr/Deuxfleurs/garage.git synced 2024-11-21 23:51:00 +00:00
Code Issues Projects Releases Packages Wiki Activity

jepsen: wip checker for register-like behavior

Browse source
This commit is contained in:
Alex Auvolat 2023-10-20 12:13:11 +02:00
parent ef662822c9
commit 4ba18ce9cc
1 changed files with 62 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
script/jepsen.garage/src/jepsen/garage/reg.clj
View file

@ -1,6 +1,7 @@
(ns jepsen.garage.reg (ns jepsen.garage.reg
(:require [clojure.tools.logging :refer :all] (:require [clojure.tools.logging :refer :all]
[clojure.string :as str] [clojure.string :as str]
[clojure.set :as set]
[jepsen [checker :as checker] [jepsen [checker :as checker]
[cli :as cli] [cli :as cli]
[client :as client] [client :as client]
@ -20,7 +21,7 @@
[slingshot.slingshot :refer [try+]])) [slingshot.slingshot :refer [try+]]))
(defn op-get [_ _] {:type :invoke, :f :read, :value nil}) (defn op-get [_ _] {:type :invoke, :f :read, :value nil})
(defn op-put [_ _] {:type :invoke, :f :write, :value (str (rand-int 9))}) (defn op-put [_ _] {:type :invoke, :f :write, :value (str (rand-int 99))})
(defn op-del [_ _] {:type :invoke, :f :write, :value nil}) (defn op-del [_ _] {:type :invoke, :f :write, :value nil})
(defrecord RegClient [creds] (defrecord RegClient [creds]
@ -47,15 +48,72 @@
(teardown! [this test]) (teardown! [this test])
(close! [this test])) (close! [this test]))
(defn reg-read-after-write
"Read-after-Write checker for register operations"
[]
(reify checker/Checker
(check [this test history opts]
(let [init {:put-values {-1 nil}
:put-done #{-1}
:put-in-progress {}
:read-can-contain {}
:bad-reads #{}}
final (reduce
(fn [state op]
(let [current-values (set/union
(set (map (fn [idx] (get (:put-values state) idx)) (:put-done state)))
(set (map (fn [[_ [idx _]]] (get (:put-values state) idx)) (:put-in-progress state))))
read-can-contain (reduce
(fn [rcc [idx v]] (assoc rcc idx (set/union current-values v)))
{} (:read-can-contain state))]
(info "--------")
(info "state: " state)
(info "current-values: " current-values)
(info "read-can-contain: " read-can-contain)
(info "op: " op)
(case [(:type op) (:f op)]
([:invoke :write])
(assoc state
:read-can-contain read-can-contain
:put-values (assoc (:put-values state) (:index op) (:value op))
:put-in-progress (assoc (:put-in-progress state) (:process op) [(:index op) (:put-done state)]))
([:ok :write])
(let [[index overwrites] (get (:put-in-progress state) (:process op))]
(assoc state
:read-can-contain read-can-contain
:put-in-progress (dissoc (:put-in-progress state) (:process op))
:put-done
(conj
(set/difference (:put-done state) overwrites)
index)))
([:invoke :read])
(assoc state
:read-can-contain (assoc read-can-contain (:process op) current-values))
([:ok :read])
(let [this-read-can-contain (get read-can-contain (:process op))
bad-reads (if (contains? this-read-can-contain (:value op))
(:bad-reads state)
(conj (:bad-reads state) [(:process op) (:index op) (:value op) this-read-can-contain]))]
(info "this-read-can-contain: " this-read-can-contain)
(assoc state
:read-can-contain (dissoc read-can-contain (:process op))
:bad-reads bad-reads))
state)))
init history)
valid? (empty? (:bad-reads final))]
(assoc final :valid? valid?)))))
(defn workload (defn workload
"Tests linearizable reads and writes" "Tests linearizable reads and writes"
[opts] [opts]
{:client (RegClient. nil) {:client (RegClient. nil)
:checker (independent/checker :checker (independent/checker
(checker/compose (checker/compose
{:linear (checker/linearizable {:reg-read-after-write (reg-read-after-write)
{:model (model/register) ; linear test is desactivated, indeed Garage is not linear
:algorithm :linear}) ;:linear (checker/linearizable
; {:model (model/register)
; :algorithm :linear})
:timeline (timeline/html)})) :timeline (timeline/html)}))
:generator (independent/concurrent-generator :generator (independent/concurrent-generator
10 10