Advanced Programming – Testing and Assessment
Advanced Programming
Testing and Assessment
Ken Friis Larsen
kflarsen@diku.dk
Department of Computer Science
University of Copenhagen
September 13, 2018
1 / 25
Today’s Program
I Questions from the Quiz
I Quick monad recap
I What is an assessment?
I Testing
I Property based testing
2 / 25
Questions and Comments from the Quiz
I “Why have both @=? and @?=? The difference is the order of the
actual and the expected value. Why not just have one of them?”
I “Could be nice if the quiz had some simple QuickCheck
exercises/questions”
I “I would appreciate a more elaborate walkthrough of the way
Gen works.”
I “Not sure how I should handle multiple tests in a sequence”
I “The exercise “Monad and QuickCheck Exercises”, still didn’t
figure out how to use the Random module…stopped tinkering
after 2 hours or so”
3 / 25
Our Two Favorite Type Classes
class Functor f where
fmap :: (a -> b) -> f a -> f b
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
class Applicative m => Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
fail :: String -> m a
4 / 25
Make Functors (and Applicatives) For Your Monads
Whenever you make your type a monad, you should also make it a
functor (and an applicative functor).
Here are implementations of Functor and Applicative for free (you
can sometimes/often do better):
instance Monad T where
…
instance Functor T where
fmap f xs = xs >>= return . f
instance Applicative T where
pure = return
af <*> ax = do f <- af
x <- ax
return (f x)
5 / 25
What Is An Assessment?
From the frontpage of the exam:
For each question your report should give an overview
of your solution, including an assessment of how good you
think your solution is and on which grounds you base your
assessment (testing, gut feeling, proof of correctness, . . . ).
6 / 25
Assessment
You should document:
I Your assumptions (if any).
I How suitable is your choice of algorithms and data structures,
often based on your assumptions
I The correctness/robustness of your code.
I An overall summary of the quality of your code.
And present evidence for your conclusions.
7 / 25
Morse Code
I One of the exercises from exercise set 0 is about decoding
morse code.
I That is, write the functions
encode :: String -> String
decode :: String -> [String]
For instance, “…—..-….-” could be the encoding for both
Sofia and Eugenia.
8 / 25
Morse Code, Implementation
import qualified Data.List as L
charMap = [(‘A’, “.-“), (‘B’, “-…”), … ]
findChar c = fromMaybe “” $ lookup c charMap
encode :: String -> String
encode = concatMap findChar
decode :: String -> [String]
decode “” = [“”]
decode input = [ c : rest | (c, code) <- charMap
, code `L.isPrefixOf` input
, let clen = length code
, rest <- decode $ drop clen input]
9 / 25
Assessment
You should document:
I Your assumptions (if any).
I How suitable is your choice of algorithms and data structures,
often based on your assumptions
I The correctness/robustness of your code.
I An overall summary of the quality of your code.
And present evidence for your conclusions.
10 / 25
(Bad) Assessment of Morse Code Implementation
I believe that my solution for working with Morse code
is quite good. The only weakness is that I use a list
as my data structure for mapping chars to the
corresponding Morse code. Instead I should probably have
used an array or a map (tree or hash based). That
would make `findChar` a constant time operation, which
would make `encode` much faster. Alas, it also make my
implementation of `decode` much uglier, and since the
list is short i decided to stay with list.
I tested my functions in the REPL for many examples,
and they always gave the correct results.
11 / 25
Correctness Claim by Testing
To claim that your code is correct, you must as a minimum do
some kind of testing:
I Black-box testing
I White-box testing
I Functional testing
I Unit testing
I . . .
Bare minimum, for each test:
I write down what you (think) you test,
I what is the expected outcome of the test,
I what was the outcome of the test.
All in a test schema/table (or as unit test). Summarise if needed.
12 / 25
Unit Testing In Haskell
Unit tests for the Morse module
import Test.Tasty
import Test.Tasty.HUnit
import Morse
fromTheQuiz =
testGroup "From the quiz"
[ testCase "Encode SOFIA"
(assertBool "" ("...---..-.....-" == encode("SOFIA")))
, testCase "Encode SOFIA 2"
("...---..-.....-" @=? encode("SOFIA"))
, testCase "Decode Eugenia"
(assertBool "" ("EUGENIA" `elem` decode "...---..-....-"))
, testCase "Decode Eugenia 2"
(assertBool "" ("EUGENIA" `elem` decode "...---..-...-"))
]
main = defaultMain fromTheQuiz
13 / 25
Property Based Testing
To say something about the correctness of our code, we should be
able to prove what properties holds for the code, or at least test that
the properties hold for a few instances.
For instance, for the Morse module we would expect to be able to
decode an encoded string:
s = decode(encode(s))
Alas, that’s too strong a property. Several strings can have the same
encoding. Thus the property we are after is
s ∈ decode(encode(s))
14 / 25
Using QuickCheck For Property Testing
The standard testing framework for property based testing in
Haskell is QuickCheck, in the module Test.QuickCheck.
We write our property as a predicate, which we can then test with
the function quickCheck
import Test.QuickCheck
import qualified Morse
prop_encode_decode s = s `elem` Morse.decode (Morse.encode s)
15 / 25
QuickCheck Building Blocks
I QuickCheck generates random values by clever use of the
Arbitrary type-class:
class Arbitrary a where
arbitrary :: Gen a
I That uses the type:
newtype Gen a = MkGen { unGen :: QCGen -> Int -> a }
to generate values of type a.
I Gen is a monad.
16 / 25
QuickCheck for Morse, Take 2
import qualified Test.QuickCheck as QC
import qualified Data.Char as C
import qualified Morse
upper = map C.toUpper
prop_encode_decode (LO s) = upper s `elem`
Morse.decode (Morse.encode s)
asciiLetter = QC.elements ([‘a’..’z’] ++ [‘A’..’Z’])
newtype LettersOnly = LO String
deriving (Eq, Show)
instance QC.Arbitrary LettersOnly where
arbitrary = fmap LO (QC.listOf asciiLetter)
17 / 25
QuickCheck for Morse, Take 3
import Test.QuickCheck
import qualified Data.Char as C
import qualified Morse
upper = map C.toUpper
prop_encode_decode (LO s) = upper s `elem`
Morse.decode (Morse.encode s)
weightedLetters = frequency [(2 ^ (max – length code), return c)
| (c,code) <- Morse.charMap]
where max = 1 + (maximum $ map (length . snd) Morse.charMap)
newtype LettersOnly = LO String deriving (Eq, Show)
instance Arbitrary LettersOnly where
arbitrary = fmap LO $ do n <- choose (0, 5)
vectorOf n weightedLetters
18 / 25
Testing Algebraic Data Types
How can be generate random expressions for checking that Add is
commutative:
data Expr = Con Int
| Add Expr Expr
deriving (Eq, Show, Read, Ord)
eval :: Expr -> Int
eval (Con n) = n
eval (Add x y) = eval x + eval y
prop_com_add x y = eval (Add x y) == eval (Add y x)
19 / 25
Generating Exprs
I Our first attempt
expr = oneof [ fmap Con arbitrary
, do x <- expr y <- expr return $ Add x y] instance Arbitrary Expr where arbitrary = expr is correct, I ... but may generate humongous expressions. I Instead we should generate a sized expression expr = sized exprN exprN 0 = fmap Con arbitrary exprN n = oneof [fmap Con arbitrary, liftM2 Add subexpr subexpr] where subexpr = exprN (n `div` 2) 20 / 25 Test your understanding: Check that minus is commutative I Add constructor and extend eval. I Extend data generator: expr = sized exprN exprN 0 = liftM Con arbitrary exprN n = oneof [liftM Con arbitrary, liftM2 Add subexpr subexpr, liftM2 Minus subexpr subexpr ] where subexpr = exprN (n `div` 2) I Write a property prop_com_minus x y = eval (Minus x y) == eval (Minus y x) 21 / 25 Shrinking in Haskell I The Arbitrary type class also specify the function shrink shrink :: a -> [a]
Which should produces a (possibly) empty list of all the possible
immediate shrinks of the given value.
I For Exprs
instance Arbitrary Expr where
arbitrary = sized exprN
where expr N 0 = …
shrink (Add e1 e2) = [e1, e2]
shrink (Minus e1 e2) = [e1, e2]
shrink _ = []
22 / 25
Questions and Comments from the Quiz
I “Why have both @=? and @?=? The difference is the order of the
actual and the expected value. Why not just have one of them?”
I “Could be nice if the quiz had some simple QuickCheck
exercises/questions”
I “I would appreciate a more elaborate walkthrough of the way
Gen works.”
I “Not sure how I should handle multiple tests in a sequence”
I “The exercise “Monad and QuickCheck Exercises”, still didn’t
figure out how to use the Random module…stopped tinkering
after 2 hours or so”
23 / 25
If time permits
I Improve the assessment of the Morse code together
I Talk about the assignment, and how stack is used
I Talk about worksheet exercises, and how to generate the
expression and the expected values together.
24 / 25
Summary
I Practise making an assessments (it will be on the exam)
I To claim correctness you should have some kind of evidence, as
a minimum some testing.
I Use Test.Tasty.HUnit for unit testing
I Use QuickCheck for better testing
I Property-based testing:
I Identify properties to test
I Write data-generators (in Haskell using Arbitrary and Gen)
I When a pro: shrinking
25 / 25