model-based-testing

test.fsx

#r "netstandard"
#load @"..\.paket\load\netstandard2.0\main.group.fsx"
      @"Step3\Infrastructure3.fs"
      @"Step3\Domain3.fs"
      @"Step3\Program3.fs"
      @"Step3\Tests3.fs"

open Step3.Domain
open Step3.Domain.Projections
open Step3.Program
open FsCheck
open FsCheck.Experimental

/// A simplified model that tracks the stock of all flavours.
type Model = Map<Flavour, int>

/// A wrapper around the real event system.
type RealSystem(initialStock) =
    let mailbox = mailbox()

    do initialStock
        |> Map.toSeq
        |> Seq.iter(fun (flavour, stock) ->  restock flavour stock mailbox)

    /// Restocks flavour by one.
    member __.Restock flavour =
        restock flavour 1 mailbox

        stockOf flavour mailbox

    /// Tries to sell a single flavour instance.
    member __.Sell flavour =
        sellFlavour flavour mailbox

        stockOf flavour mailbox

let spec =
    /// Restocks the flavour by one
    let restock flavour =
        { new Operation<RealSystem, Model>() with
            member __.Run m =
                m |> Map.add flavour (m.[flavour] + 1)
            member __.Check (system, model) =
                let res = system.Restock flavour
                model.[flavour] = res
                |@ sprintf "Restock %A: model = %i, actual = %i" flavour model.[flavour] res
            override __.ToString() = sprintf "restock %A" flavour }

    /// Tries to sell when stock is non-empty
    let sellWhenValid flavour =
        { new Operation<RealSystem,Model>() with
            member __.Run m =
                m |> Map.add flavour (m.[flavour] - 1)
            override __.Pre m =
                m.[flavour] > 0
            member __.Check (system, m) =
                let res = system.Sell flavour
                m.[flavour] = res
                |@ sprintf "Sell %A: model = %i, actual = %i" flavour m.[flavour] res
            override __.ToString() = sprintf "sell %A" flavour }

    /// Tries to sell when stock is empty
    let sellWheninvalid flavour =
        { new Operation<RealSystem,Model>() with
            member __.Run m = m
            override __.Pre m =
                m.[flavour] = 0
            member __.Check (system, m) =
                let res = system.Sell flavour
                m.[flavour] = res
                |@ sprintf "Cant Sell %A: model = %i, actual = %i" flavour m.[flavour] res
            override __.ToString() = sprintf "cantSell %A" flavour }

    /// Creates the initial stock of the system
    let create initialStock =
        { new Setup<RealSystem,Model>() with
            member __.Actual() = RealSystem initialStock
            member __.Model() = initialStock }

    let allFlavours = [ Vanilla; Strawberry ]

    { new Machine<RealSystem,Model>() with
        member __.Setup =
            allFlavours
            |> List.map(fun flavour ->
                Gen.choose (0, 3)
                |> Gen.map(fun stock -> flavour, stock))
            |> Gen.collect id
            |> Gen.map(Map >> create)
            |> Arb.fromGen
        member __.Next _ =
            gen {
                let! operations =
                    allFlavours
                    |> List.map(fun f -> Gen.elements [ restock f; sellWhenValid f; sellWheninvalid f ])
                    |> Gen.collect id
                return! Gen.elements operations
            }
    }

let p = spec |> StateMachine.toProperty

// Check.Quick p
Check.Verbose p