# Hedgehog - State Machine Testing

Huw Campbell
2018-08-17 Hedgehog will eat all your bugs.

State machine testing in Hedgehog is an interesting and expressive testing paradigm for R.

The goal is to test object oriented code or complex systems involving state and hidden or abstracted functionality.

John Hughes has a series of excellent talks regarding testing of state based and non-deterministic systems using QuviQ's proprietary QuickCheck implementation, which has been using these techniques to great effect for many years.

Here's a quick example: the following code is a reference class which maintains a lookup for values, with integer keys. One could also imagine writing a fast implementation of this in c. If you haven't seen reference classes before, that's ok – one can think of them as akin to C++ classes.

``````refs <- setRefClass("Refs",
fields = list(
num = "numeric"
, refs = "list"
)
, methods = list(
initialize = function() .self\$reset()
, newRef = function() {
.self\$num <- .self\$num + 1
.self\$refs[[.self\$num]] <- 0
return ( .self\$num )
}
return ( .self\$refs[[i]] )
}
, writeRef = function(i, a) {
.self\$refs[[i]] <- a
invisible(NULL)
}
, reset = function() {
.self\$num = 0
.self\$refs = list()
invisible(NULL)
}
)
)
grefs <- refs\$new()``````

We use the `grefs` value as a global system which we will interact with.

How would we test this object? Using hedgehog, we will simulate a model for this class as a list of tuples, one for naming the map entry, and one for its value. For example:

``list(key = 2, val = 0)``
``````## \$key
##  2
##
## \$val
##  0``````

The commands we can use to interact with the reference class api are creating a new map entry, writing to a map entry, and reading a map entry.

We will define a hedgehog command which will be used to test the `newRef` functionality of the class.

``````new  <- command ( "New",
generator = function( state ) list()
, execute   = function() grefs\$newRef()
, update    = function( state, output )
snoc( state, list(key = output, val = 0))
)``````

The `command` function takes a name of the function, which will be shown when presenting counterexamples, as well as a set of functions which are used when building and exercising this class's functionality.

The generator function is provided with the current state of the system while we are running the generators and generates the list of arguments which should be passed to the `new` function while it is being executed.

Here, the `new` command doesn't take an input, so this is the empty list (the arguments are curried to the property functions using `do.call`).

The `execute` function will take the inputs generated by the generator, and applies them. In our case, there is no input (as mentioned above), so this function takes no arguments. Inside the `execute` function we actually call the `newRef()` function of the class.

Finally the `update` function shown will add a new value to the test's model of the system. This function is run both at generation time and during execution of the property. This is interesting because during generation, there isn't actually a value for the output which we can pass to this function. Instead, we pass a symbolic value representing the output and what it will be during execution. This does have one interesting side effect, in that we can not permit one to look at or examine the value of the output in this function. It must be agnostic to whether the value is the type it expects.

For `new` the update function is rather simple, and just adds a new map entry with value `0` to the model.

We can now test this functionality with an initial state.

``initialmodel <- list()``
``````test_that( "Registry State Machine Model",
forall( gen.actions ( initialmodel, list(new) ), function( actions ) {
grefs\$reset()
expect_sequential( initialmodel, actions )
})
)``````

And it passes. Hedgehog has generated a random list of commands (all of which are `new`) and run them.

Let's look at the functions we have used: `gen.actions` is a generator which will build a list of commands to call, ensuring that the preconditions are sound, and providing sensible shrinks; the test, `expect_sequential`, is an expectation which will run the actions and the post condition expectations. Notice that inside the `forall`, we also call `grefs\$reset()`; this ensures that the global state is in a pristine condition before the tests are run.

There aren't actually any expectations in this model, so it's not too surprising that the test passes.

Now we can make this test more interesting and will add a command for the `readRef` functionality of the system.

``````read <- command ( "Read",
generator = function( state ) {
if ( length(state) == 0 )
return(NULL)
list(
key = gen.with(gen.element( state ), function(i) i\$key )
)}
, require = function( state, key )
!is.null ( Find( function( proc ) { proc\$key == key } , state ) )
, execute = function( key ) grefs\$readRef(key)
, ensure  = function( state, output, key ) {
expected <- Find( function( proc ) { proc\$key == key } , state )\$val
expect_equal( expected, output)
}
)``````

There quite a few interesting things going on here. Firstly the generator now is a function which will choose one of the `keys` to read. Notice that if the model is currently empty, we return `NULL`. This is one of the ways we ensure we only run `read` after a call to `new` has been performed. The `require` function is also applicable here, but furthermore tests that the generated function inputs are valid – this is important during shrinking, as we don't want to cull a command during shrinking and then end up with an invalid state.

The `execute` function now takes the `key` to read, and can pass it to `readRef`.

Finally, we have an `ensure` function. After execution, we run this function, and any `testthat` expectations within it.

Ok, let's add the final command:

``````write <- command ( "Write",
generator = function( state ) {
if ( length(state) == 0 )
return(NULL)
list (
key = gen.map( function(i) i\$key, gen.element( state ))
, val = gen.int(10)
)}
, require = function( state, key, val )
!is.null ( Find( function( proc ) { proc\$key == key } , state ) )
, execute = function( key, val ) grefs\$writeRef( key, val )
, update  = function( state, output, key, val )
lapply( state, function(proc)
if (proc\$key == key) list(key = proc\$key, val = val) else proc
)
)``````

Now we can run the tests with `new`, `read`, and `write` commands.

``````test_that( "Registry State Machine Model",
forall( gen.actions ( initialmodel, list(new, read, write) ), function( actions ) {
grefs\$reset()
expect_sequential( initialmodel, actions )
})
)``````

These tests now pass, meaning our model and our system are consistent. Let's now subtly break something, so we can show how counterexamples and shrinking work. What we'll do is write an incorrect `write` function, which writes a value incremented by `1`, instead of the correct value. This will cause the model and reality to clash.

``````writeIncorrect <- command ( "Write (Broken)",
generator = function( state ) {
if ( length(state) == 0 )
return(NULL)
list (
key = gen.with( gen.element( state ), function(i) i\$key)
, val = gen.int(10)
)}
, require = function( state, key, val )
!is.null ( Find( function( proc ) { proc\$key == key } , state ) )
, execute = function( key, val ) grefs\$writeRef( key, val + 1)
, update  = function( state, output, key, val )
lapply( state, function(proc)
if (proc\$key == key) list(key = proc\$key, val = val) else proc
)
)``````

Now we'll run the expectation with the incorrect write function as well.

``````test_that( "Registry State Machine Model",
forall( gen.actions ( initialmodel, list(new, read, write, writeIncorrect) ), function( actions ) {
grefs\$reset()
expect_sequential( initialmodel, actions )
})
)``````
``````## Error: Test failed: 'Registry State Machine Model'
## * Falsifiable after 12 tests, and 3 shrinks
## `expected` not equal to `output`.
## 1/1 mismatches
##  1 - 2 == -1
## Counterexample:
## []
## New
## output variable: 1
##
## []
## Write (Broken)
## inputs:
## \$key
## Var 1 (symbolic)
## \$val
##  1
##
## output variable: 2
##
## []
{"ft_lang_label":"__label__en","ft_lang_prob":0.8193981,"math_prob":0.96994144,"size":8237,"snap":"2020-34-2020-40","text_gpt3_token_len":2022,"char_repetition_ratio":0.14866999,"word_repetition_ratio":0.15880722,"special_character_ratio":0.27170086,"punctuation_ratio":0.13962767,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.9807084,"pos_list":[0,1,2],"im_url_duplicate_count":[null,null,null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2020-08-11T10:13:26Z\",\"WARC-Record-ID\":\"<urn:uuid:8077a53d-4ecf-4f74-b06a-6f9ae19fad93>\",\"Content-Length\":\"47768\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:5e89663c-07fc-4c69-a2a6-e83d4978dd3d>\",\"WARC-Concurrent-To\":\"<urn:uuid:45225d67-764d-49b2-a310-dd16e1a6d79d>\",\"WARC-IP-Address\":\"130.225.254.116\",\"WARC-Target-URI\":\"http://mirrors.dotsrc.org/cran/web/packages/hedgehog/vignettes/state-machines.html\",\"WARC-Payload-Digest\":\"sha1:HDIZI36YE5P2CYNP65LWRL7CU4ETOCLX\",\"WARC-Block-Digest\":\"sha1:OPTPJAFNMAG2JAAPM627AVEN4Y3ZQ55C\",\"WARC-Identified-Payload-Type\":\"application/xhtml+xml\",\"warc_filename\":\"/cc_download/warc_2020/CC-MAIN-2020-34/CC-MAIN-2020-34_segments_1596439738746.41_warc_CC-MAIN-20200811090050-20200811120050-00366.warc.gz\"}"}