F#: Bombproof Code with Property-based Testing

Datetime:2016-08-22 21:59:40          Topic: Test Engineer  F#           Share

Intro

As I learn F#, I am also learning an alternative technique for proving code. Specifically, I am learning how to abstract away example-based tests into property-based tests. On this journey, I was surprised to realize that despite the unit tests that I wrote to bulletproof my functions, my functions still had bugs in them based on various edge cases that I never considered. Thus, I learned that bullet-proofing my code with example-based cases just wasn’t enough. I needed to bombproof my code!

Bombproof a Function

I relate a suite of unit tests qualifying a function to the metaphor of bulletproofing a vehicle. However, based on my current journey within functional programming, I now relate property-based tests with affiliated unit tests as a technique for bombproofing a function.

A bomb might be viewed as a single unit of force. However, the carnage that results from a bomb is really from the shrapnel that’s projected at high rates of speed in all directions. Thus, the shrapnel generated from the force of a blast behaves like a myriad of bullets without a direction. In other words, bullets are fired typically in one direction at an intended target. Whereas a bomb destroys indiscriminately. For more details, the science of a bomb blast can be found here. As stated earlier, the common result of a bomb blast is collateral damage. Which is essentially damage inflicted on unintended targets. Hmmm… That sounds a lot like buggy code that has cascading effects on a complex system. Even though this analogy is a bit warped, my goal is to provide the software community with an analogy that helped me appreciate the value of property-based testing. In other words, I value property-based testing as tool for protection against the unintended use of a function which could otherwise inflict severe damage to a system.

Defining Response Types

I recently wrote a checkers game in F# so that I can better understand functional concepts for not only building software but also testing it as I build.

Here’s the types that support the Checkers game I wrote:

(* Types *)
type Black = BlackKing | BlackSoldier
type Red =   RedKing   | RedSoldier
 
type Coordinate = int * int
 
type Piece =
    | Black of Black * Coordinat

 
type OptionsResponse =
    | DuplicatesNotAllowed of Space list
    | Succeeded            of Coordinate list
 
type MoveResponse =
    | DuplicatesNotAllowed of Space list * Status
    | MoveNotAllowed       of Space list * Status
    | DestinationNotFound  of Space list * Status
    | Succeeded            of Space list * Status

If you notice in the types defined above, I have defined two Response types. Specifically, I implemented an OptionsResponse and a MoveResponse. The OptionsResponse type is for conveying the move options that a checker has based on its position on the checker board. The MoveResponse type conveys the updated checker board after a move was performed. Note my incomplete description of these two discriminated union types. Hence, what I did not convey in the two types defined above are the values that represent the reasons why a valid result couldn’t be provided. Hence, both discriminated union types have a case value for duplicates being discovered that would ultimately prevent the function from returning a “Succeeded” case value. However, the MoveResponse also defines a MoveNotAllowed as well as a DestinationNotFound case value.

Identifying Case Values for a Response

In the previous section, I identified the response types that would be used as a function result for identifying move options for a checker and moving it. However, those response types did not stem from BUFD (aka: Big Upfront Design) or even TDD (Test-driven Development). No. Those types were flushed out as a result of running Property-based tests.

Property-based Tests

Property-based testing is a technique used to generate a multitude of test scenarios in an effort to prove that a function has certain properties about it. Thus, I view property-based testing as an indirect technique for generating edge cases for the testing of a given function.

Revisiting Checkers

I incorporated property-based testing into the Checkers Kata that I have been working on.

Here’s an example of a property-based test that I wrote:

[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct 
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2

The test above targets the optionsFor function. This function under test has the responsibility of identifying the move options for a given checker. The property test for this function tests that a checker whose type is Soldier can never have more than 2 options for moving.

The optionsFor function is below:

let optionsFor piece positions =
 
    if duplicatesIn positions
    then OptionsResponse.DuplicatesNotAllowed positions
    else match piece |> isKing with
         | false -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForSoldier piece)
                    OptionsResponse.Succeeded options
                    
         | true  -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForKing piece)
                    OptionsResponse.Succeeded options

Notice the following line:

if duplicatesIn positions
    then OptionsResponse.DuplicatesNotAllowed positions

This condition was added into the optionsFor function after my property test for it failed. The test failed because duplicate entries were found in the positions parameter of the function. As I observed this failure, I recognized that I still needed to return a result regardless of invalid arguments being provided. Thus, that’s when I realized that a discriminated union could be leveraged to identify the response types mentioned earlier.

Here are the property tests that I wrote for the checkers game:

open FsCheck
open FsCheck.Xunit
 
type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100000,
        QuietOnSuccess = true)
 
[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct 
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2
     
[<Run100K>]
let ``options for king can never exceed 4`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter isKing
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , Seq.distinct y 
                                 |> Seq.toList)
                 |> Arb.fromGen
                 |> Prop.forAll 
                 <| fun (piece , positions) ->
                         positions |> optionsFor piece
                                   |> fromOptions
                                   |> List.length <= 4
 
[<Run100K>]
let ``moving checker retains distinct element count`` () =
 
    // Setup
    gen { let! piece =          Arb.generate<Piece> 
          let! destination =    Arb.generate<Space>
          let! otherPositions = Arb.generate<Space list> // Used to ensure inclusion of piece & destination
          let! positions =      Occupied piece::destination::otherPositions |> Gen.shuffle
          let! status =         Arb.generate<Status>
          
          return piece , destination , positions
                                       |> Seq.distinct
                                       |> Seq.toList , status 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (piece , destination , positions , status) -> 
           (positions , status) |> move piece destination
                                |> fromMove
                                |> List.length = positions.Length
 
[<Run100K>]
let ``attempted checker jump results in zero or one distinct checkers removed`` () =
 
    // Setup
    gen { let! source =          Arb.generate<Piece>
          let! target =          Arb.generate<Piece>
          let! otherPositions =  Arb.generate<Space list>
          let! positions =       Occupied source :: Occupied target
                                                 :: otherPositions 
                                                 |> Gen.shuffle
 
          let tryAddDistinct (map:Map<Coordinate,Space>) s = 
              match tryGetCoordinate s with
              | Some xy -> match map.TryFind xy with
                           | Some pos -> map
                           | None     -> map.Add(xy,s)
              | None    -> map
 
          let distinct = (Map [], positions |> List.ofArray) 
                                            ||> List.fold tryAddDistinct
                                            |> Map.toList
                                            |> List.map snd
          return source , target , distinct 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (source , target, positions) ->
 
           let gameStatus = positions , statusOf source
 
           (gameStatus , source) ||> jump target
                                  |> fromMove
                                  |> (fun l -> l.Length = positions.Length  ||
                                               l.Length = positions.Length - 1)

The workflow of a Property-based Test

1. Setup

a. Create a generator:

let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
let positionsGenerator = Arb.generate<Space list>

b. Generate a value:

(pieceGenerator , positionsGenerator) 
||> Gen.map2 (fun x y -> x , y |> Seq.distinct // Create a tuple via Gen.map to host our argument types
        |> Seq.toList)

2. Test

a. Use the value to test the function:

|> Arb.fromGen
|> Prop.forAll 
<| fun (piece , positions) ->
        positions |> optionsFor piece

3. Verify

a. Verify the result of the function maintains the expected property:

|> fromOptions
|> List.length <= 2

Here’s the complete test:

open FsCheck
open FsCheck.Xunit
 
type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100000,
        QuietOnSuccess = true)
 
[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct // Create a tuple via Gen.map to host are argument types
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2

Creating Unit Tests from Property-based Tests

As I ran my property-based tests and observed failures, I realized that I needed to investigate why these properties were not being upheld for certain inputs. This resulted in me taking the inputs identified from the failed scenario and writing a new unit test to better understand the failure. Thankfully, FsCheck shrinks the data used in a failed test scenario to a more manageable size so that it can be used to diagnose the anomaly. The unit tests that are written as a result of failed property tests can then be incorporated into the regression suite of tests for continuous integration.

Conclusion

In conclusion, as I learn F#, I am also learning an alternative technique for proving code. Specifically, I am learning how to abstract away example-based tests into property-based tests. On this journey, I was surprised to realize that despite the unit tests that I wrote to bulletproof my functions, my functions still had bugs in them based on various edge cases that I never considered. Thus, I learned that bullet-proofing my code with example-based cases just wasn’t enough. I needed to bombproof my code with property-based tests. Thus, when I incorporated property-based tests into my arsenal of craftsmanship tools, I soon realized that property-based tests actually identify edge cases that can be added to a unit test suite for regression tests.

Appendix

The following sections reflect the actual code that was written as I performed this kata.

Domain

(* Types *)
type Black = BlackKing | BlackSoldier
type Red =   RedKing   | RedSoldier
 
type Coordinate = int * int
 
type Piece =
    | Black of Black * Coordinate
    | Red   of Red   * Coordinate
 
type Space =
    | Occupied  of Piece
    | Available of Coordinate
 
type Status =
    | BlacksTurn | RedsTurn
    | BlackWins  | RedWins
 
type OptionsResponse =
    | NoDuplicatesAllowed of Space list
    | Succeeded            of Coordinate list
 
type MoveResponse =
    | DuplicatesNotAllowed of Space list * Status
    | MoveNotAllowed       of Space list * Status
    | DestinationNotFound  of Space list * Status
    | Succeeded            of Space list * Status
 
(* Private *)
let private black coordinate = Occupied (Black (BlackSoldier , coordinate))
let private red   coordinate = Occupied (Red   (RedSoldier   , coordinate))
 
let private yDirection = function
    | Black _ -> -1
    | Red   _ ->  1
 
let private toAvailable = function
    | Available pos -> true
    | _             -> false
 
let private available positions = positions |> List.filter toAvailable
 
let private availableSelection = function
    | Available pos -> Some pos
    | Occupied _   -> None
 
let private availablePositions positions = 
    positions |> List.filter toAvailable
              |> List.choose availableSelection
 
let private tryGetCoordinate = function
    | Available xy -> Some xy
    | _            -> None
 
let private coordinateOf = function
    | Black (checker , pos) -> pos
    | Red   (checker , pos) -> pos
 
let private optionsForSoldier piece = 
 
    let (sourceX , sourceY) = coordinateOf piece
 
    (fun pos -> pos = ((sourceX - 1) , (sourceY + (piece |> yDirection) )) ||
                pos = ((sourceX + 1) , (sourceY + (piece |> yDirection) )))
 
let private optionsForKing piece = 
 
    let (sourceX , sourceY) = coordinateOf piece
 
    (fun pos -> pos = ((sourceX - 1) , (sourceY + 1 )) ||
                pos = ((sourceX + 1) , (sourceY + 1 )) ||
                pos = ((sourceX - 1) , (sourceY - 1 )) ||
                pos = ((sourceX + 1) , (sourceY - 1 )))
 
let private jumpOptions (sourceX , sourceY) space =
    match space with
    | Occupied p -> match p with
                     | Red   (ch,xy) -> xy = (sourceX + 1, sourceY - 1) ||
                                        xy = (sourceX - 1, sourceY - 1)
    
                     | Black (ch,xy) -> xy = (sourceX + 1, sourceY + 1) ||
                                        xy = (sourceX - 1, sourceY + 1)
    | _ -> false
 
let private jumpsForSoldier piece positions =
    match piece with
    | Black (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))
    | Red   (ch,pos) -> positions |> List.filter (jumpOptions (coordinateOf piece))
 
let private isKing piece = 
    match piece with
    | Black (checker , _) -> match checker with
                             | BlackSoldier -> false
                             | BlackKing    -> true
 
    | Red   (checker , _) -> match checker with
                             | RedSoldier   -> false
                             | RedKing      -> true
 
let private filterOut a b positions =
    positions |> List.filter(fun x -> x <> a && x <> b)
 
let private movePiece destination positions piece =
 
    let destinationXY = 
        match destination with
        | Available xy -> xy
        | Occupied p  -> coordinateOf p
 
    let yValueMin , yValueMax = 0 , 7
 
    let canCrown =
        let yValue = snd destinationXY
        (yValue = yValueMin || 
         yValue = yValueMax) && 
         not (isKing piece)
 
    match positions |> List.find (fun space -> space = Occupied piece) with
    | Occupied (Black (ch, xy)) -> 
        let checkerType = if canCrown && not (isKing piece) then BlackKing else ch
        Available(xy) :: (Occupied(Black(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Black(ch, xy))) destination)     
        
    | Occupied (Red   (ch, xy)) -> 
        let checkerType = if canCrown && not (isKing piece) then RedKing else ch
        Available(xy) :: (Occupied(Red(checkerType, destinationXY)))
                      :: (positions |> filterOut (Occupied (Red(ch, xy))) destination) 
    | _ -> positions
 
let private update = function
    | BlacksTurn -> RedsTurn
    | RedsTurn   -> BlacksTurn
    | BlackWins  -> BlackWins
    | RedWins    -> RedWins
 
let private statusOf = function
    | Black _ -> BlacksTurn
    | Red   _ -> RedsTurn
 
let private duplicatesIn positions = 
    positions |> Seq.countBy id
              |> Seq.map snd
              |> Seq.exists (fun count -> count > 1)
 
let private getTurn (positions , status) = status
 
(* Public *)
let startGame () =
    [ red (0,0);  red (2,0);  red (4,0);  red (6,0)
      red (1,1);  red (3,1);  red (5,1);  red (7,1)
      red (0,2);  red (2,2);  red (4,2);  red (6,2)
      
      Available (1,3); Available (3,3); Available (5,3); Available (7,3)
      Available (0,4); Available (2,4); Available (4,4); Available (6,4)
      
      black (1,5);  black (3,5);  black (5,5);  black (7,5)
      black (0,6);  black (2,6);  black (4,6);  black (6,6)
      black (1,7);  black (3,7);  black (5,7);  black (7,7) ] , BlacksTurn
 
let fromMove = function
    | Succeeded            (positions, status)
    | DuplicatesNotAllowed (positions, status)  
    | MoveNotAllowed       (positions, status) 
    | DestinationNotFound  (positions, status) -> positions
 
let fromOptions = function
    | OptionsResponse.Succeeded            coordinates -> coordinates
    | OptionsResponse.NoDuplicatesAllowed positions   -> 
        positions |> List.map (fun pos -> match pos with
                                          | Available xy -> xy
                                          | Occupied p   -> coordinateOf p)
 
let optionsFor piece positions =
 
    if duplicatesIn positions
    then OptionsResponse.NoDuplicatesAllowed positions
    else match piece |> isKing with
         | false -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForSoldier piece)
                    OptionsResponse.Succeeded options
                    
         | true  -> let options = positions |> availablePositions 
                                            |> List.filter (optionsForKing piece)
                    OptionsResponse.Succeeded options
 
let move piece destination (positions,status) =
 
    if duplicatesIn positions
    then DuplicatesNotAllowed (positions,status)
    else let canProceed =  match piece with
                           | Red   _ -> update status = RedsTurn  
                           | Black _ -> update status = BlacksTurn
 
         if not canProceed 
         then MoveNotAllowed (positions , update status)
 
         else match optionsFor piece positions with
              | OptionsResponse.NoDuplicatesAllowed spaces -> DuplicatesNotAllowed (spaces,status)
              | OptionsResponse.Succeeded coordinates       -> 
                 let canMoveTo = (fun target -> coordinates |> List.exists (fun xy -> xy = target))
                 
                 match tryGetCoordinate destination with
                 | Some target -> if canMoveTo target then
                                     let updatedBoard = ((positions , piece) ||> movePiece destination)
                                     Succeeded (updatedBoard , update status)
              
                                  else MoveNotAllowed (positions , update status)
         
                 | None -> DestinationNotFound (positions , update status)
 
let jump target (positions,status) source =
 
    let jumpsExist = 
        positions |> jumpsForSoldier source
                  |> List.exists (fun s -> 
                    match s with
                    | Occupied target -> true
                    | _               -> false)
 
    let (|NorthEast|NorthWest|SouthEast|SouthWest|Origin|) (origin , barrier) =
        
        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier
 
        if   barrierY = sourceY + 1 &&
             barrierX = sourceX - 1
        then SouthWest
 
        elif barrierY = sourceY + 1 &&
             barrierX = sourceX + 1 
        then SouthEast
 
        elif barrierY = sourceY - 1 &&
             barrierX = sourceX - 1
        then NorthWest
 
        elif barrierY = sourceY - 1 &&
             barrierX = sourceX + 1
        then NorthEast
 
        else Origin
 
    let jumpToPostion origin barrier =
 
        let (sourceX  , sourceY) =  origin
        let (barrierX , barrierY) = barrier
 
        match (origin , barrier) with
        | SouthWest -> (barrierX + 1, barrierY - 1)
        | SouthEast -> (barrierX + 1, barrierY + 1)
        | NorthWest -> (barrierX - 1, barrierY - 1)
        | NorthEast -> (barrierX - 1, barrierY + 1)
        | Origin    -> origin
 
    let isSameCoordinate source target = 
        coordinateOf source = coordinateOf target
 
    if jumpsExist && not (isSameCoordinate source target) then
             let destination = Available (jumpToPostion (coordinateOf source) (coordinateOf target))
             let result = (positions, source) ||> movePiece destination
                                               |> List.filter (fun s -> s <> Occupied target)
 
             Succeeded (Available (coordinateOf target)::result , update status)
 
    else MoveNotAllowed (positions,status)

Unit Tests

(* Tests *)
open NUnit.Framework
open FsUnit
 
let exists expected = fromMove >> List.exists (fun s -> s = expected)
 
[<Test>]
let ``black goes first`` () =
    startGame () |> getTurn
                 |> should equal BlacksTurn
[<Test>]
let ``get available positions`` () =
    startGame () |> fst
                 |> available
                 |> List.length 
                 |> should equal 8
[<Test>]
let ``get available positions for black soldier`` () =
    // Setup
    let piece = Black ( BlackSoldier , (1,5) )
 
    // Test
    let available = startGame () |> fst |> optionsFor piece
    // Verify
    match available with
    | OptionsResponse.Succeeded coordinates ->
        let northWestAvailable = coordinates |> List.exists (fun pos -> pos = (0,4))
        let northEastAvailable = coordinates |> List.exists (fun pos -> pos = (2,4))
 
        (northWestAvailable && northEastAvailable) |> should equal true
 
    | _ -> failwith "Failed to get options"
[<Test>]
let ``get available positions for red soldier`` () =
    // Setup
    let piece = Red ( RedSoldier , (0,2) )
 
    // Test
    startGame () |> fst
                 |> optionsFor piece
                 |> fromOptions
                 |> List.exists (fun pos -> pos = (1,3))
                 |> should equal true
[<Test>]
let ``get available positions for red king`` () =
    // Setup
    let piece = Red ( RedKing , (2,4) )
    let positions = [Available (0,2);  Available (2,2);  Available (4,2);  Available (6,2)
      
                     Available (1,3);  Available (3,3);  Available (5,3);  Available (7,3)
                     Available (0,4);  Occupied piece;  Available (4,4);  Available (6,4)
      
                     Available (1,5);  Available (3,5);  Available (5,5);  Available (7,5)]
 
    // Test
    positions |> optionsFor piece
              |> fromOptions
              |> List.length
              |> should equal 4
[<Test>]
let ``move red soldier`` () =
 
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)
 
    // Test
    startGame () |> move piece destination
                 |> exists (Occupied (Red (RedSoldier , (1,3) )))
                 |> should equal true
[<Test>]
let ``moving red soldier leaves space available`` () =
 
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)
 
    // Test
    startGame () |> move piece destination
                 |> exists (Available (0,2))
                 |> should equal true
[<Test>]
let ``moving red soldier maintains piece count`` () =
 
    let piece = Red ( RedSoldier , (0,2) )
    let destination = Available (1,3)
 
    // Test
    startGame () |> move piece destination
                 |> fromMove
                 |> List.length
                 |> should equal 32
[<Test>]
let ``get jump options for red soldier`` () =
 
    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let positions = [Occupied redPiece; Occupied blackPiece]
 
    // Test
    positions |> jumpsForSoldier redPiece
              |> should equal [Occupied blackPiece]
[<Test>]
let ``red soldier gets new destination when it jumps black soldier`` () =
 
    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected = Occupied (Red (RedSoldier , (2,4)))
    let positions = [Occupied redPiece; Occupied blackPiece; Available (2,4)]
    let gameState = positions , RedsTurn
 
    // Test
    (gameState,redPiece) ||> jump blackPiece
                          |> exists expected
                          |> should equal true
[<Test>]
let ``black soldier gets new destination when it jumps red soldier`` () =
 
    let redPiece =   Red   ( RedSoldier   , (2,2) )
    let blackPiece = Black ( BlackSoldier , (3,3) )
    let expected =   Occupied (Black ( BlackSoldier , (1,1) ))
    let positions =  [Occupied redPiece; Occupied blackPiece; Available (1,1)]
    let gameState = (positions,BlacksTurn)
 
    // Test
    (gameState, blackPiece) ||> jump redPiece
                             |> exists expected
                             |> should equal true
[<Test>]
let ``black soldier removed after being jumped by red soldier`` () =
 
    let redPiece =   Red   ( RedSoldier , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (1,3)
    let positions =  [Occupied redPiece; Occupied blackPiece]
    let gameState = (positions,RedsTurn)
 
    // Test
    (gameState , redPiece) ||> jump blackPiece
                           |> exists expected
                           |> should equal true
[<Test>]
let ``red soldier removed after being jumped by black soldier`` () =
 
    let redPiece =   Red   ( RedSoldier   , (0,2) )
    let blackPiece = Black ( BlackSoldier , (1,3) )
    let expected =   Available (0,2)
    let positions =  [Occupied redPiece; Occupied blackPiece; expected]
    let gameState = positions , BlacksTurn
 
    // Test
    (gameState, blackPiece) ||> jump redPiece
                             |> exists expected
                             |> should equal true
[<Test>]
let ``movng black soldier to endzone makes king`` () =
    
    let piece = Black ( BlackSoldier , (1,1) )
    let destinationCoordinate = (0,0)
    let destination = Available destinationCoordinate
    let positions = [destination; Occupied piece]
    let expected = Occupied (Black (BlackKing , destinationCoordinate))
 
    // Test
    (positions, RedsTurn) |> move piece destination
                          |> exists expected
                          |> should equal true          
[<Test>]
let ``movng red soldier to endzone makes king`` () =
 
    let piece = Red ( RedSoldier , (6,6) )
    let destinationCoordinate = (7,7)
    let destination = Available destinationCoordinate
    let positions = [destination; Occupied piece]
    let expected = Occupied (Red (RedKing , destinationCoordinate))
 
    // Test
    (positions, BlacksTurn) |> move piece destination
                            |> exists expected
                            |> should equal true
[<Test>]
let ``can't move red twice in a row`` () =
    let piece = Red(RedSoldier , (0,2))
    let destination = Available (1,3)
 
    // Test
    let set1 = startGame() |> move piece destination
    let set2 = ((fromMove set1) , BlacksTurn) |> move piece destination
                    
    set2 |> fromMove
         |> should equal (set1 |> fromMove)

Property Tests

open FsCheck
open FsCheck.Xunit
 
type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100,
        QuietOnSuccess = true)
 
[<Run100K>]
let ``options for soldier can never exceed 2`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter (isKing >> not)
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , y |> Seq.distinct 
                                   |> Seq.toList)
     |> Arb.fromGen
     |> Prop.forAll 
     <| fun (piece , positions) ->
             positions |> optionsFor piece
                       |> fromOptions
                       |> List.length <= 2
     
[<Run100K>]
let ``options for king can never exceed 4`` () =
 
    // Setup
    let pieceGenerator =     Arb.generate<Piece> |> Gen.filter isKing
    let positionsGenerator = Arb.generate<Space list>
 
    // Test
    (pieceGenerator , positionsGenerator) 
    ||> Gen.map2 (fun x y -> x , Seq.distinct y 
                                 |> Seq.toList)
                 |> Arb.fromGen
                 |> Prop.forAll 
                 <| fun (piece , positions) ->
                         positions |> optionsFor piece
                                   |> fromOptions
                                   |> List.length <= 4
 
[<Run100K>]
let ``moving checker retains distinct element count`` () =
 
    // Setup
    gen { let! piece =          Arb.generate<Piece> 
          let! destination =    Arb.generate<Space>
          let! otherPositions = Arb.generate<Space list> // Used to ensure inclusion of piece & destination
          let! positions =      Occupied piece::destination::otherPositions |> Gen.shuffle
          let! status =         Arb.generate<Status>
          
          return piece , destination , positions
                                       |> Seq.distinct
                                       |> Seq.toList , status 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (piece , destination , positions , status) -> 
           (positions , status) |> move piece destination
                                |> fromMove
                                |> List.length = positions.Length
 
[<Run100K>]
let ``attempted checker jump results in zero or one distinct checkers removed`` () =
 
    // Setup
    gen { let! source =          Arb.generate<Piece>
          let! target =          Arb.generate<Piece>
          let! otherPositions =  Arb.generate<Space list>
          let! positions =       Occupied source :: Occupied target
                                                 :: otherPositions 
                                                 |> Gen.shuffle
 
          let tryAddDistinct (map:Map<Coordinate,Space>) s = 
              match tryGetCoordinate s with
              | Some xy -> match map.TryFind xy with
                           | Some pos -> map
                           | None     -> map.Add(xy,s)
              | None    -> map
 
          let distinct = (Map [], positions |> List.ofArray) 
                                            ||> List.fold tryAddDistinct
                                            |> Map.toList
                                            |> List.map snd
          return source , target , distinct 
        } |> Arb.fromGen
 
    // Test
    |> Prop.forAll 
    <| fun (source , target, positions) ->
 
           let gameStatus = positions , statusOf source
 
           (gameStatus , source) ||> jump target
                                  |> fromMove
                                  |> (fun l -> l.Length = positions.Length  ||
                                               l.Length = positions.Length - 1)




About List