**Test (ing)**

**Haskell's 4 Letter Word**

Who am I?

Programmer

Blues Guitarist

Origami Professional

Creole Chef Extraordinaire

Is Testing Necessary? Haskell programs which compile "just work"

No, they don't. No one actually thinks this. Please kill this meme.

Java

σ type scheme

τ known type

Γ type environment

⊦ assertion

: assumption

- judgement

What's a type?

x

add 1 2

take 4 "hello"

3.14159

"Hello, Prezi!"

\x -> x + 1

let x = 4

in x + 3

qsort :: Ord a => [a] -> [a]

qsort [] = []

qsort (x:xs) =

qsort lhs ++ [x] ++ qsort rhs

where lhs = filter (< x) xs

rhs = filter (>= x) xs

Exhaustive. The qsort function will return a value of type [a] for all possible input values of type [a]

No null pointer exceptions!

But - the type is not strong enough to prove qsort correct.

data Empty

data NonEmpty

data SafeList a b where

Nil :: SafeList a Empty

Cons :: a -> SafeList a b -> SafeList a NonEmpty

data Zero

data Succ n

data SafeList a b where

Nil :: SafeList a Zero

Cons :: a -> SafeList a b -> SafeList a (Succ b)

Only discriminates between Nil and all other lists

Somewhat cumbersome to use

Too much type information!

Way worse in every respect

Dependent type system will make it slightly easier to write functions - but is still quite difficult

[ 1, 2, 3 ] :: SafeList Int (Succ (Succ (Succ Zero)))

**Further in this direction lies the subject of someone else's talk ...**

**Unit Testing**

**Haskell's type system *does* cover many cases that would be left to unit testing in other languages - but ...**

Help isolate the location of a defect to a single function (ideally - more to come)

Can be written in isolation (and therefore incrementally) and assist in reasoning about your code (TDD)

Haskell functions are already pure - no chance of accidently launching missles in a unit test.

Show & Read type classes make generating test data very easy.

Make lots of green! Programmers love green!

Can create alot of noise in your test suite, requiring additional scripting to maintain your data.

Brittle. Has roughly a 1:1 correspondence with the implementation, doubling your workload.

No ability to mock without bizarre function dicitonary passing tricks, somewhat obscuring property of isolation.

it "should type check user data types" $ assertCheck

(TypExpr (TypeSymP "Cons")

(TypeAbsP (TypeApp (TypeApp (TypeSym (TypeSymP "->"))

(TypeVar (TypeVarP "a")))

(TypeApp (TypeApp (TypeSym (TypeSymP "->"))

(TypeApp (TypeSym (TypeSymP "List"))

(TypeVar (TypeVarP "a"))))

(TypeApp (TypeSym (TypeSymP "List"))

(TypeVar (TypeVarP "a"))))))

(TypExpr (TypeSymP "Nil")

(TypeAbsP (TypeApp (TypeSym (TypeSymP "List"))

(TypeVar (TypeVarP "a"))))

(LetExpr (Sym "length")

(AbsExpr (Sym "n")

(MatExpr (VarExpr (SymVal (Sym "n")))

[ (ValPatt (ConVal (TypeSym (TypeSymP "Nil"))), VarExpr (LitVal (NumLit 0.0)))

, (ConPatt (TypeSymP "Cons")

[ ValPatt (SymVal (Sym "_"))

, ValPatt (SymVal (Sym "xs")) ]

, AppExpr (AppExpr (VarExpr (SymVal (Sym "+")))

(VarExpr (LitVal (NumLit 1.0))))

(AppExpr (VarExpr (SymVal (Sym "length")))

(VarExpr (SymVal (Sym "xs")))))]))

(AppExpr (VarExpr (SymVal (Sym "length")))

(AppExpr (AppExpr (VarExpr (ConVal (TypeSym (TypeSymP "Cons"))))

(VarExpr (LitVal (NumLit 1.0))))

(AppExpr (AppExpr (VarExpr (ConVal (TypeSym (TypeSymP "Cons"))))

(VarExpr (LitVal (NumLit 2.0))))

(VarExpr (ConVal (TypeSym (TypeSymP "Nil"))))))))))

Nothing

data Cons: a -> List a -> List a

data Nil: List a

let length n =

match n with

Nil = 0

(Cons _ xs) = 1 + length xs

length (Cons 1 (Cons 2 Nil))

Step back - how to cabal

You'll need a library, even if you're writing an executable. Be sure to expose every module you intend to test via the exposed-modules section.

library

hs-source-dirs: src

exposed-modules: Tested

other-modules: Tested.Utils

build-depends: base

ghc-options: -Wall

You'll need a test-suite section. This needs all libraries that you will require to write your test bodies, but not the functions themselves.

test-suite tested-tests

type: exitcode-stdio-1.0

hs-source-dirs: tests, src

main-is: MainTestSuite.hs

build-depends: base,

HUnit,

QuickCheck,

hspec,

test-framework,

test-framework-hunit,

test-framework-quickcheck2

exitcode-stdio-1.0

Name: foo

Version: 1.0

License: BSD3

Cabal-Version: >= 1.9.2

Build-Type: Simple

Test-Suite test-foo

type: exitcode-stdio-1.0

main-is: test-foo.hs

build-depends: base

module Main where

import System.Exit (exitFailure)

main = do

putStrLn "This test always fails!"

exitFailure

detailed-1.0 (actually, detailed-0.9)

Name: bar

Version: 1.0

License: BSD3

Cabal-Version: >= 1.9.2

Build-Type: Simple

Test-Suite test-bar

type: detailed-1.0

test-module: Bar

build-depends: base, Cabal >= 1.9.2

module Bar ( tests ) where

import Distribution.TestSuite

tests :: IO [Test]

tests = return [ Test succeeds, Test fails ]

where

succeeds = TestInstance

{ run = return $ Finished Pass

, name = "succeeds"

, tags = []

, options = []

, setOption = \_ _ -> Right succeeds

}

fails = TestInstance

{ run = return $ Finished $ Fail "Always fails!"

, name = "fails"

, tags = []

, options = []

, setOption = \_ _ -> Right fails

}

spec :: Spec

spec = do

describe "Ohml.Parser" $ do

it "should compile & run match expressions" $ assertNode

" let fib = fun n -> \

\ match n with \

\ 0 -> 0; \

\ 1 -> 1; \

\ n -> fib (n - 1) + fib (n - 2);; \

\ fib 7 "

(Right "13\n")

**hspec specifications**

**Integrates HUnit, QuickCheck and SmallCheck, and look like this**

**hspec-discover via preprocessor**

{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

module Spec where

test = 1

**test/FooSpec.hs**

test/Foo/BarSpec.hs

test/BazSpec.hs

test/Foo/BarSpec.hs

test/BazSpec.hs

main :: IO ()

main = hspecX $ do

describe "Foo" $ do

FooSpec.spec

describe "Bar"

Foo.BarSpec.spec

describe "Baz"

BazSpec.spec

HUnit

type Assertion = IO ()

assertFailure :: String -> Assertion

assertFailure msg = ioError (userError ("HUnit:" ++ msg))

assertBool :: String -> Bool -> Assertion

assertBool msg b = unless b (assertFailure msg)

assertString :: String -> Assertion

assertString s = unless (null s) (assertFailure s)

assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion

assertEqual preface expected actual =

unless (actual == expected) (assertFailure msg)

where msg = (if null preface then "" else preface ++ "\n") ++

"expected: " ++ show expected ++ "\n but got: " ++ show actual

Property based testing via QuickCheck

spec = do

describe "Functions in the Lists module form Prelude" $ do

describe "The `reverse` function" $

it "Applying `reverse` twice should return you the same input" $

property $ \xs -> reverse (reverse xs) == xs

To GHCi!

Conditional Property Testing via QuickCheck

ordered xs = and (zipWith (<=) xs (drop 1 xs))

insert x xs = takeWhile (<x) xs++[x]++dropWhile (<x) xs

spec = describe "The order-preserving insert function" $

it "should hold that inserting into an ordered list results in an ordered list" $

property $ \ x xs -> ordered xs ==> ordered (insert (x :: Int) xs)

... but be careful you have reasonable assumptions about your test data distribution:

spec = describe "The order-preserving insert function" $

it "should hold that inserting into and ordered list results in an ordered list" $

property $ \x xs ->

ordered xs ==>

trivial (null xs) $

collect (length xs) $

classify (ordered (x:xs)) "at-head" $

classify (ordered (xs++[x])) "at-tail" $

ordered (insert x xs)

Property testing over your own datatypes via QuickCheck

choose :: Random a => (a, a) -> Gen a

genEl :: [a] -> Gen a

genEl xs = choose (0, length xs-1) >>= (!! i)

next :: Gen a -> (a, Gen a)

oneof :: [Gen a] -> Gen a

frequency :: [(Int, Gen a)] -> Gen a

inc 1

Property testing your own datatypes via the arbitrary type class ... via QuickCheck

instance Arbitrary Sym where

arbitrary = (Sym . (:[])) `fmap` choose ('a', 'z')

instance Arbitrary Lit where

arbitrary = oneof [ StrLit `fmap` oneof (return `fmap` arbitrary)

, NumLit `fmap` oneof (return `fmap` arbitrary) ]

instance Arbitrary Val where

arbitrary = oneof [ SymVal `fmap` arbitrary

, LitVal `fmap` arbitrary ]

instance Arbitrary Expr where

arbitrary = sized expr'

where

expr' 0 = VarExpr `fmap` arbitrary

expr' n = oneof [ liftM3 LetExpr arbitrary subExpr subExpr

, liftM2 AppExpr subExpr subExpr

, liftM2 AbsExpr arbitrary subExpr

, liftM VarExpr arbitrary ]

where subExpr = expr' (n `div` 2)

**DocTest**

-- | Compute Fibonacci numbers

--

-- Examples:

--

-- >>> fib 10

-- 55

--

-- >>> fib 5

-- 5

fib :: Int -> Int

fib 0 = 0

fib 1 = 1

fib n = fib (n - 1) + fib (n - 2)

-- $setup

-- >>> import Control.Applicative

-- >>> import Test.QuickCheck

-- >>> newtype Small = Small Int deriving Show

-- >>> instance Arbitrary Small where arbitrary = Small . (`mod` 10) <$> arbitrary

-- | Compute Fibonacci numbers

--

-- The following property holds:

--

-- prop> \(Small n) -> fib n == fib (n + 2) - fib (n + 1)

fib :: Int -> Int

fib 0 = 0

fib 1 = 1

fib n = fib (n - 1) + fib (n - 2)

-- file doctests.hs

import Test.DocTest

main = doctest ["-isrc", "src/Main.hs"]

test-suite doctests

type: exitcode-stdio-1.0

ghc-options: -threaded

main-is: doctests.hs

build-depends: base, doctest >= 0.8

Example

let g = \x -> add x 4

in g 2

`add` must be type `a -> b -> c`

it is known that `add` is type `Num -> Num -> Num`

therefore `a`, `b`, `c` are type `Num`

therefore `\x -> add x 4` must be type `a -> c`

therefore `g` must be type `a -> c`

therefore `a` must be type `Num`

therefore the program must be type Num

Introduce an `Assumption` for every symbol in a program, binding the symbol's name & scope to it's type, which may be a variable.

Walk the expression tree using these assumptions, and introduce a `Substitution` for every usage of a symbol, to fit its context.

Where we assign or abstract values, we need to `Unify` two types, by calculating the most general new substitutions which make them equivalent.

Where we want to use a variable in a polymorphic way, we'll need to `Generalize` some assumptions so they can be instantiated with a fresh set of type variables for every usage.

Algorithm

**DocTest (cont)**

Decidable

Turing Incomplete

Inferrable

Will always calculate the Principal Type

data TestSet = TS (M.Map String Int) [String] [String] deriving (Show)

instance Arbitrary TestSet where

arbitrary = do common <- (filter (/="")) <$> arbitrary

known <- (filter (/="")) <$> arbitrary

unknown <- (filter (/="")) <$> arbitrary

counts <- ((map ((+1) . abs)) . (cycle . (++[1]))) <$> arbitrary

return $ TS (M.fromList (zipWith (,) (known ++ common) counts)) (unknown ++ common) common

prop_idemp (TS d w _) = spellCheck (D d) w == spellCheck (D d) (spellCheck (D d) w)

Another Example, Spellchecking

Spellchecking random words against a random dictionary may not work so well ....

data Expr = LetExpr Sym Expr Expr -- let x = 1 in x

| AppExpr Expr Expr -- f a

| AbsExpr Sym Expr -- fun x -> x

| VarExpr Val -- x

data Val = SymVal Sym

| LitVal Lit

data Lit = StrLit String

**HPC**

Simply add `-fhpc` to your ghc-options section of your test-suite, and your tests will generate `.tix` and `.mix` files suitable for analysis

EXCEPT NOT REALLY - because hpc integration with cabal is currently broken. Sorry!

**An aside about IO ...**

getList = find 5 where

find 0 = return []

find n = do

ch <- getChar

if ch `elem` ['a'..'e'] then do

tl <- find (n-1)

return (ch : tl) else

find n

-- A thin monadic skin layer

getList :: IO [Char]

getList = fmap take5 getContents

-- The actual worker

take5 :: [Char] -> [Char]

take5 = take 5 . filter (`elem` ['a'..'e'])

Coarbitrary

class CoArbitrary where

coarbitrary :: a -> Gen c -> Gen c

A note about Shrinkage

shrink :: a -> [a]

shrink = subsequences

eg, for Lists

dropFirstElementNumberOfElements :: [Int] -> [Int]

Without generalization step, the application of `f 1` will introduce the assumption `f : Num -> Num`, which makes the rest of the expression invalid.

Generalization will guarantee that each application of `f` will have new type variables, by replacing the type variable representing `x` with a fresh var at every invocation.

let f = \x -> x

in f 1 == f 1 && f \"test\" == f "test"

Generalization