feat(course): audit fixes and twelve extensions (Modules 7b, 12, 13)
Audit pass: - Frame rule counts frames since the last move, so every step lasts exactly movesEvery(score) frames, also right after a speed-up - clampTime + MAX_GAP_MS: a hidden tab no longer replays the whole gap - Pong Restart keeps held keys - Fact corrections (mulberry32 output coverage, Haskell IO, uniform) - New fixture cases from a mutation analysis Extensions (all three tracks, shared fixtures, course text): - Turn queue (Exercise 10.6), persisted high score (10.7), replay viewer (10.8), play() end-to-end helper (9.5) - Optional State (4.7) and optional Module 7b, stack-safe IO - Module 12, property-based testing with generators, shrinking, invariants and a model-based oracle - Module 13, Conway's Life with a Click event - JS type checking via jsconfig, JSDoc and types.d.ts - Maintainer tools: scripts/mutate.mjs, scripts/typecheck-js.sh, Playwright end-to-end suite (e2e/, scripts/e2e.sh) Docs: docs/contract.md is the canonical contract; specs and build log under docs/superpowers. Verified: JS 728, Scala 689, F# 691 unit tests; stubs and progression M01-M13 and M07b; 176 end-to-end tests on Chromium and WebKit. Co-Authored-By: Claude Fable 5.2 <noreply@anthropic.com>
This commit is contained in:
1 parent
876f5aabb1
commit
edd57f0148
253 files changed
+21753
-503
No files matched your search
@@ -72,7 +72,8 @@ let gameState (v: JsonElement) : GameState =
|
||||
Seed = u32 (prop "seed" v)
|
||||
Score = num (prop "score" v)
|
||||
Status = status (prop "status" v)
|
||||
Frame = num (prop "frame" v) }
|
||||
Frame = num (prop "frame" v)
|
||||
Queued = opt direction (prop "queued" v) }
|
||||
|
||||
let shape (v: JsonElement) : Shape =
|
||||
let n key = num (prop key v)
|
||||
|
||||
@@ -16,7 +16,8 @@ let private eating: GameState =
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0 }
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
|
||||
@@ -0,0 +1,83 @@
|
||||
module Snake.Tests.M04State
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.State
|
||||
|
||||
// Small initial states for the "behaves like" checks: two States behave alike when they give the same pair from each.
|
||||
let private starts = [ 0; 1; 7; 42 ]
|
||||
|
||||
let private sameOnAll (st1: State<int, 'a>) (st2: State<int, 'a>) : unit =
|
||||
for s in starts do
|
||||
Expect.equal (State.run s st1) (State.run s st2) $"from state {s}"
|
||||
|
||||
// A counter step: gives the current number times 10 and adds 1 to the state. A function of unit, so that a stub
|
||||
// that throws fails each test on its own instead of the whole file at load time.
|
||||
let private step () : State<int, int> =
|
||||
State.get () |> State.bind (fun n -> State.put (n + 1) |> State.map (fun () -> n * 10))
|
||||
|
||||
let private f (a: int) : State<int, int> = State.modify (fun s -> s * 2) |> State.map (fun () -> a + 1)
|
||||
let private g (b: int) : State<int, int * int> = State.get () |> State.bind (fun s -> State.pure (b, s))
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M04 State" [
|
||||
testCase "State pure gives its value and leaves the state alone" (fun () ->
|
||||
Expect.equal (State.run 99 (State.pure "x")) ("x", 99) "pure")
|
||||
|
||||
testCase "State map applies f to the value and keeps the state from the underlying step" (fun () ->
|
||||
Expect.equal (State.run 4 (State.map (fun v -> v + 1) (step ()))) (41, 5) "map")
|
||||
|
||||
testCase "State bind threads the state through both steps" (fun () ->
|
||||
let both = step () |> State.bind (fun a -> step () |> State.map (fun b -> (a, b)))
|
||||
Expect.equal (State.run 4 both) ((40, 50), 6) "bind")
|
||||
|
||||
testCase "State get gives the state as the value and leaves it alone" (fun () ->
|
||||
Expect.equal (State.run "board" (State.get ())) ("board", "board") "get")
|
||||
|
||||
testCase "State put replaces the state and gives unit" (fun () ->
|
||||
Expect.equal (State.run 99 (State.put 5)) ((), 5) "put")
|
||||
|
||||
testCase "State modify applies f to the state and gives unit" (fun () ->
|
||||
Expect.equal (State.run 21 (State.modify (fun s -> s * 2))) ((), 42) "modify")
|
||||
|
||||
testCase "State law: left identity, bind f (pure a) behaves like f a" (fun () ->
|
||||
sameOnAll (State.pure 3 |> State.bind f) (f 3))
|
||||
|
||||
testCase "State law: right identity, bind pure m behaves like m" (fun () ->
|
||||
sameOnAll (step () |> State.bind State.pure) (step ()))
|
||||
|
||||
testCase "State law: associativity, the grouping of bind does not matter" (fun () ->
|
||||
sameOnAll (step () |> State.bind f |> State.bind g) (step () |> State.bind (fun a -> f a |> State.bind g)))
|
||||
|
||||
testCase "State a counter hands out fresh labels in order" (fun () ->
|
||||
let fresh = State.get () |> State.bind (fun n -> State.put (n + 1) |> State.map (fun () -> $"L{n}"))
|
||||
|
||||
let three =
|
||||
fresh
|
||||
|> State.bind (fun a -> fresh |> State.bind (fun b -> fresh |> State.map (fun c -> [ a; b; c ])))
|
||||
|
||||
Expect.equal (State.run 0 three) ([ "L0"; "L1"; "L2" ], 3) "from 0"
|
||||
Expect.equal (State.run 7 three) ([ "L7"; "L8"; "L9" ], 10) "from 7")
|
||||
|
||||
testCase "State Random is State with the seed as S: the dice give the same values and seeds" (fun () ->
|
||||
// One draw written only with State's get and put: read the seed, compute, store the next seed.
|
||||
let draw: State<uint32, uint32> =
|
||||
State.get ()
|
||||
|> State.bind (fun seed ->
|
||||
let v, next = Random.run seed Random.nextUint32
|
||||
State.put next |> State.map (fun () -> v))
|
||||
|
||||
// The same draw, by turning a Random step into a State by hand.
|
||||
let wrapped: State<uint32, uint32> = State(fun seed -> Random.run seed Random.nextUint32)
|
||||
let d6State = draw |> State.map (fun v -> 1u + v % 6u)
|
||||
let twoDiceState = d6State |> State.bind (fun a -> d6State |> State.map (fun b -> a + b))
|
||||
let d6Random = Random.nextUint32 |> Random.map (fun v -> 1u + v % 6u)
|
||||
let twoDiceRandom = d6Random |> Random.bind (fun a -> d6Random |> Random.map (fun b -> a + b))
|
||||
|
||||
for seed in [ 0u; 1u; 42u; 4294967295u ] do
|
||||
Expect.equal (State.run seed draw) (Random.run seed Random.nextUint32) $"draw from {seed}"
|
||||
Expect.equal (State.run seed wrapped) (Random.run seed Random.nextUint32) $"wrapped from {seed}"
|
||||
Expect.equal (State.run seed d6State) (Random.run seed d6Random) $"d6 from {seed}"
|
||||
Expect.equal (State.run seed twoDiceState) (Random.run seed twoDiceRandom) $"twoDice from {seed}")
|
||||
]
|
||||
@@ -0,0 +1,293 @@
|
||||
module Snake.Tests.M07bSafeIO
|
||||
|
||||
// The JS tests check that a node holds the very same function; functions cannot be compared, so these tests check
|
||||
// each node's shape (its case) and then observe the program through `trace`. `traceStep` and `drive` are JS-only.
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.View
|
||||
open Snake.SafeIO
|
||||
|
||||
let private rectAt (x: int) : Shape = Rect(x, 0, 1, 1, "#000000")
|
||||
let private r1 = rectAt 0
|
||||
let private t1 = Text(1, 2, "hi", "#ffffff", 16, "left")
|
||||
let private boom (_: 'a) : SafeIO<'b> = failwith "boom"
|
||||
let private N = 100000
|
||||
|
||||
// The value of a RandomSeed answer (the same job as IO.randomSeed does for m07's IO).
|
||||
let private seedValue (r: IO.OpResult) : uint32 =
|
||||
match r with
|
||||
| IO.Seed s -> s
|
||||
| _ -> failwith "RandomSeed must be answered with a Seed"
|
||||
|
||||
// SafeIO versions of m07's `draw` and `randomSeed`, built the same way.
|
||||
let private draw (shape: Shape) : SafeIO<unit> = SafeIO.effect (IO.Draw shape) |> SafeIO.map ignore
|
||||
let private randomSeed () : SafeIO<uint32> = SafeIO.effect IO.RandomSeed |> SafeIO.map seedValue
|
||||
|
||||
let private leftDraws (n: int) : SafeIO<unit> =
|
||||
List.fold (fun acc i -> acc |> SafeIO.bind (fun () -> draw (rectAt i))) (SafeIO.pure ()) [ 0 .. n - 1 ]
|
||||
|
||||
let private rightDraws (n: int) : SafeIO<unit> =
|
||||
List.foldBack (fun i rest -> draw (rectAt i) |> SafeIO.bind (fun () -> rest)) [ 0 .. n - 1 ] (SafeIO.pure ())
|
||||
|
||||
let private firstAndLast (ops: IO.Op list) : IO.Op list = [ List.head ops; List.last ops ]
|
||||
|
||||
// ---- the monad laws, observed through trace
|
||||
|
||||
let private programs: (string * (unit -> SafeIO<uint32>)) list =
|
||||
[ "a pure value", (fun () -> SafeIO.pure 4u)
|
||||
"one effect", (fun () -> randomSeed ())
|
||||
"a draw followed by reading the seed", (fun () -> draw r1 |> SafeIO.bind (fun () -> randomSeed ())) ]
|
||||
|
||||
let private f (n: uint32) : SafeIO<uint32> = draw (rectAt (int n)) |> SafeIO.bind (fun () -> SafeIO.pure (n * 2u))
|
||||
let private g (n: uint32) : SafeIO<uint32> = randomSeed () |> SafeIO.map (fun s -> s + n)
|
||||
|
||||
// ---- the same programs under m07's IO. F# cannot pass "an IO module" as a parameter, so each program is written
|
||||
// twice, line for line the same, once with each IO.
|
||||
|
||||
let private shared: (string * (unit -> IO.Traced<int>) * (unit -> IO.Traced<int>)) list =
|
||||
[ "seed, then a draw that depends on it",
|
||||
(fun () ->
|
||||
randomSeed ()
|
||||
|> SafeIO.bind (fun s -> draw (rectAt (int (s % 20u))) |> SafeIO.map (fun () -> int s))
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
IO.randomSeed ()
|
||||
|> IO.bind (fun s -> IO.draw (rectAt (int (s % 20u))) |> IO.map (fun () -> int s))
|
||||
|> IO.trace 7u)
|
||||
|
||||
"a sequence of three effects",
|
||||
(fun () ->
|
||||
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore; draw r1 ]
|
||||
|> SafeIO.map (fun () -> 0)
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore; IO.draw r1 ]
|
||||
|> IO.map (fun () -> 0)
|
||||
|> IO.trace 7u)
|
||||
|
||||
"200 left-nested binds",
|
||||
(fun () ->
|
||||
List.fold
|
||||
(fun acc i -> acc |> SafeIO.bind (fun n -> draw (rectAt i) |> SafeIO.map (fun () -> n + 1)))
|
||||
(SafeIO.pure 0)
|
||||
[ 0..199 ]
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
List.fold (fun acc i -> acc |> IO.bind (fun n -> IO.draw (rectAt i) |> IO.map (fun () -> n + 1))) (IO.pure 0) [ 0..199 ]
|
||||
|> IO.trace 7u)
|
||||
|
||||
"nested on both sides",
|
||||
(fun () ->
|
||||
randomSeed ()
|
||||
|> SafeIO.bind (fun s -> draw r1 |> SafeIO.bind (fun () -> SafeIO.pure (int s + 1)))
|
||||
|> SafeIO.bind (fun n ->
|
||||
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore ] |> SafeIO.map (fun () -> n * 3))
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
IO.randomSeed ()
|
||||
|> IO.bind (fun s -> IO.draw r1 |> IO.bind (fun () -> IO.pure (int s + 1)))
|
||||
|> IO.bind (fun n -> IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore ] |> IO.map (fun () -> n * 3))
|
||||
|> IO.trace 7u) ]
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M07b SafeIO" [
|
||||
// ---- building
|
||||
|
||||
testCase "pure builds a Pure" (fun () ->
|
||||
match SafeIO.pure 3 with
|
||||
| Pure 3 -> ()
|
||||
| _ -> failtest "expected Pure 3")
|
||||
|
||||
testCase "effect op is an Effect whose continuation is pure" (fun () ->
|
||||
match SafeIO.effect IO.RandomSeed with
|
||||
| Effect(op, k) ->
|
||||
Expect.equal op IO.RandomSeed "op"
|
||||
|
||||
match k (IO.Seed 5u) with
|
||||
| Pure(IO.Seed 5u) -> ()
|
||||
| _ -> failtest "expected the continuation to give Pure (Seed 5u)"
|
||||
| _ -> failtest "expected an Effect")
|
||||
|
||||
testCase "bind only builds a FlatMap node" (fun () ->
|
||||
match SafeIO.pure 1 |> SafeIO.bind (fun n -> SafeIO.pure (n + 1)) with
|
||||
| FlatMap(inner, k) ->
|
||||
match inner with
|
||||
| Pure x -> Expect.equal (unbox<int> x) 1 "the inner program is the Pure 1 it was given"
|
||||
| _ -> failtest "expected the inner program to be a Pure"
|
||||
|
||||
Expect.equal (SafeIO.trace 0u (k (box 1))).Result 2 "the continuation is f"
|
||||
| _ -> failtest "expected a FlatMap")
|
||||
|
||||
testCase "building bind throwingF (pure 1) does not throw" (fun () ->
|
||||
SafeIO.pure 1 |> SafeIO.bind boom |> ignore<SafeIO<int>>)
|
||||
|
||||
testCase "building map throwingF io does not throw" (fun () ->
|
||||
SafeIO.effect IO.RandomSeed |> SafeIO.map (fun _ -> failwith "boom") |> ignore<SafeIO<int>>)
|
||||
|
||||
testCase "tracing map throwingF io runs f and throws" (fun () ->
|
||||
Expect.throwsC
|
||||
(fun () ->
|
||||
SafeIO.effect IO.RandomSeed
|
||||
|> SafeIO.map (fun _ -> failwith "boom")
|
||||
|> SafeIO.trace 0u
|
||||
|> ignore<IO.Traced<int>>)
|
||||
(fun e -> Expect.equal e.Message "boom" "f runs when the program is traced"))
|
||||
|
||||
// ---- step: the three rewrite rules
|
||||
|
||||
testCase "step leaves a Pure unchanged" (fun () ->
|
||||
match SafeIO.step (SafeIO.pure 1) with
|
||||
| Pure 1 -> ()
|
||||
| _ -> failtest "expected Pure 1")
|
||||
|
||||
testCase "step leaves an Effect unchanged" (fun () ->
|
||||
match SafeIO.step (SafeIO.effect IO.RandomSeed) with
|
||||
| Effect(IO.RandomSeed, k) ->
|
||||
match k (IO.Seed 5u) with
|
||||
| Pure(IO.Seed 5u) -> ()
|
||||
| _ -> failtest "expected the same continuation (pure)"
|
||||
| _ -> failtest "expected an Effect with the same op")
|
||||
|
||||
testCase "step of FlatMap(Pure a, f) is f a" (fun () ->
|
||||
match SafeIO.step (SafeIO.pure 3 |> SafeIO.bind (fun n -> SafeIO.pure (n * 2))) with
|
||||
| Pure 6 -> ()
|
||||
| _ -> failtest "expected Pure 6")
|
||||
|
||||
testCase "step of FlatMap(Effect(op, k), f) is an Effect with the same op that continues with FlatMap(k r, f)" (fun () ->
|
||||
let f (r: IO.OpResult) = SafeIO.pure (int (seedValue r) * 2)
|
||||
|
||||
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind f) with
|
||||
| Effect(op, k) ->
|
||||
Expect.equal op IO.RandomSeed "op"
|
||||
|
||||
match k (IO.Seed 5u) with
|
||||
| FlatMap(Pure x, _) as next ->
|
||||
Expect.equal (unbox<IO.OpResult> x) (IO.Seed 5u) "FlatMap(k r, _): k r is Pure (Seed 5u)"
|
||||
Expect.equal (SafeIO.trace 0u next) { IO.Result = 10; IO.Ops = [] } "then f"
|
||||
| _ -> failtest "expected the continuation to give FlatMap(Pure _, _)"
|
||||
| _ -> failtest "expected an Effect")
|
||||
|
||||
testCase "step re-associates FlatMap(FlatMap(m, g), f) into FlatMap(m, fun x -> FlatMap(g x, f))" (fun () ->
|
||||
let g (r: IO.OpResult) = SafeIO.pure (int (seedValue r) + 1)
|
||||
let f (n: int) = SafeIO.pure (n * 2)
|
||||
|
||||
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind g |> SafeIO.bind f) with
|
||||
| FlatMap(Effect(IO.RandomSeed, _), k) ->
|
||||
match k (box (IO.Seed 4u)) with
|
||||
| FlatMap(Pure x, _) as inner ->
|
||||
Expect.equal (unbox<int> x) 5 "g x is Pure 5"
|
||||
Expect.equal (SafeIO.trace 0u inner) { IO.Result = 10; IO.Ops = [] } "then f"
|
||||
| _ -> failtest "expected the continuation to give FlatMap(g x, f)"
|
||||
| _ -> failtest "expected FlatMap(m, _) with m the Effect")
|
||||
|
||||
testCase "step does not call the functions it re-associates" (fun () ->
|
||||
SafeIO.effect IO.RandomSeed
|
||||
|> SafeIO.bind boom
|
||||
|> SafeIO.bind boom
|
||||
|> SafeIO.step
|
||||
|> ignore<SafeIO<int>>)
|
||||
|
||||
testCase "step of a left-nested chain is one rewrite, not a whole walk" (fun () ->
|
||||
// After one step, the top is still a FlatMap: step did constant work, the rest is left for later steps.
|
||||
let chain = List.fold (fun acc _ -> acc |> SafeIO.bind (fun n -> SafeIO.pure (n + 1))) (SafeIO.pure 0) [ 1..N ]
|
||||
|
||||
match SafeIO.step chain with
|
||||
| FlatMap _ -> ()
|
||||
| _ -> failtest "expected a FlatMap")
|
||||
|
||||
// ---- the interpreter
|
||||
|
||||
testCase "trace of pure 3 has result 3 and no ops" (fun () ->
|
||||
Expect.equal (SafeIO.trace 0u (SafeIO.pure 3)) { IO.Result = 3; IO.Ops = [] } "trace")
|
||||
|
||||
testCase "trace answers RandomSeed with the seed and Draw with Done" (fun () ->
|
||||
let program =
|
||||
SafeIO.effect IO.RandomSeed
|
||||
|> SafeIO.bind (fun s -> SafeIO.effect (IO.Draw r1) |> SafeIO.map (fun d -> (s, d)))
|
||||
|
||||
Expect.equal
|
||||
(SafeIO.trace 9u program)
|
||||
{ IO.Result = (IO.Seed 9u, IO.Done); IO.Ops = [ IO.RandomSeed; IO.Draw r1 ] }
|
||||
"trace")
|
||||
|
||||
// The stub throws too, so the test also checks that the failure is not the stub's TODO.
|
||||
testCase "trace refuses operations of later modules" (fun () ->
|
||||
Expect.throwsC
|
||||
(fun () -> SafeIO.trace 0u (SafeIO.effect IO.LoadBest) |> ignore)
|
||||
(fun e -> Expect.isFalse (e.Message.Contains "TODO") $"refused by the interpreter, not the stub: {e.Message}"))
|
||||
|
||||
testCase "sequence of nothing has no ops" (fun () ->
|
||||
Expect.equal (SafeIO.trace 0u (SafeIO.sequence [])) { IO.Result = (); IO.Ops = [] } "trace")
|
||||
|
||||
testCase "sequence runs effects left to right" (fun () ->
|
||||
Expect.equal
|
||||
(SafeIO.trace 0u (SafeIO.sequence [ randomSeed () |> SafeIO.map ignore; draw t1; draw r1 ])).Ops
|
||||
[ IO.RandomSeed; IO.Draw t1; IO.Draw r1 ]
|
||||
"ops")
|
||||
|
||||
// ---- stack safety
|
||||
|
||||
testCase "100 000 left-nested binds of draws run, in order" (fun () ->
|
||||
let traced = SafeIO.trace 0u (leftDraws N)
|
||||
Expect.equal traced.Result () "result"
|
||||
Expect.equal (List.length traced.Ops) N "ops"
|
||||
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
|
||||
|
||||
testCase "100 000 right-nested binds of draws run, in order" (fun () ->
|
||||
let traced = SafeIO.trace 0u (rightDraws N)
|
||||
Expect.equal (List.length traced.Ops) N "ops"
|
||||
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
|
||||
|
||||
testCase "100 000 left-nested maps run without any op" (fun () ->
|
||||
let program = List.fold (fun acc _ -> acc |> SafeIO.map (fun n -> n + 1)) (SafeIO.pure 0) [ 1..N ]
|
||||
Expect.equal (SafeIO.trace 0u program) { IO.Result = N; IO.Ops = [] } "trace")
|
||||
|
||||
testCase "sequence of 100 000 draws runs" (fun () ->
|
||||
let program = SafeIO.sequence [ for i in 0 .. N - 1 -> draw (rectAt i) ]
|
||||
Expect.equal (List.length (SafeIO.trace 0u program).Ops) N "ops")
|
||||
|
||||
testCase "a while loop over step is a complete interpreter for 100 000 left-nested binds" (fun () ->
|
||||
// What an impure runtime would do (a loop is allowed there): rewrite until the top is Pure or Effect, perform.
|
||||
let mutable performed = 0
|
||||
let mutable current = leftDraws N
|
||||
let isPure p = match p with Pure _ -> true | _ -> false
|
||||
|
||||
while not (isPure current) do
|
||||
current <- SafeIO.step current
|
||||
|
||||
match current with
|
||||
| Effect(_, k) ->
|
||||
performed <- performed + 1
|
||||
current <- k IO.Done
|
||||
| _ -> ()
|
||||
|
||||
Expect.equal performed N "performed")
|
||||
|
||||
// ---- the monad laws, observed through trace
|
||||
|
||||
yield!
|
||||
[ for name, program in programs do
|
||||
testCase $"left identity holds for {name}" (fun () ->
|
||||
let a = (SafeIO.trace 5u (program ())).Result
|
||||
Expect.equal (SafeIO.trace 5u (SafeIO.pure a |> SafeIO.bind f)) (SafeIO.trace 5u (f a)) "left identity")
|
||||
|
||||
testCase $"right identity holds for {name}" (fun () ->
|
||||
Expect.equal
|
||||
(SafeIO.trace 5u (program () |> SafeIO.bind SafeIO.pure))
|
||||
(SafeIO.trace 5u (program ()))
|
||||
"right identity")
|
||||
|
||||
testCase $"associativity holds for {name}" (fun () ->
|
||||
Expect.equal
|
||||
(SafeIO.trace 5u (program () |> SafeIO.bind f |> SafeIO.bind g))
|
||||
(SafeIO.trace 5u (program () |> SafeIO.bind (fun x -> f x |> SafeIO.bind g)))
|
||||
"associativity") ]
|
||||
|
||||
// ---- the same programs under Module 7's IO
|
||||
|
||||
yield!
|
||||
[ for name, safe, simple in shared ->
|
||||
testCase $"trace equals Module 7's trace for {name}" (fun () -> Expect.equal (safe ()) (simple ()) "trace") ]
|
||||
]
|
||||
@@ -24,6 +24,9 @@ let tests =
|
||||
testCase "interval emits several multiples after one big time jump" (fun () ->
|
||||
Expect.equal (Stream.run [ Time 35L ] (Stream.interval 10L)) [ 10L; 20L; 30L ] "ticks")
|
||||
|
||||
testCase "interval 1 emits every millisecond crossed" (fun () ->
|
||||
Expect.equal (Stream.run [ Time 1L; Time 3L ] (Stream.interval 1L)) [ 1L; 2L; 3L ] "ticks")
|
||||
|
||||
testCase "interval ignores key events" (fun () ->
|
||||
Expect.equal (Stream.run [ KeyDown "a"; KeyUp "a" ] (Stream.interval 10L)) [] "ticks")
|
||||
|
||||
|
||||
+25
-2
@@ -7,6 +7,9 @@ open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.Tests.M09Helpers
|
||||
|
||||
// The ops of drawing one state's view.
|
||||
let private drawOps (state: GameState) : Op list = View.view state |> List.map Draw
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M09 App" [
|
||||
@@ -37,12 +40,19 @@ let tests =
|
||||
(View.view (Spawn.newGame 42u) |> List.map Draw)
|
||||
"ops")
|
||||
|
||||
// Module 10 (Exercise 10.7) makes `main` also load the stored best and draw one more shape after the game's
|
||||
// view, so this test accepts both versions; M10 pins the final one exactly.
|
||||
testCase "main asks for a random seed, then builds the stream from it" (fun () ->
|
||||
let traced = IO.trace 42u (App.main ())
|
||||
Expect.equal traced.Ops [ RandomSeed ] "ops"
|
||||
|
||||
Expect.isTrue
|
||||
(traced.Ops = [ RandomSeed ] || traced.Ops = [ RandomSeed; LoadBest ])
|
||||
$"main may only ask for the seed (and, from m10 on, the stored best); it asked for %A{traced.Ops}"
|
||||
|
||||
let outs, _ = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (List.length outs) 1 "one drawing"
|
||||
Expect.equal (drawn (List.head outs)) (View.view (Spawn.newGame 42u)) "drawing")
|
||||
let expected = View.view (Spawn.newGame 42u)
|
||||
Expect.equal (drawn (List.head outs) |> List.truncate (List.length expected)) expected "drawing")
|
||||
|
||||
// `main` itself switches to speedActions in m10, so the 150 ms behaviour is checked on the same program built from classicActions.
|
||||
testCase "the program built from classicActions draws the new game first, then the ticked game after 150 ms" (fun () ->
|
||||
@@ -60,4 +70,17 @@ let tests =
|
||||
let later, _ = Stream.step (Time 150L) next
|
||||
Expect.equal (List.length first) 1 "one drawing"
|
||||
Expect.isNonEmpty later "more drawings")
|
||||
|
||||
// ---- play: the whole program in one equality (Exercise 9.5)
|
||||
|
||||
testCase "play on the classic program equals the scenes of the expected states" (fun () ->
|
||||
let events = [ Time 150L; KeyDown "ArrowUp"; KeyDown "x"; Time 300L; Time 310L ]
|
||||
let expectedStates = Game.history (Spawn.newGame 42u) [ Tick; Turn Up; Tick ]
|
||||
Expect.equal (App.play 42u events (classicMain ())) (List.map drawOps expectedStates) "drawings")
|
||||
|
||||
testCase "play with no events gives no drawings" (fun () ->
|
||||
Expect.equal (App.play 42u [] (classicMain ())) [] "drawings")
|
||||
|
||||
testCase "play uses the seed for the program's RandomSeed" (fun () ->
|
||||
Expect.equal (App.play 7u [ Time 0L ] (classicMain ())) [ drawOps (Spawn.newGame 7u) ] "drawings")
|
||||
]
|
||||
@@ -16,4 +16,4 @@ let drawn (io: IO<unit>) : Shape list =
|
||||
|> List.choose (fun op ->
|
||||
match op with
|
||||
| Draw shape -> Some shape
|
||||
| RandomSeed -> None)
|
||||
| _ -> None)
|
||||
@@ -8,17 +8,25 @@ open Snake.Runtime
|
||||
open Snake.Tests.M09Helpers
|
||||
|
||||
/// A fake platform: records every call and lets the test fire events by hand. (Tests may mutate; src/ may not.)
|
||||
type FakePlatform(seed: uint32) =
|
||||
type FakePlatform(seed: uint32, best: int) =
|
||||
let calls = ResizeArray<obj list>()
|
||||
let mutable onTime: int64 -> unit = ignore
|
||||
let mutable onDown: string -> unit = ignore
|
||||
let mutable onUp: string -> unit = ignore
|
||||
// m13: a runtime from Module 9 does not register this yet; nothing in m09 fires a click.
|
||||
let mutable onClick: int -> int -> unit = fun _ _ -> ()
|
||||
let registered = ResizeArray<string>()
|
||||
|
||||
new(seed: uint32) = FakePlatform(seed, 0)
|
||||
|
||||
member _.Calls: obj list list = List.ofSeq calls
|
||||
member _.Clear() = calls.Clear()
|
||||
member _.FireTime(t: int64) = onTime t
|
||||
member _.FireKey(key: string) = onDown key
|
||||
member _.FireKeyUp(key: string) = onUp key
|
||||
member _.FireClick(x: int, y: int) = onClick x y
|
||||
/// The names of the handlers the runtime registered ("click", "down", "time", "up"), sorted.
|
||||
member _.Registered: string list = registered |> Seq.distinct |> Seq.sort |> List.ofSeq
|
||||
|
||||
member _.Platform: Platform =
|
||||
{ FillRect = fun x y w h color -> calls.Add [ box "fillRect"; box x; box y; box w; box h; box color ]
|
||||
@@ -29,9 +37,27 @@ type FakePlatform(seed: uint32) =
|
||||
fun () ->
|
||||
calls.Add [ box "randomSeed" ]
|
||||
seed
|
||||
StartClock = fun cb -> onTime <- cb
|
||||
OnKeyDown = fun cb -> onDown <- cb
|
||||
OnKeyUp = fun cb -> onUp <- cb }
|
||||
LoadBest =
|
||||
fun () ->
|
||||
calls.Add [ box "loadBest" ]
|
||||
best
|
||||
SaveBest = fun n -> calls.Add [ box "saveBest"; box n ]
|
||||
StartClock =
|
||||
fun cb ->
|
||||
registered.Add "time"
|
||||
onTime <- cb
|
||||
OnKeyDown =
|
||||
fun cb ->
|
||||
registered.Add "down"
|
||||
onDown <- cb
|
||||
OnKeyUp =
|
||||
fun cb ->
|
||||
registered.Add "up"
|
||||
onUp <- cb
|
||||
OnClick =
|
||||
fun cb ->
|
||||
registered.Add "click"
|
||||
onClick <- cb }
|
||||
|
||||
// What the platform should have been asked to draw for a scene.
|
||||
let private expectedCalls (scene: Scene) : obj list list =
|
||||
|
||||
@@ -1,15 +1,47 @@
|
||||
module Snake.Tests.M10Extensions
|
||||
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.App
|
||||
open Snake.Tests.Fixtures
|
||||
open Snake.Tests.M09Helpers
|
||||
open Snake.Tests.M09Runtime
|
||||
|
||||
let private frameTimes = [ 25L; 50L; 75L; 100L; 125L; 150L; 175L; 200L ]
|
||||
|
||||
// Sessions in the fixtures use the keys game, best and improved.
|
||||
let private session (v: JsonElement) : Session =
|
||||
{ Game = gameState (prop "game" v); Best = num (prop "best" v); Improved = bool (prop "improved" v) }
|
||||
|
||||
// Events in the golden fixture: {tag:'Time', t} and {tag:'KeyDown', key}.
|
||||
let private event (v: JsonElement) : Event =
|
||||
match str (prop "tag" v) with
|
||||
| "Time" -> Time((prop "t" v).GetInt64())
|
||||
| "KeyDown" -> KeyDown(str (prop "key" v))
|
||||
| "KeyUp" -> KeyUp(str (prop "key" v))
|
||||
| other -> failwith $"unknown event tag: {other}"
|
||||
|
||||
// The drawings are compared by their first shapes, the game's view: Exercise 10.7 adds the best score after it.
|
||||
let private startsWithView (io: IO<unit>) (state: GameState) (label: string) =
|
||||
let expected = View.view state
|
||||
Expect.equal (drawn io |> List.truncate (List.length expected)) expected label
|
||||
|
||||
let private newSession (game: GameState) (best: int) : Session = { Game = game; Best = best; Improved = false }
|
||||
|
||||
let private drawOps (scene: Scene) : Op list = List.map Draw scene
|
||||
|
||||
let private saves (ops: Op list) : int list =
|
||||
ops
|
||||
|> List.choose (fun op ->
|
||||
match op with
|
||||
| SaveBest n -> Some n
|
||||
| _ -> None)
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M10 Extensions" [
|
||||
@@ -22,6 +54,31 @@ let tests =
|
||||
yield! fixtureTests "m10-input" "keyToAction" (fun c ->
|
||||
Expect.equal (Input.keyToAction (str (arg 0 c))) (opt action (expected c)) "keyToAction")
|
||||
|
||||
yield! fixtureTests "m10-session-update" "sessionUpdate" (fun c ->
|
||||
Expect.equal (App.sessionUpdate (session (arg 0 c)) (action (arg 1 c))) (session (expected c)) "sessionUpdate")
|
||||
|
||||
yield! fixtureTests "m10-session-view" "sessionView" (fun c ->
|
||||
Expect.equal (App.sessionView (session (arg 0 c))) (list shape (expected c)) "sessionView")
|
||||
|
||||
// ---- the turn queue (Exercise 10.6)
|
||||
|
||||
testCase "steer is what update does with a Turn" (fun () ->
|
||||
for c in cases "m10-update" do
|
||||
match action (arg 1 c) with
|
||||
| Turn dir -> Expect.equal (Game.steer (gameState (arg 0 c)) dir) (gameState (expected c)) (name c)
|
||||
| _ -> ())
|
||||
|
||||
testCase "Turn Up then Turn Left within one step: the snake goes Up on the next step and Left on the one after" (fun () ->
|
||||
let start = Spawn.newGame 42u // heading Right from (10, 10); the apple is far away
|
||||
let states = List.scan Game.update start [ Turn Up; Turn Left; Tick; Tick ]
|
||||
|
||||
Expect.equal
|
||||
(states |> List.skip 2 |> List.map (fun s -> List.head s.Snake))
|
||||
[ { X = 10; Y = 10 }; { X = 10; Y = 9 }; { X = 9; Y = 9 } ]
|
||||
"head path"
|
||||
|
||||
Expect.equal (states |> List.map (fun s -> s.Queued)) [ None; None; Some Left; None; None ] "queued")
|
||||
|
||||
testCase "the animation clock runs every 25 ms" (fun () -> Expect.equal App.FRAME_MS 25L "FRAME_MS")
|
||||
|
||||
testCase "speedActions turns the clock into Frame actions every 25 ms" (fun () ->
|
||||
@@ -35,9 +92,9 @@ let tests =
|
||||
|
||||
testCase "main (seed 42) draws a moved snake after eight 25 ms frames" (fun () ->
|
||||
let traced = IO.trace 42u (App.main ())
|
||||
Expect.equal traced.Ops [ RandomSeed ] "ops"
|
||||
Expect.equal (List.head traced.Ops) RandomSeed "first op"
|
||||
let first, afterFirst = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (drawn (List.head first)) (View.view (Spawn.newGame 42u)) "first drawing"
|
||||
startsWithView (List.head first) (Spawn.newGame 42u) "first drawing"
|
||||
let drawings = Stream.run (List.map Time frameTimes) afterFirst
|
||||
Expect.equal (List.length drawings) 8 "eight drawings"
|
||||
let start = Spawn.newGame 42u
|
||||
@@ -45,7 +102,153 @@ let tests =
|
||||
let moved =
|
||||
{ start with
|
||||
Snake = start.Snake |> List.map (fun p -> { p with X = p.X + 1 })
|
||||
Frame = 8 }
|
||||
Frame = 0 }
|
||||
|
||||
Expect.equal (drawn drawings[7]) (View.view moved) "moved snake")
|
||||
startsWithView drawings[7] moved "moved snake")
|
||||
|
||||
// ---- clampTime: a long silence from the clock (a background tab) must not turn into hundreds of frames
|
||||
|
||||
testCase "clampTime passes small steps of time through unchanged" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 5L; 10L; 35L ]))
|
||||
[ 10L; 20L; 30L ]
|
||||
"outputs")
|
||||
|
||||
testCase "clampTime lets a long gap count as maxGap, and carries on from there" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run (List.map Time [ 10L; 5000L; 5010L ]))
|
||||
[ 10L; 20L; 30L; 40L ]
|
||||
"outputs")
|
||||
|
||||
testCase "clampTime clamps the very first step too (the clock starts at 0)" (fun () ->
|
||||
Expect.equal (Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 1000L ]) [ 10L; 20L ] "outputs")
|
||||
|
||||
testCase "clampTime never moves the clock backwards" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 30L; 10L; 40L ]))
|
||||
[ 10L; 20L; 30L; 40L; 50L; 60L ]
|
||||
"outputs")
|
||||
|
||||
testCase "clampTime passes key events through, and they do not disturb the clock" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.keyDowns |> Stream.clampTime 5L |> Stream.run [ KeyDown "a"; Time 50L; KeyDown "b" ])
|
||||
[ "a"; "b" ]
|
||||
"keys"
|
||||
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 10L; KeyDown "a"; Time 20L ])
|
||||
[ 10L; 20L ]
|
||||
"clock")
|
||||
|
||||
testCase "clampTime tells the inner stream exactly the clamped time, and a repeated time adds nothing" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 1L |> Stream.clampTime 100L |> Stream.run [ Time 5L; Time 5L; Time 6L ])
|
||||
[ 1L; 2L; 3L; 4L; 5L; 6L ]
|
||||
"outputs")
|
||||
|
||||
testCase "running the same clamped stream twice gives the same outputs" (fun () ->
|
||||
let s = Stream.interval 10L |> Stream.clampTime 25L
|
||||
let events = List.map Time [ 10L; 5000L; 5010L ]
|
||||
Expect.equal (Stream.run events s) (Stream.run events s) "same outputs")
|
||||
|
||||
testCase "the game accepts at most 250 ms of time at once" (fun () -> Expect.equal App.MAX_GAP_MS 250L "MAX_GAP_MS")
|
||||
|
||||
testCase "main: after ten seconds in a background tab the game advances by 250 ms, not by ten seconds" (fun () ->
|
||||
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (App.main ())).Result
|
||||
let drawings, next = Stream.step (Time 10000L) afterFirst
|
||||
Expect.equal (List.length drawings) (int (App.MAX_GAP_MS / App.FRAME_MS)) "ten drawings"
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10025L) next))) 1 "one more drawing")
|
||||
|
||||
// ---- a high score that survives a reload (Exercise 10.7)
|
||||
|
||||
testCase "loadBest records a LoadBest op and is answered with the best given to traceWith" (fun () ->
|
||||
Expect.equal (IO.traceWith 0u 17 (IO.loadBest ())) { Result = 17; Ops = [ LoadBest ] } "traceWith")
|
||||
|
||||
testCase "trace answers LoadBest with 0 (no best given)" (fun () ->
|
||||
Expect.equal (IO.trace 9u (IO.loadBest ())).Result 0 "result")
|
||||
|
||||
testCase "saveBest records a SaveBest op with the score and produces ()" (fun () ->
|
||||
Expect.equal (IO.trace 0u (IO.saveBest 7)) { Result = (); Ops = [ SaveBest 7 ] } "trace")
|
||||
|
||||
testCase "a program can load the best, then save a higher one" (fun () ->
|
||||
Expect.equal
|
||||
(IO.traceWith 0u 4 (IO.loadBest () |> IO.bind (fun b -> IO.saveBest (b + 1)))).Ops
|
||||
[ LoadBest; SaveBest 5 ]
|
||||
"ops")
|
||||
|
||||
testCase "sessions starts with the new game and the stored best, then yields one session per action" (fun () ->
|
||||
let out = App.sessions 42u 3 App.speedActions |> Stream.run [ Time 25L; KeyDown " " ]
|
||||
let s0 = newSession (Spawn.newGame 42u) 3
|
||||
let s1 = App.sessionUpdate s0 Frame
|
||||
Expect.equal out [ s0; s1; App.sessionUpdate s1 TogglePause ] "sessions")
|
||||
|
||||
testCase "renderSession draws the session view and saves nothing when the best did not improve" (fun () ->
|
||||
let s = newSession (Spawn.newGame 42u) 5
|
||||
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s)) "ops")
|
||||
|
||||
testCase "renderSession draws the session view, then saves the best, when the best improved" (fun () ->
|
||||
let s = { Game = { Spawn.newGame 42u with Score = 6 }; Best = 6; Improved = true }
|
||||
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s) @ [ SaveBest 6 ]) "ops")
|
||||
|
||||
testCase "main asks for the seed, then the stored best, and draws the first session" (fun () ->
|
||||
let traced = IO.traceWith 42u 9 (App.main ())
|
||||
Expect.equal traced.Ops [ RandomSeed; LoadBest ] "ops"
|
||||
let first, _ = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (drawn (List.head first)) (App.sessionView (newSession (Spawn.newGame 42u) 9)) "drawing")
|
||||
|
||||
testCase "playWith passes the best to the program: the first scene shows it" (fun () ->
|
||||
Expect.equal
|
||||
(App.playWith 42u 9 [ Time 0L ] (App.main ()))
|
||||
[ drawOps (App.sessionView (newSession (Spawn.newGame 42u) 9)) ]
|
||||
"drawings")
|
||||
|
||||
// The golden fixture: a seed, a scripted list of inputs, a stored best, and the scene of the last drawing.
|
||||
yield!
|
||||
[ for c in cases "m10-golden" do
|
||||
let seed = u32 (arg 0 c)
|
||||
let events = list event (arg 1 c)
|
||||
let best = num (arg 2 c)
|
||||
let expectedScene = list shape (expected c)
|
||||
|
||||
yield
|
||||
testCase $"play(main): {name c}" (fun () ->
|
||||
let lastScene = App.playWith seed best events (App.main ()) |> List.last
|
||||
Expect.equal (lastScene |> List.choose (fun op -> match op with Draw s -> Some s | _ -> None)) expectedScene "last scene")
|
||||
|
||||
yield
|
||||
testCase $"play(main) saves once per improvement: {name c}" (fun () ->
|
||||
let saved = App.playWith seed best events (App.main ()) |> List.collect saves
|
||||
|
||||
let finalBest =
|
||||
expectedScene
|
||||
|> List.pick (fun s ->
|
||||
match s with
|
||||
| Text(_, _, text, _, _, _) when text.StartsWith "Best: " -> Some(int (text.Substring 6))
|
||||
| _ -> None)
|
||||
|
||||
Expect.equal saved [ best + 1 .. finalBest ] "saves") ]
|
||||
|
||||
// ---- the runtime with a fake platform that records the two new calls
|
||||
|
||||
testCase "runIO answers LoadBest with platform.LoadBest () and continues with it" (fun () ->
|
||||
let p = FakePlatform(42u, 11)
|
||||
Expect.equal (Runtime.runIO p.Platform (IO.loadBest () |> IO.map (fun b -> b + 1))) 12 "result"
|
||||
Expect.equal p.Calls [ [ box "loadBest" ] ] "calls")
|
||||
|
||||
testCase "runIO maps SaveBest to platform.SaveBest score" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
Expect.equal (Runtime.runIO p.Platform (IO.saveBest 8 |> IO.bind (fun () -> IO.pure "done"))) "done" "result"
|
||||
Expect.equal p.Calls [ [ box "saveBest"; box 8 ] ] "calls")
|
||||
|
||||
testCase "runApp asks for the seed and loads the best once, at start, and draws nothing before the first event" (fun () ->
|
||||
let p = FakePlatform(42u, 3)
|
||||
Runtime.runApp p.Platform (App.main ())
|
||||
Expect.equal p.Calls [ [ box "randomSeed" ]; [ box "loadBest" ] ] "calls at start"
|
||||
p.FireTime 0L
|
||||
p.FireTime 25L
|
||||
Expect.equal (p.Calls |> List.filter (fun c -> List.head c = box "loadBest") |> List.length) 1 "one load"
|
||||
|
||||
Expect.isTrue
|
||||
(p.Calls |> List.exists (fun c -> List.head c = box "fillText" && c[3] = box "Best: 3"))
|
||||
"draws Best: 3")
|
||||
]
|
||||
@@ -0,0 +1,180 @@
|
||||
module Snake.Tests.M10Replay
|
||||
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.Replay
|
||||
open Snake.Tests.Fixtures
|
||||
open Snake.Tests.M09Helpers
|
||||
|
||||
// Viewers in the fixtures use the keys index, last and playing.
|
||||
let private viewer (v: JsonElement) : Viewer =
|
||||
{ Index = num (prop "index" v); Last = num (prop "last" v); Playing = bool (prop "playing" v) }
|
||||
|
||||
let private viewerAction (v: JsonElement) : ViewerAction =
|
||||
match str (prop "tag" v) with
|
||||
| "Next" -> ViewerAction.Next
|
||||
| "Prev" -> ViewerAction.Prev
|
||||
| "First" -> ViewerAction.First
|
||||
| "Last" -> ViewerAction.Last
|
||||
| "TogglePlay" -> ViewerAction.TogglePlay
|
||||
| "Beat" -> ViewerAction.Beat
|
||||
| other -> failwith $"unknown viewer action tag: {other}"
|
||||
|
||||
// The sample recording, as the page loads it. Not a fixture of cases: a recording {seed, actions}.
|
||||
let private sample: Recording =
|
||||
let v = load "replay-sample"
|
||||
{ Seed = u32 (prop "seed" v); Actions = list action (prop "actions" v) }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M10 Replay" [
|
||||
yield! fixtureTests "m10-viewer-update" "viewerUpdate" (fun c ->
|
||||
Expect.equal (viewerUpdate (viewer (arg 0 c)) (viewerAction (arg 1 c))) (viewer (expected c)) "viewerUpdate")
|
||||
|
||||
yield! fixtureTests "m10-viewer-key" "viewerKey" (fun c ->
|
||||
Expect.equal (viewerKey (str (arg 0 c))) (opt viewerAction (expected c)) "viewerKey")
|
||||
|
||||
yield! fixtureTests "m10-viewer-view" "viewerView" (fun c ->
|
||||
Expect.equal (viewerView (list gameState (arg 0 c)) (viewer (arg 1 c))) (list shape (expected c)) "viewerView")
|
||||
|
||||
yield!
|
||||
[ testCase
|
||||
"the sample recording is worth watching: Tick and Turn only, under 400 actions, at least five apples, then game over"
|
||||
(fun () ->
|
||||
Expect.all
|
||||
sample.Actions
|
||||
(fun a ->
|
||||
match a with
|
||||
| Tick
|
||||
| Turn _ -> true
|
||||
| _ -> false)
|
||||
"Tick and Turn only"
|
||||
|
||||
let n = List.length sample.Actions
|
||||
Expect.isTrue (n >= 150 && n <= 400) $"{n} actions"
|
||||
let fs = Game.history (Spawn.newGame sample.Seed) sample.Actions
|
||||
let last = List.last fs
|
||||
Expect.isGreaterThanOrEqual last.Score 5 "score"
|
||||
Expect.equal last.Status GameOver "last frame"
|
||||
Expect.equal (List.item (List.length fs - 2) fs).Status Playing "frame before the last")
|
||||
|
||||
testCase "frames replays the recording with history, from the new game of its seed" (fun () ->
|
||||
let recording = { Seed = 42u; Actions = [ Tick; Turn Up; Tick ] }
|
||||
Expect.equal (frames recording) (Game.history (Spawn.newGame 42u) recording.Actions) "frames"
|
||||
Expect.equal (List.length (frames sample)) (List.length sample.Actions + 1) "length")
|
||||
|
||||
testCase "viewerStart is the first frame, not playing" (fun () ->
|
||||
Expect.equal (viewerStart 12) { Index = 0; Last = 12; Playing = false } "viewerStart")
|
||||
|
||||
testCase "viewerUpdate keeps the index in [0, last] whatever the actions" (fun () ->
|
||||
let actions =
|
||||
[ ViewerAction.Prev
|
||||
ViewerAction.Next
|
||||
ViewerAction.Last
|
||||
ViewerAction.Next
|
||||
ViewerAction.TogglePlay
|
||||
ViewerAction.Beat
|
||||
ViewerAction.Beat
|
||||
ViewerAction.First
|
||||
ViewerAction.Prev
|
||||
ViewerAction.Beat ]
|
||||
|
||||
let viewers = List.scan viewerUpdate (viewerStart 3) actions
|
||||
|
||||
Expect.all
|
||||
viewers
|
||||
(fun v -> v.Index >= 0 && v.Index <= 3 && not (v.Playing && v.Index = 3))
|
||||
"in range, never playing at the end")
|
||||
|
||||
testCase "the autoplay clock beats every 100 ms" (fun () -> Expect.equal REPLAY_MS 100L "REPLAY_MS")
|
||||
|
||||
testCase "replayActions turns the clock into Beats and keys into viewer actions" (fun () ->
|
||||
Expect.equal
|
||||
(run [ Time 100L; KeyDown "ArrowRight"; KeyDown "x"; KeyDown " "; Time 300L ] replayActions)
|
||||
[ ViewerAction.Beat
|
||||
ViewerAction.Next
|
||||
ViewerAction.TogglePlay
|
||||
ViewerAction.Beat
|
||||
ViewerAction.Beat ]
|
||||
"actions")
|
||||
|
||||
testCase "autoplay: Space, then the clock steps one frame per 100 ms and stops at the end" (fun () ->
|
||||
let out =
|
||||
viewerStates 3 replayActions
|
||||
|> run [ Time 0L; KeyDown " "; Time 100L; Time 200L; Time 300L; Time 400L; Time 500L ]
|
||||
|
||||
Expect.equal (out |> List.map (fun v -> v.Index)) [ 0; 0; 1; 2; 3; 3; 3 ] "indices"
|
||||
|
||||
Expect.equal
|
||||
(out |> List.map (fun v -> v.Playing))
|
||||
[ false; true; true; true; false; false; false ]
|
||||
"playing")
|
||||
|
||||
testCase "without Space nothing plays: the clock alone never moves the viewer" (fun () ->
|
||||
Expect.all
|
||||
(viewerStates 3 replayActions |> run [ Time 0L; Time 1000L; Time 2000L ])
|
||||
(fun v -> v.Index = 0)
|
||||
"index 0")
|
||||
|
||||
testCase "replayMain asks for nothing and draws the first frame of the recording first" (fun () ->
|
||||
let traced = IO.trace 0u (replayMain sample)
|
||||
Expect.equal traced.Ops [] "ops"
|
||||
let drawings, _ = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (List.length drawings) 1 "one drawing"
|
||||
|
||||
Expect.equal
|
||||
(drawn (List.head drawings))
|
||||
(viewerView (frames sample) (viewerStart (List.length sample.Actions)))
|
||||
"first scene"
|
||||
|
||||
let start = View.view (Spawn.newGame sample.Seed)
|
||||
|
||||
Expect.equal
|
||||
(drawn (List.head drawings) |> List.truncate (List.length start))
|
||||
start
|
||||
"the game's own view first")
|
||||
|
||||
testCase "replayMain: End shows the last frame of the game, the game over" (fun () ->
|
||||
let out = (IO.trace 0u (replayMain sample)).Result |> run [ Time 0L; KeyDown "End" ]
|
||||
let fs = frames sample
|
||||
let last = List.length fs - 1
|
||||
let scene = drawn (List.last out)
|
||||
Expect.equal scene (viewerView fs { Index = last; Last = last; Playing = false }) "last scene"
|
||||
|
||||
Expect.exists
|
||||
scene
|
||||
(fun s ->
|
||||
match s with
|
||||
| Text(_, _, "Game Over", _, _, _) -> true
|
||||
| _ -> false)
|
||||
"Game Over")
|
||||
|
||||
testCase "stepping back shows exactly the earlier scene" (fun () ->
|
||||
let out =
|
||||
(IO.trace 0u (replayMain sample)).Result
|
||||
|> run
|
||||
[ Time 0L
|
||||
KeyDown "ArrowRight"
|
||||
KeyDown "ArrowRight"
|
||||
KeyDown "ArrowRight"
|
||||
KeyDown "ArrowLeft"
|
||||
KeyDown "d"
|
||||
KeyDown "a"
|
||||
KeyDown "a" ]
|
||||
|
||||
let scenes = List.map drawn out
|
||||
Expect.equal scenes[4] scenes[2] "back one"
|
||||
Expect.equal scenes[6] scenes[4] "forward and back"
|
||||
Expect.equal scenes[7] scenes[1] "back to frame 1"
|
||||
Expect.notEqual scenes[3] scenes[2] "frames differ")
|
||||
|
||||
testCase "replayMain: after ten seconds in a background tab autoplay moves 2 frames (250 ms), not 100" (fun () ->
|
||||
let _, afterPlay = Stream.step (KeyDown " ") (IO.trace 0u (replayMain sample)).Result
|
||||
let _, afterFirst = Stream.step (Time 0L) afterPlay
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 2 "two drawings") ]
|
||||
]
|
||||
@@ -134,6 +134,10 @@ let tests =
|
||||
Expect.equal (out |> List.map (fun s -> s.Held.Up)) [ false; false; true; true ] "held up"
|
||||
Expect.equal out[3].Player 20 "player moved up")
|
||||
|
||||
testCase "pongMain: after ten seconds in a background tab the match advances by 250 ms, not by ten seconds" (fun () ->
|
||||
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (pongMain ())).Result
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 8 "eight drawings")
|
||||
|
||||
testCase "pongMain asks for a seed, draws the new match first, and then the updated one" (fun () ->
|
||||
let traced = IO.trace 42u (pongMain ())
|
||||
Expect.equal traced.Ops [ IO.RandomSeed ] "ops"
|
||||
|
||||
@@ -0,0 +1,442 @@
|
||||
module Snake.Tests.M12Check
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Check
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
// ---- helpers for moveGaps: a state whose snake has its head at (x, y); nothing else matters there
|
||||
|
||||
let private at (x: int) (y: int) : GameState =
|
||||
{ Width = 20
|
||||
Height = 20
|
||||
Snake = [ { X = x; Y = y }; { X = x - 1; Y = y } ]
|
||||
Dir = Right
|
||||
NextDir = Right
|
||||
Apple = None
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
|
||||
// ---- the payoff: properties of the game, and deliberately broken games ("mutants") that they must catch
|
||||
|
||||
// Every state of the game played with `upd` from `start`. (For the real `Game.update` this is `Game.history`.)
|
||||
let private statesWith (upd: GameState -> Action -> GameState) (start: GameState) (actions: Action list) : GameState list =
|
||||
List.scan upd start actions
|
||||
|
||||
let private sane (upd: GameState -> Action -> GameState) (actions: Action list) : bool =
|
||||
statesWith upd (Spawn.newGame 1u) actions |> List.forall (fun s -> List.isEmpty (violations s))
|
||||
|
||||
// Mutant 1: `turn` checks against NextDir instead of Dir (version A of Puzzle 2 in Module 3).
|
||||
let private turnAgainstNextDir (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Turn dir -> if state.Status = Playing && dir <> opposite state.NextDir then { state with NextDir = dir } else state
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 2: `advance` forgets to check the walls.
|
||||
let private advanceWithoutWalls (state: GameState) : GameState =
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let head = Rules.move (List.head state.Snake) state.NextDir
|
||||
let eating = state.Apple = Some head
|
||||
let body = if eating then state.Snake else Util.dropLast state.Snake
|
||||
|
||||
if Util.contains body head (=) then
|
||||
{ state with Dir = state.NextDir; Status = GameOver }
|
||||
else
|
||||
{ state with
|
||||
Snake = head :: body
|
||||
Dir = state.NextDir
|
||||
Apple = if eating then None else state.Apple
|
||||
Score = state.Score + (if eating then 1 else 0) }
|
||||
|
||||
// What `update` does after a step since Exercise 10.6: take the queued turn. The mutants below that replace `Tick`
|
||||
// do the same, so that each one differs from the real game in exactly one thing.
|
||||
let private takeQueued (s: GameState) : GameState =
|
||||
match s.Queued with
|
||||
| Some d when s.Status = Playing -> { s with NextDir = d; Queued = None }
|
||||
| _ -> s
|
||||
|
||||
let private noWalls (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Tick -> takeQueued (Spawn.spawnApple (advanceWithoutWalls state))
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 4: a `Tick` that forgets the turn queue of Exercise 10.6 (the `Frame` step still takes it).
|
||||
let private tickForgetsQueue (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Tick -> Spawn.tick state
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 5: the queue accepts any key that differs from the pending turn, even the one straight back from it.
|
||||
let private queueAnyKey (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Turn dir when state.Status = Playing && state.NextDir <> state.Dir && dir <> state.NextDir ->
|
||||
{ state with Queued = Some dir }
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 3: the frame rule this course used at first: step whenever the *total* frame count is a multiple of movesEvery.
|
||||
let private totalFrameCount (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Frame ->
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let counted = { state with Frame = state.Frame + 1 }
|
||||
if counted.Frame % Game.movesEvery counted.Score = 0 then Spawn.tick counted else counted
|
||||
| _ -> Game.update state action
|
||||
|
||||
// A long corridor: the snake is one step from its third apple (score 2 -> 3, so the speed changes), `frame` frames into the game.
|
||||
let private corridor (frame: int) : GameState =
|
||||
{ Width = 60
|
||||
Height = 1
|
||||
Snake = [ { X = 1; Y = 0 }; { X = 0; Y = 0 } ]
|
||||
Dir = Right
|
||||
NextDir = Right
|
||||
Apple = Some { X = 2; Y = 0 }
|
||||
Seed = 0u
|
||||
Score = 2
|
||||
Status = Playing
|
||||
Frame = frame
|
||||
Queued = None }
|
||||
|
||||
let private frames = List.replicate 40 Frame
|
||||
|
||||
// Every gap between two moves is exactly `movesEvery` of the score the snake had after the first of the two.
|
||||
let private steady (upd: GameState -> Action -> GameState) (frame: int) : bool =
|
||||
let states = statesWith upd (corridor frame) frames
|
||||
|
||||
let scoreAtMove =
|
||||
states
|
||||
|> List.pairwise
|
||||
|> List.filter (fun (before, after) -> List.head after.Snake <> List.head before.Snake)
|
||||
|> List.map (fun (_, after) -> after.Score)
|
||||
|
||||
let gaps = moveGaps states
|
||||
List.forall2 (fun gap score -> gap = Game.movesEvery score) gaps (List.truncate (List.length gaps) scoreAtMove)
|
||||
|
||||
// ---- random states and the oracle
|
||||
|
||||
let private connected (snake: Point list) : bool =
|
||||
snake |> List.pairwise |> List.forall (fun (a, b) -> abs (a.X - b.X) + abs (a.Y - b.Y) = 1)
|
||||
|
||||
let private board (width: int) (height: int) : GameState = { at 0 0 with Width = width; Height = height }
|
||||
|
||||
// Mutant 6: Puzzle 1 of Module 3, "the new head must not be on the old snake" (it forgets that the tail moves away).
|
||||
let private advanceOldSnakeCheck (state: GameState) : GameState =
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let head = Rules.move (List.head state.Snake) state.NextDir
|
||||
let eating = state.Apple = Some head
|
||||
let body = if eating then state.Snake else Util.dropLast state.Snake
|
||||
|
||||
if not (Rules.inBounds state head) || Util.contains state.Snake head (=) then
|
||||
{ state with Dir = state.NextDir; Status = GameOver }
|
||||
else
|
||||
{ state with
|
||||
Snake = head :: body
|
||||
Dir = state.NextDir
|
||||
Apple = if eating then None else state.Apple
|
||||
Score = state.Score + (if eating then 1 else 0) }
|
||||
|
||||
let private pt (x: int) (y: int) : Point = { X = x; Y = y }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M12 Check" [
|
||||
// ---- generators
|
||||
|
||||
testCase "elementOf picks the element at the index drawn by intBelow" (fun () ->
|
||||
let xs = [ "a"; "b"; "c"; "d"; "e" ]
|
||||
let i, seed = Random.run 0u (Random.intBelow 5)
|
||||
Expect.equal (Random.run 0u (elementOf xs)) (xs[i], seed) "elementOf")
|
||||
|
||||
testCase "elementOf of a one-element list always gives that element, and still uses up a draw" (fun () ->
|
||||
Expect.equal (Random.run 0u (elementOf [ "only" ])) ("only", 1831565813u) "elementOf")
|
||||
|
||||
testCase "listOf 0 gen is the empty list and leaves the seed alone" (fun () ->
|
||||
Expect.equal (Random.run 99u (listOf 0 Random.nextUint32)) ([], 99u) "listOf 0")
|
||||
|
||||
testCase "listOf threads the seed from each draw to the next" (fun () ->
|
||||
Expect.equal
|
||||
(Random.run 0u (listOf 3 Random.nextUint32))
|
||||
([ 1144304738u; 1416247u; 958946056u ], 1199730143u)
|
||||
"listOf 3")
|
||||
|
||||
testCase "listOf of a constant generator repeats the value and leaves the seed alone" (fun () ->
|
||||
Expect.equal (Random.run 7u (listOf 4 (Random.pure "x"))) ([ "x"; "x"; "x"; "x" ], 7u) "listOf pure")
|
||||
|
||||
testCase "genActions n gives n actions, the same ones for the same seed" (fun () ->
|
||||
let actions, _ = Random.run 5u (genActions 30)
|
||||
Expect.equal (List.length actions) 30 "length"
|
||||
|
||||
Expect.all
|
||||
actions
|
||||
(fun a ->
|
||||
match a with
|
||||
| Tick
|
||||
| Turn _ -> true
|
||||
| TogglePause
|
||||
| Restart
|
||||
| Frame -> false)
|
||||
"only Tick and Turn"
|
||||
|
||||
Expect.equal (Random.run 5u (genActions 30)) (Random.run 5u (genActions 30)) "same seed, same actions")
|
||||
|
||||
// ---- forAll
|
||||
|
||||
testCase "forAll reports success with the number of runs" (fun () ->
|
||||
Expect.equal (forAll 200 1u (fun x -> x >= 0 && x < 10) (Random.intBelow 10)) (Passed 200) "forAll")
|
||||
|
||||
testCase "forAll with zero runs succeeds without drawing anything" (fun () ->
|
||||
Expect.equal (forAll 0 1u (fun _ -> false) Random.nextUint32) (Passed 0) "forAll")
|
||||
|
||||
testCase "forAll reports the first failing draw, its value and the seed it started from" (fun () ->
|
||||
let gen = Random.intBelow 10
|
||||
let prop x = x <> 7
|
||||
let draws, _ = Random.run 3u (listOf 200 gen)
|
||||
let first = draws |> List.findIndex (fun x -> not (prop x))
|
||||
Expect.isGreaterThan first 0 "the test needs a failure that is not the very first draw"
|
||||
|
||||
match forAll 200 3u prop gen with
|
||||
| Failed(run, seed, value) ->
|
||||
Expect.equal (run, value) (first, 7) "run and value"
|
||||
Expect.equal (fst (Random.run seed gen)) 7 "the reported seed gives the value again"
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}")
|
||||
|
||||
testCase "forAll stops at the first failure: the property is not asked about later values" (fun () ->
|
||||
let gen = Random.intBelow 10
|
||||
let draws, _ = Random.run 3u (listOf 200 gen)
|
||||
let first = draws |> List.findIndex (fun x -> x = 7)
|
||||
let mutable calls = 0 // test code may count; the code under test may not
|
||||
|
||||
let result =
|
||||
forAll
|
||||
200
|
||||
3u
|
||||
(fun x ->
|
||||
calls <- calls + 1
|
||||
x <> 7)
|
||||
gen
|
||||
|
||||
match result with
|
||||
| Failed(run, _, _) -> Expect.equal run first "run"
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
|
||||
Expect.equal calls (first + 1) "calls")
|
||||
|
||||
testCase "forAll is reproducible: same generator, property, runs and seed give the same report" (fun () ->
|
||||
let check () = forAll 500 11u (fun x -> x % 97 <> 0) (Random.intBelow 1000)
|
||||
Expect.equal (check ()) (check ()) "same report")
|
||||
|
||||
testCase "forAll runs in constant stack: a million runs do not overflow it" (fun () ->
|
||||
Expect.equal (forAll 1000000 1u (fun x -> x < 10) (Random.intBelow 10)) (Passed 1000000) "forAll")
|
||||
|
||||
// ---- shrinking
|
||||
|
||||
testCase "removals lists every way to drop one element, in order" (fun () ->
|
||||
Expect.equal (removals [ 1; 2; 3 ]) [ [ 2; 3 ]; [ 1; 3 ]; [ 1; 2 ] ] "removals")
|
||||
|
||||
testCase "removals of an empty list is empty, and of a single element is one empty list" (fun () ->
|
||||
Expect.equal (removals ([]: int list)) [] "empty"
|
||||
Expect.equal (removals [ "a" ]) [ [] ] "single")
|
||||
|
||||
testCase "minimize keeps exactly the elements the failure needs" (fun () ->
|
||||
Expect.equal
|
||||
(minimize (fun xs -> List.contains 3 xs && List.contains 7 xs) [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ])
|
||||
[ 3; 7 ]
|
||||
"minimize")
|
||||
|
||||
testCase "minimize keeps the order and the duplicates the failure needs" (fun () ->
|
||||
Expect.equal
|
||||
(minimize
|
||||
(fun xs -> (xs |> List.filter (fun x -> x = "a") |> List.length) >= 2 && List.contains "c" xs)
|
||||
[ "b"; "a"; "c"; "a"; "d"; "a" ])
|
||||
[ "c"; "a"; "a" ]
|
||||
"minimize")
|
||||
|
||||
testCase "minimize of a list that fails whatever you remove is the empty list" (fun () ->
|
||||
Expect.equal (minimize (fun _ -> true) [ 1; 2; 3 ]) [] "minimize")
|
||||
|
||||
testCase "minimize returns a list that still fails and has no failing removal (1-minimal)" (fun () ->
|
||||
let fails (xs: int list) = List.sum xs >= 10
|
||||
let small = minimize fails [ 5; 1; 4; 2; 6; 3 ]
|
||||
Expect.isTrue (fails small) "still fails"
|
||||
Expect.all (removals small) (fun ys -> not (fails ys)) "no failing removal")
|
||||
|
||||
// ---- invariants
|
||||
|
||||
yield! fixtureTests "m12-violations" "violations" (fun c ->
|
||||
Expect.equal (violations (gameState (arg 0 c))) (list str (expected c)) "violations")
|
||||
|
||||
// ---- moveGaps
|
||||
|
||||
testCase "moveGaps measures the distance between consecutive moves of the head" (fun () ->
|
||||
Expect.equal
|
||||
(moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0; at 2 0; at 3 0; at 3 1 ])
|
||||
[ 3; 1 ]
|
||||
"moveGaps")
|
||||
|
||||
testCase "moveGaps of fewer than two moves is empty" (fun () ->
|
||||
Expect.equal (moveGaps []) [] "no states"
|
||||
Expect.equal (moveGaps [ at 1 0 ]) [] "one state"
|
||||
Expect.equal (moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0 ]) [] "one move")
|
||||
|
||||
testCase "moveGaps counts a move at index 1" (fun () ->
|
||||
Expect.equal (moveGaps [ at 1 0; at 2 0; at 2 0; at 3 0 ]) [ 2 ] "moveGaps")
|
||||
|
||||
testCase "moveGaps treats an empty snake as a head of its own" (fun () ->
|
||||
let snake (cells: Point list) = { at 1 0 with Snake = cells }
|
||||
|
||||
Expect.equal
|
||||
(moveGaps [ snake []; snake []; snake [ { X = 1; Y = 0 } ]; snake [ { X = 1; Y = 0 } ]; snake [ { X = 2; Y = 0 } ] ])
|
||||
[ 2 ]
|
||||
"moveGaps")
|
||||
|
||||
// ---- properties of the game, and the mutants
|
||||
|
||||
testCase "statesWith Game.update in these tests is the history of Module 5" (fun () ->
|
||||
let actions, _ = Random.run 9u (genActions 25)
|
||||
Expect.equal (statesWith Game.update (Spawn.newGame 1u) actions) (Game.history (Spawn.newGame 1u) actions) "history")
|
||||
|
||||
testCase "the real game keeps every invariant on 300 random games of 40 actions" (fun () ->
|
||||
Expect.equal (forAll 300 2024u (sane Game.update) (genActions 40)) (Passed 300) "forAll")
|
||||
|
||||
testCase "the quick double turn bug is found and shrunk to its two key presses" (fun () ->
|
||||
let prop = sane turnAgainstNextDir
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
match minimize (fun actions -> not (prop actions)) value with
|
||||
| [ Turn first; Turn second ] ->
|
||||
Expect.contains [ Up; Down ] first "first turn"
|
||||
Expect.equal second Left "second turn"
|
||||
| small -> failtest $"expected two turns, got %A{small}")
|
||||
|
||||
testCase "a game without walls is found and shrunk to the shortest way off the board: ten ticks" (fun () ->
|
||||
let prop = sane noWalls
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
Expect.equal (minimize (fun actions -> not (prop actions)) value) (List.replicate 10 Tick) "ten ticks")
|
||||
|
||||
testCase "a Tick that forgets the queued turn is caught by queued-not-reversed and shrunk to four actions" (fun () ->
|
||||
let prop = sane tickForgetsQueue
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
Expect.equal
|
||||
(minimize (fun actions -> not (prop actions)) value)
|
||||
[ Turn Up; Turn Right; Tick; Turn Left ]
|
||||
"four actions")
|
||||
|
||||
testCase "a queue that accepts a reversal is found and shrunk to its two key presses" (fun () ->
|
||||
let prop = sane queueAnyKey
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
Expect.equal (minimize (fun actions -> not (prop actions)) value) [ Turn Up; Turn Down ] "two key presses")
|
||||
|
||||
testCase "the real game moves exactly every movesEvery score frames, also across a speed-up" (fun () ->
|
||||
Expect.equal (forAll 100 7u (steady Game.update) (Random.intBelow 8)) (Passed 100) "forAll")
|
||||
|
||||
testCase "counting frames from the start of the game makes some steps too short, and the property finds one" (fun () ->
|
||||
match forAll 100 7u (steady totalFrameCount) (Random.intBelow 56) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) -> Expect.isFalse (steady totalFrameCount value) "the counterexample fails")
|
||||
|
||||
// ---- random states (Exercise 12.6)
|
||||
|
||||
testCase "genSnake draws the head first, then walks from the tail (seed 0, 5x5, at most 6 cells)" (fun () ->
|
||||
Expect.equal
|
||||
(Random.run 0u (genSnake 5 5 6))
|
||||
([ pt 3 2; pt 3 1; pt 3 0; pt 2 0; pt 1 0; pt 0 0 ], 4231026099u)
|
||||
"genSnake")
|
||||
|
||||
testCase "genSnake is pinned for a few more seeds" (fun () ->
|
||||
Expect.equal
|
||||
(fst (Random.run 1u (genSnake 5 5 6)))
|
||||
[ pt 2 3; pt 3 3; pt 4 3; pt 4 4; pt 3 4; pt 2 4 ]
|
||||
"seed 1"
|
||||
|
||||
Expect.equal
|
||||
(fst (Random.run 42u (genSnake 5 5 6)))
|
||||
[ pt 1 0; pt 1 1; pt 2 1; pt 2 0; pt 3 0; pt 3 1 ]
|
||||
"seed 42")
|
||||
|
||||
testCase "genSnake with maxLen 1 is just the head, drawn with two draws" (fun () ->
|
||||
let x, s1 = Random.run 0u (Random.intBelow 5)
|
||||
let y, s2 = Random.run s1 (Random.intBelow 5)
|
||||
Expect.equal (Random.run 0u (genSnake 5 5 1)) ([ pt x y ], s2) "genSnake")
|
||||
|
||||
testCase "genSnake stops early when the walk is stuck: a 1x1 board holds one cell" (fun () ->
|
||||
Expect.equal (fst (Random.run 3u (genSnake 1 1 5))) [ pt 0 0 ] "genSnake")
|
||||
|
||||
testCase "genSnake always gives a snake on the board, connected, without overlap, at most maxLen long" (fun () ->
|
||||
let ok (snake: Point list) =
|
||||
List.length snake >= 1
|
||||
&& List.length snake <= 8
|
||||
&& connected snake
|
||||
&& List.forall (Rules.inBounds (board 4 3)) snake
|
||||
&& List.length (List.distinct snake) = List.length snake
|
||||
|
||||
Expect.equal (forAll 300 5u ok (genSnake 4 3 8)) (Passed 300) "forAll")
|
||||
|
||||
testCase "every generated state is sane: 500 states of a 5x5 board have no violations" (fun () ->
|
||||
Expect.equal (forAll 500 2024u (fun s -> List.isEmpty (violations s)) (genState 5 5)) (Passed 500) "forAll")
|
||||
|
||||
testCase "generated states are Playing, have nothing queued, and vary in length and apple" (fun () ->
|
||||
let states, _ = Random.run 2024u (listOf 500 (genState 5 5))
|
||||
Expect.all states (fun s -> s.Status = Playing && s.Queued = None && s.Width = 5 && s.Height = 5) "shape"
|
||||
|
||||
Expect.all
|
||||
states
|
||||
(fun s ->
|
||||
match s.Snake with
|
||||
| [ _ ] -> s.Dir = Right
|
||||
| head :: second :: _ -> Rules.move second s.Dir = head
|
||||
| [] -> false)
|
||||
"dir"
|
||||
|
||||
Expect.exists states (fun s -> List.length s.Snake = 1) "a one-cell snake"
|
||||
Expect.exists states (fun s -> List.length s.Snake >= 10) "a long snake"
|
||||
Expect.exists states (fun s -> s.Apple = None) "no apple"
|
||||
Expect.exists states (fun s -> s.Apple <> None) "an apple"
|
||||
Expect.exists states (fun s -> s.NextDir <> s.Dir) "a pending turn")
|
||||
|
||||
testCase "generated states start with seed 0, score 0 and frame 0" (fun () ->
|
||||
let states, _ = Random.run 2024u (listOf 50 (genState 5 5))
|
||||
Expect.all states (fun s -> s.Seed = 0u && s.Score = 0 && s.Frame = 0) "seed, score and frame")
|
||||
|
||||
// ---- a second implementation as an oracle (Exercise 12.7)
|
||||
|
||||
yield! fixtureTests "m03-advance" "advanceSpec agrees with Module 3's advance fixture" (fun c ->
|
||||
Expect.equal (advanceSpec (gameState (arg 0 c))) (gameState (expected c)) "advanceSpec")
|
||||
|
||||
testCase "advance and advanceSpec agree on 500 generated states of a 5x5 board" (fun () ->
|
||||
Expect.equal (forAll 500 2024u (fun s -> Rules.advance s = advanceSpec s) (genState 5 5)) (Passed 500) "forAll")
|
||||
|
||||
testCase "no invariant sees the wrong collision check of Puzzle 1: every state it produces is sane" (fun () ->
|
||||
Expect.equal
|
||||
(forAll 500 2024u (fun s -> List.isEmpty (violations (advanceOldSnakeCheck s))) (genState 5 5))
|
||||
(Passed 500)
|
||||
"forAll")
|
||||
|
||||
testCase "comparing with advanceSpec catches the wrong collision check: the head was moving onto the tail" (fun () ->
|
||||
match forAll 500 2024u (fun s -> advanceOldSnakeCheck s = advanceSpec s) (genState 5 5) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(run, _, s) ->
|
||||
Expect.equal run 21 "run"
|
||||
Expect.equal (Rules.move (List.head s.Snake) s.NextDir) (List.last s.Snake) "onto the tail"
|
||||
Expect.equal (advanceOldSnakeCheck s).Status GameOver "the mutant ends the game"
|
||||
Expect.equal (advanceSpec s).Status Playing "the rules do not")
|
||||
]
|
||||
@@ -0,0 +1,268 @@
|
||||
module Snake.Tests.M13Life
|
||||
|
||||
open System.Diagnostics
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Stream
|
||||
open Snake.Life.Model
|
||||
open Snake.Life.Rules
|
||||
open Snake.Life.View
|
||||
open Snake.Life.App
|
||||
open Snake.Tests.Fixtures
|
||||
open Snake.Tests.M09Helpers
|
||||
open Snake.Tests.M09Runtime
|
||||
|
||||
let private lifeState (v: JsonElement) : LifeState =
|
||||
{ Cells = list point (prop "cells" v)
|
||||
Running = bool (prop "running" v)
|
||||
Seed = u32 (prop "seed" v)
|
||||
Generation = num (prop "generation" v) }
|
||||
|
||||
let private lifeAction (v: JsonElement) : LifeAction =
|
||||
match str (prop "tag" v) with
|
||||
| "Frame" -> LifeAction.Frame
|
||||
| "Toggle" -> LifeAction.Toggle(point (prop "cell" v))
|
||||
| "TogglePause" -> LifeAction.TogglePause
|
||||
| "Step" -> LifeAction.Step
|
||||
| "Clear" -> LifeAction.Clear
|
||||
| "Randomize" -> LifeAction.Randomize
|
||||
| other -> failwith $"unknown life action tag: {other}"
|
||||
|
||||
let private cell (x: int) (y: int) : Point = { X = x; Y = y }
|
||||
|
||||
let private rowMajor (cells: Point list) : bool =
|
||||
cells |> List.pairwise |> List.forall (fun (a, b) -> a.Y < b.Y || (a.Y = b.Y && a.X < b.X))
|
||||
|
||||
// n generations after `cells`, the start included: n + 1 boards.
|
||||
let private generations (n: int) (cells: Point list) : Point list list =
|
||||
List.scan (fun cs _ -> lifeStep cs) cells [ 1..n ]
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M13 Life" [
|
||||
yield! fixtureTests "m13-life-step" "lifeStep" (fun c ->
|
||||
Expect.equal (lifeStep (list point (arg 0 c))) (list point (expected c)) "lifeStep")
|
||||
|
||||
yield! fixtureTests "m13-life-update" "lifeUpdate" (fun c ->
|
||||
Expect.equal (lifeUpdate (lifeState (arg 0 c)) (lifeAction (arg 1 c))) (lifeState (expected c)) "lifeUpdate")
|
||||
|
||||
yield! fixtureTests "m13-life-view" "lifeView" (fun c ->
|
||||
Expect.equal (lifeView (lifeState (arg 0 c))) (list shape (expected c)) "lifeView")
|
||||
|
||||
yield! fixtureTests "m13-life-key" "lifeKey" (fun c ->
|
||||
Expect.equal (lifeKey (str (arg 0 c))) (opt lifeAction (expected c)) "lifeKey")
|
||||
|
||||
yield! fixtureTests "m13-life-click" "lifeClick" (fun c ->
|
||||
Expect.equal (lifeClick (num (arg 0 c)) (num (arg 1 c))) (opt lifeAction (expected c)) "lifeClick")
|
||||
|
||||
yield!
|
||||
[ // ---- the model and the rules
|
||||
|
||||
testCase "the board is 40 by 30 cells of 16 pixels, with a 24-pixel status strip below" (fun () ->
|
||||
Expect.equal [ LW; LH; LCELL; STRIP ] [ 40; 30; 16; 24 ] "constants")
|
||||
|
||||
testCase "initialLife is an empty, paused world at generation 0 with the given seed" (fun () ->
|
||||
Expect.equal
|
||||
(initialLife 9u)
|
||||
{ Cells = []
|
||||
Running = false
|
||||
Seed = 9u
|
||||
Generation = 0 }
|
||||
"initialLife")
|
||||
|
||||
testCase "lifeUpdate does not modify the state it is given" (fun () ->
|
||||
let make () =
|
||||
{ Cells = [ cell 4 5; cell 5 5; cell 6 5 ]
|
||||
Running = true
|
||||
Seed = 3u
|
||||
Generation = 0 }
|
||||
|
||||
let s = make ()
|
||||
|
||||
[ LifeAction.Frame
|
||||
LifeAction.Toggle(cell 0 0)
|
||||
LifeAction.Toggle(cell 5 5)
|
||||
LifeAction.Randomize
|
||||
LifeAction.Clear ]
|
||||
|> List.iter (fun a -> lifeUpdate s a |> ignore)
|
||||
|
||||
Expect.equal s (make ()) "unchanged")
|
||||
|
||||
testCase "a glider moves one cell diagonally every four generations" (fun () ->
|
||||
let glider = [ cell 1 0; cell 2 1; cell 0 2; cell 1 2; cell 2 2 ]
|
||||
|
||||
Expect.equal
|
||||
(List.last (generations 4 glider))
|
||||
[ cell 2 1; cell 3 2; cell 1 3; cell 2 3; cell 3 3 ]
|
||||
"after four generations")
|
||||
|
||||
testCase "the next generation is computed from the whole old board: a blinker blinks forever" (fun () ->
|
||||
let horizontal = [ cell 9 10; cell 10 10; cell 11 10 ]
|
||||
let gens = generations 6 horizontal
|
||||
Expect.equal gens[2] horizontal "two generations"
|
||||
Expect.equal gens[6] horizontal "six generations"
|
||||
Expect.equal gens[1] [ cell 10 9; cell 10 10; cell 10 11 ] "vertical in between")
|
||||
|
||||
testCase "Randomize draws one intBelow 4 per cell in row-major order, alive when the draw is 0" (fun () ->
|
||||
let seed = 2024u
|
||||
|
||||
// The same draws, written the long way round with the Module 4 generator.
|
||||
let draws, next =
|
||||
List.fold
|
||||
(fun (ds, s) _ ->
|
||||
let d, s2 = Random.run s (Random.intBelow 4)
|
||||
ds @ [ d ], s2)
|
||||
([], seed)
|
||||
[ 1 .. LW * LH ]
|
||||
|
||||
let expectedCells =
|
||||
draws
|
||||
|> List.indexed
|
||||
|> List.choose (fun (i, d) -> if d = 0 then Some(cell (i % LW) (i / LW)) else None)
|
||||
|
||||
let result = lifeUpdate (initialLife seed) LifeAction.Randomize
|
||||
Expect.equal result.Cells expectedCells "cells"
|
||||
Expect.equal result.Seed next "seed"
|
||||
let n = List.length result.Cells
|
||||
Expect.isTrue (n > 200 && n < 400) $"{n} live cells")
|
||||
|
||||
testCase "every generation of a random board stays sorted row-major, on the board and without duplicates" (fun () ->
|
||||
let start = (lifeUpdate (initialLife 5u) LifeAction.Randomize).Cells
|
||||
|
||||
generations 20 start
|
||||
|> List.iter (fun cells ->
|
||||
Expect.isTrue (rowMajor cells) "sorted row-major, no duplicates"
|
||||
Expect.all cells (fun c -> c.X >= 0 && c.X < LW && c.Y >= 0 && c.Y < LH) "on the board"))
|
||||
|
||||
// Generous on purpose (and more so than in JS, for an unoptimised Debug build): a straightforward
|
||||
// lifeStep takes a few milliseconds per generation. This only catches a generation that is far slower
|
||||
// than the 150 ms between two of them.
|
||||
testCase "lifeStep keeps up: 50 generations of a quarter-full board take well under 50 x 150 ms" (fun () ->
|
||||
let start = (lifeUpdate (initialLife 11u) LifeAction.Randomize).Cells
|
||||
let watch = Stopwatch.StartNew()
|
||||
generations 50 start |> ignore
|
||||
let ms = watch.ElapsedMilliseconds
|
||||
Expect.isLessThan ms 5000L $"{ms} ms")
|
||||
|
||||
// ---- the fourth kind of event
|
||||
|
||||
testCase "clicks emits the position of every Click event and ignores everything else" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.clicks |> Stream.run [ Time 10L; Click(3, 4); KeyDown "a"; Click(0, 479); KeyUp "a" ])
|
||||
[ (3, 4); (0, 479) ]
|
||||
"positions")
|
||||
|
||||
testCase "the other sources ignore clicks" (fun () ->
|
||||
let events = [ Click(5, 5); Time 100L; Click(6, 6) ]
|
||||
Expect.equal (Stream.run events Stream.keyDowns) [] "keyDowns"
|
||||
Expect.equal (Stream.run events Stream.keyUps) [] "keyUps"
|
||||
Expect.equal (Stream.run events (Stream.interval 50L)) [ 50L; 100L ] "interval"
|
||||
|
||||
Expect.equal
|
||||
(Stream.run events (Stream.clampTime 250L Stream.clicks))
|
||||
[ (5, 5); (6, 6) ]
|
||||
"clampTime passes clicks through")
|
||||
|
||||
testCase "a generation every 150 ms" (fun () -> Expect.equal GEN_MS 150L "GEN_MS")
|
||||
|
||||
testCase "lifeActions turns the clock into Frames, keys into actions and clicks on the board into Toggles" (fun () ->
|
||||
Expect.equal
|
||||
(lifeActions
|
||||
|> Stream.run
|
||||
[ Time 150L; KeyDown " "; Click(20, 40); KeyDown "x"; Click(700, 10); KeyDown "n"; Time 450L ])
|
||||
[ LifeAction.Frame
|
||||
LifeAction.TogglePause
|
||||
LifeAction.Toggle(cell 1 2)
|
||||
LifeAction.Step
|
||||
LifeAction.Frame
|
||||
LifeAction.Frame ]
|
||||
"actions")
|
||||
|
||||
testCase "lifeStates starts with the new world, then yields one state per action" (fun () ->
|
||||
let out =
|
||||
lifeStates 7u lifeActions
|
||||
|> Stream.run [ Time 0L; Click(16, 16); Click(32, 16); Click(48, 16); KeyDown " "; Time 150L ]
|
||||
|
||||
Expect.equal (List.head out) (initialLife 7u) "first state"
|
||||
Expect.equal (out |> List.map (fun s -> List.length s.Cells)) [ 0; 1; 2; 3; 3; 3 ] "live cells"
|
||||
|
||||
Expect.equal
|
||||
(List.last out)
|
||||
{ Cells = [ cell 2 0; cell 2 1; cell 2 2 ]
|
||||
Running = true
|
||||
Seed = 7u
|
||||
Generation = 1 }
|
||||
"last state")
|
||||
|
||||
testCase "lifeMain asks for a seed, draws the empty world first, and then a click as a live cell" (fun () ->
|
||||
let traced = IO.trace 42u (lifeMain ())
|
||||
Expect.equal traced.Ops [ IO.RandomSeed ] "ops"
|
||||
let first, next = Stream.step (Time 0L) traced.Result
|
||||
let second, _ = Stream.step (Click(17, 33)) next
|
||||
Expect.equal (drawn (List.head first)) (lifeView (initialLife 42u)) "first drawing"
|
||||
|
||||
Expect.equal
|
||||
(drawn (List.head second))
|
||||
(lifeView { initialLife 42u with Cells = [ cell 1 2 ] })
|
||||
"second drawing")
|
||||
|
||||
testCase "lifeMain: after ten seconds in a background tab the world advances by 250 ms, not by ten seconds" (fun () ->
|
||||
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (lifeMain ())).Result
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 1 "one drawing")
|
||||
|
||||
// ---- the runtime (step 7 of the module); the browser glue in web/ is given
|
||||
|
||||
testCase "runApp registers a click handler with the platform" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
Runtime.runApp p.Platform (IO.pure (Stream.clicks |> Stream.map (fun _ -> IO.pure ())))
|
||||
Expect.equal p.Registered [ "click"; "down"; "time"; "up" ] "registered")
|
||||
|
||||
testCase "runApp feeds clicks to the stream" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
|
||||
let program =
|
||||
IO.pure (Stream.clicks |> Stream.map (fun (x, y) -> IO.draw (View.Rect(x, y, 1, 1, "#ffffff"))))
|
||||
|
||||
Runtime.runApp p.Platform program
|
||||
p.FireClick(33, 47)
|
||||
p.FireClick(0, 2)
|
||||
|
||||
Expect.equal
|
||||
p.Calls
|
||||
[ [ box "fillRect"; box 33; box 47; box 1; box 1; box "#ffffff" ]
|
||||
[ box "fillRect"; box 0; box 2; box 1; box 1; box "#ffffff" ] ]
|
||||
"calls")
|
||||
|
||||
testCase "runApp runs Life: a click on the canvas draws the world with that cell alive" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
Runtime.runApp p.Platform (lifeMain ())
|
||||
p.FireTime 0L
|
||||
p.Clear()
|
||||
p.FireClick(100, 250)
|
||||
|
||||
Expect.contains
|
||||
p.Calls
|
||||
[ box "fillRect"; box (6 * 16 + 1); box (15 * 16 + 1); box 14; box 14; box "#7cb342" ]
|
||||
"the live cell")
|
||||
|
||||
testCase "Snake and Pong ignore clicks: their actions and drawings are the same with and without them" (fun () ->
|
||||
let withClicks = [ Time 0L; Click(5, 5); Time 25L; KeyDown "ArrowUp"; Click(300, 300); Time 200L ]
|
||||
|
||||
let without =
|
||||
withClicks
|
||||
|> List.filter (fun e ->
|
||||
match e with
|
||||
| Click _ -> false
|
||||
| _ -> true)
|
||||
|
||||
Expect.equal (Stream.run withClicks App.speedActions) (Stream.run without App.speedActions) "speedActions"
|
||||
|
||||
Expect.equal
|
||||
(Stream.run withClicks Pong.App.pongActions)
|
||||
(Stream.run without Pong.App.pongActions)
|
||||
"pongActions"
|
||||
|
||||
Expect.equal (App.play 42u withClicks (App.main ())) (App.play 42u without (App.main ())) "play main") ]
|
||||
]
|
||||
@@ -13,16 +13,21 @@
|
||||
<Compile Include="M03Rules.fs" />
|
||||
<Compile Include="M04Random.fs" />
|
||||
<Compile Include="M04Spawn.fs" />
|
||||
<Compile Include="M04State.fs" />
|
||||
<Compile Include="M05Game.fs" />
|
||||
<Compile Include="M06View.fs" />
|
||||
<Compile Include="M07IO.fs" />
|
||||
<Compile Include="M07bSafeIO.fs" />
|
||||
<Compile Include="M08Stream.fs" />
|
||||
<Compile Include="M09Helpers.fs" />
|
||||
<Compile Include="M09Input.fs" />
|
||||
<Compile Include="M09App.fs" />
|
||||
<Compile Include="M09Runtime.fs" />
|
||||
<Compile Include="M10Extensions.fs" />
|
||||
<Compile Include="M10Replay.fs" />
|
||||
<Compile Include="M11Pong.fs" />
|
||||
<Compile Include="M12Check.fs" />
|
||||
<Compile Include="M13Life.fs" />
|
||||
<Compile Include="Purity.fs" />
|
||||
<Compile Include="Main.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
Reference in new issue
Block a user