如何写一个脚本语言_如何少快好省地写一个QuickCheck

大家可能在很多编程语言里都看到过QuickCheck这个自动化随机测试库,其实这套方法最初是在Haskell98上实现,原始论文[1]写于2000年,强烈建议读一读,后来其中一位作者John Hughes用Erlang重新实现还开了家软件测试公司,据说帮Volvo做汽车软件集成测试效果很不错(广告共赢)。测试跟形式验证不同,本质上是反证法,把同一个测试用例算两次做比较,对于spec上的每一行功能说明,单元测试和QuickCheck都在尝试构造反例,如果找不到并不能证明实现是正确的。测试的构造性意味着量变往往无法转化为质变,盲目测试常常就是大海捞针。单元测试是靠人脑想边角案例,人手写测试用例,初始阶段效果可能很好,但后面边际收益很低;QuickCheck是基于Property的,自动生成随机测试用例,所谓Property其实就是返回值为Bool的函数,是剥离掉实现细节对功能说明API做的抽象,往往可以从spec的说明直接翻译成代码,比如加法有单位率,结合律,交换律,事实上任何满足这三种定律某种意义上都可以被称作加法。我建议读一读这篇文章[2],作者列了七种Property常见的来源,比如算两次,不变性等等。当然数学里各种运算的性质也可以拿过来用,比如分配律,幂等律。如果是写Haskell,类型类公理往往也是Property的来源之一,FRP的发明人Conal Elliott就曾围绕此专门写过文章[3]谈如何设计没有抽象泄露的API。
好了回到Haskell,单元测试是在写一个形如Eq b => a -> b的partial函数或者是Eq v => [(k, v)],如果是多个参数可以用uncurry转化为这种形式,QuickCheck则是在写一个形似Generative a => a -> Bool的total函数,如果是多个参数可以用curry加上类型类转化。这一点形式的不同会带来诸多好处,首先GHC能检查一部分totality,比如说模式匹配是否完全,一定程度上(概率为1)我们在测试整个指定的定义域,当然如果想声明前提条件排除一部分值在QuickCheck里也很容易;其次,Haskell默认curry,加上全局类型推导,这种可归纳形式十分有利,多参数的情况完全不必手动uncurry;再者,如果不显式写出类型,GHC会用输入参数最泛化的类型,在Haskell里自由定理保证了函数越泛化能通过类型检查的实现越少,我们写出来的特性自动多了一层安全性和抽象性,这种抽象性反过来还能帮助思考和检查spec错误,随机测试效果也更好。
当然QuickCheck也有缺点。首先围绕API写一个好的特性就不容易,如果测试者用了实现者同样的错误思路来写特性,测试效果为零。其次如果定义域约束比较复杂,用generate-then-filter方法产生输入参数效果很差,得手动写发生器,更复杂的约束甚至得求助于random constraint solver。保证概率为1遍历整个定义域也不代表真正遍历,其实标准设置情况下保证不了概率为1,因为有个隐藏的变量size,SmallCheck可以保证完全遍历某个范围内的全部取值可能。所以要克服以上这些缺点,需要懂一点QuickCheck背后的原理。QuickCheck干净轻量,论文附录就有整个库的代码,不到三百行,不含任何编译器扩展,唯一依赖的外部库是随机序列发生器,当然最初的库没有实现自动shrink反例的功能,因为作者没想到。shrink来自于Andy Gill的想法,我觉得这跟他写的应用是PrettyPrint相关,对于很多递归类型shrink函数的实现并没有直观意义,完全需要依靠problem domain的知识和经验。

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RankNTypes    #-}
{-# LANGUAGE GADTs         #-}

import Data.Bits
import Data.List
import Data.Char
import Data.Monoid
import System.Random
import Control.Monad (join)
import Control.Arrow ((&&&))
import Text.Show.Functions
import qualified Data.Map as M

我今天重写了一下QuickCheck,用到的数据类型跟库代码有所不同,但实现了它所有的主要特性,而且我相信更容易理解,尤其是shrink过程。首先还是设计数据类型,随机测试需要用到伪随机序列发生器和概率分布来产生输入参数类型的随机值。产生符合期望的随机值这并不容易,数学家到现在都没搞清楚Pi或者2的平方根十进制序列到底是不是性质良好的随机序列,概率就更难,幸好是这里处理的是离散概率分布,简单值类型均匀分布就够了,复杂自定义类型需要注意避免耦合,耦合的结果有时候会违反直觉,比如x是均匀分布的随机值,2*x是均匀分布,但如果耦合x+x却是正态分布。这里有个有趣的问题[4],如果有枚两面不对称的硬币,如何抛才能产生任意有理数的二项式分布样本,比如最简单的p=0.5,大家可以想想。

newtype Distribution a = Dist { runDist :: Int -> StdGen -> a } deriving (Functor)

instance Applicative Distribution where
  pure a = Dist $ (_ _ -> a)
  Dist f <*> Dist a = Dist $ s r -> let (r1, r2) = split r in f s r1 (a s r2)

分布用Distribution来表示,它是函子,这没有问题,但如果只声明为函子,那写起自定义类型的分布会十分繁琐,QuickCheck额外还定义了Distribution单子的实例,这样就可以随心所欲地使用语法do,不过它违反单子的公理,更糟糕的是对于自定义递归类型,单子意味着稍不注意就会引入耦合,作者在定义单子实例时很小心用split避免了这个问题。我觉得定义合用函子的实例就够了,这样同样可以愉快地使用ApplicativeDo语法,不过它也违反了合用函子的三条公理。我跟作者一样认为这是合理的,因为随机变量本来就没有pointwise equality的定义。你可能会想StdGen是State Monad,Distribution还有点像Reader Monad,为啥不用MTL?这主要是因为如果用State就没法写输入参数是函数的随机值发生器。另外如果利用自由合用函子构造,我们能设计出完全符合合用函子公理的分布,也能写简单函数类型的随机值生成器,但GADT会擦除中间shrinkable的信息,导致最终的Property实现不了shrink功能。

frequency :: [(Int, Distribution a)] -> Distribution a
frequency fs = do { as <- sequenceA (fmap snd fs); w <- choose (0, head ws - 1); pure (pick (tail ws) as w) } 
  where
    ws = scanr1 (+) (fmap fst fs)
    pick []     (a:as) r = a
    pick (w:ws) (a:as) r = if r >= w then a else pick ws as r
data Rose a = Rose a [Rose a] deriving (Show)
 
instance Arbitrary a => Arbitrary (Rose a) where
  arbitrary = sized arbRose where
    arbRose 0 = Rose <$> arbitrary <*> pure [] 
    arbRose n = frequency
      [ (1, arbRose 0)
      , (2, Rose <$> arbitrary <*> resize (n `div` 2) arbitrary)
      ]

有了合用函子方法,我们就能方便定义智能构造器了。假设现在要定义玫瑰树的分布,很容易写出oneOf [Rose <$> arbitrary <*> [], Rose <$> arbitrary <*> arbitrary],或者要尽可能多地产生深度大于1的玫瑰树,你会用frequency。但是注意子树对应的arbitrary是递归调用,虽然定义了终止条件,但递归使得终止发生的概率指数级减小,最后生成的玫瑰树可能非常深,根本无法控制大小。为了解决这个问题,Distribution引入一个隐藏的自然数,用来表示类型数据的大小。它是全局的,每轮测试所有参数拿到的都一样,然后逐渐增大。引入size主要是控制随机生成的递归类型数据,比如表示列表的长度或者二叉树的深度。它也可以用来表示值类型数据的范围,比如默认设置库里面整数的取值范围就不是整个31位,可以看出这样测试涉及到整数运算溢出Property时非常容易误用,用下面三个函数可以很方便地重新配置它。

sized :: (Int -> Distribution a) -> Distribution a
sized f = Dist $ s -> runDist (f s) s
 
resize :: Int -> Distribution a -> Distribution a
resize s d = Dist $ _ -> runDist d s
   
scale :: (Int -> Int) -> Distribution a -> Distribution a
scale f g = sized $ s -> resize (f s) g

有了合用函子的实例和操作size的三个函数,就可以愉快地写我最喜欢的智能构造器了。对于常见基本类型,可以用类型类Arbitrary在编译期保存分布信息,这样通过类型推导,GHC自动会生成输入参数是基本类型的Property。

class Arbitrary a where
  arbitrary :: Distribution a
  shrink :: a -> Succs a
  shrink = flip Succs []

choose :: Random a => (a, a) -> Distribution a
choose r = Dist $ const (fst . randomR r)

chooseAny :: Random a => Distribution a
chooseAny = Dist $ const (fst . random)

elements :: [a] -> Distribution a
elements as = do { n <- choose (0, length as - 1); pure (as !! n) }

oneOf :: [Distribution a] -> Distribution a
oneOf gs = do { as <- sequenceA gs; n <- choose (0, length gs - 1); pure (as !! n) }

vectorOf :: Distribution a -> Int -> Distribution [a]
vectorOf g = sequenceA . flip replicate g

listOf :: Distribution a -> Distribution [a]
listOf g = do { as <- sized (vectorOf g); n <- sized (s -> choose (0, s)); pure (take n as) } 

listOf1 :: Distribution a -> Distribution [a]
listOf1 g = do { as <- sized (vectorOf g); n <- sized (s -> choose (1, s)); pure (take n as) } 

orderedList :: (Ord a, Arbitrary a) => Distribution [a]
orderedList = sort <$> listOf arbitrary

刚才说到之所以不用State Monad是为了能自动生成简单函数的分布。首先Distribution (a->b)是Int->StdGen->a->b外面的一层wrapper,用curry合并输入参数得到(Int, StdGen, a)->b,注意到(Int, StdGen, a)和(a, Int, StdGen)同构,再用uncurry可以得到a->(Int->StdGen->b),总结起来就是下面的promote函数。那么怎样才能生成a->Gen b呢?注意到每个基本类型其实就是内存里一串存储的01序列,函数即值,值也是函数,我们可以把01序列看作分布的扰动器,结合split很容易就能写出以下variant函数,注意扰动的其实是随机序列,并没有任何数学意义,因为函数是point free很难定义其值的分布。这个技巧还可以用在理解foldl::(b->a->b)->b->t a->b和foldr::(a->b->b)->b->t a->b上,可以把a看作action b->b,foldl其实就是依次执行这些action,初始状态是b,对于foldr,我们需要进一步把b->b看作action (b->b)->(b->b),可以理解为有了前一个action才进行这个action,初始状态是id,我们就能够很容易地用foldr表示foldl。回到产生函数的值分布,基本类型的和积类型也都是内存里面的一串01序列,想想C里面struct的存储,我们用Coarbitrary类型类来表示这一类扰动函数。扰动器区别的是同一类型的不同值并非不同类型,对于自定义类型或者递归类型,只需要把这个类型的值构造器也序列化就行。如果想不清楚这一点,很容易写错比如Either a b很容易错写成coarbitrary (Left a) = coarbitrary a和coarbitrary (Right b) = coarbitrary b,可以试试写一下二叉树的coarbitrary。好了,有了Arbitrary a和Coarbitrary b,GHC就能帮我们自动推导Arbitrary (b -> a)。这里还有最后一个问题,如果输入参数是高阶函数怎么办,函数值貌似无法序列化就无法写Coarbitrary (a->b),事实上如果定义了Distribution的单子方法是可以写出来的,但我觉得实在无法解释函数扰动器的作用,函数本来也没有pointwise意义上的相等,如何定义不同函数是否产生不同的扰动效果,而且实际应用中很少有输入参数是高阶函数的。

promote :: (a -> Distribution b) -> Distribution (a -> b)
promote f = Dist $ s r a -> runDist (f a) s r

variant :: Int -> Distribution a -> Distribution a
variant n d = Dist $ s r -> runDist d s (iter r)
  where
    cnt  = maybe 64 id (bitSizeMaybe n)
    bits = testBit n <$> [0..(cnt-1)]
    iter = flip (foldr (b r -> if b then fst (split r) else snd (split r))) bits  

class Coarbitrary a where
  coarbitrary :: a -> Distribution b -> Distribution b

instance (Arbitrary a, Coarbitrary b) => Arbitrary (b -> a) where
  arbitrary = promote (flip coarbitrary arbitrary)

好了我们有了值类型和简单函数类型的分布,还有形如a->Bool的Property,很自然可以把Property定义成Distribution Bool。但对于测试反例和覆盖率更重要,我们需要在运行时保留这些信息。一般遇到这种需要统计某类数据的情况,往往可以设计成幺半群,比如下面的Result。前面说了,有时候我们会想加前提条件或者把输入分类,这些都可以设计成幺半群,幺半群的积类型仍然是幺半群。同样利用m和m->m之间的同构,我们可以定义一些智能构造器,比如说label,classify,collect。

data Result = Result
  { ok        :: Maybe Bool
  , labels    :: M.Map String Int
  , classes   :: M.Map String Int
  , arguments :: [String]
  , seed      :: Int
  , numTests  :: Int
  } deriving (Show)
 
instance Monoid Result where
  mempty = Result Nothing M.empty M.empty [] 0 0
  r@(Result (Just False) _ _ _ _ _) `mappend` _           = r
  _ `mappend` r@(Result (Just False) _ _ _ _ _)           = r
  Result Nothing _ _ _ _ _ `mappend` r                    = r
  r `mappend` Result Nothing _ _ _ _ _                    = r
  Result _ ll lc la _ ln `mappend` Result _ rl rc ra _ rn = Result (Just True) (M.unionWith (+) ll rl) (M.unionWith (+) lc rc) (la ++ ra) 0 (ln + rn)

接下来考虑如何shrink,shrink其实是一个函数a->[a]。QuickCheck库用的是上面提到的玫瑰树来表示,是一个递归数据类型,但以多叉树形式shrink有很多缺点,一是多叉树隐形限制了shrink的order,DFS或者BFS,很难指定其他顺序,二是同一层玫瑰树的子树可能会出现重复,lazy执行会缓解这个问题。其实不如把树拍平,直接用列表来表示,这不是我的想法,来自于Control.Applicative.Successors,我觉得特别优雅,Successor保证了每次最多只shrink一步,还可以提前剔除重复元素,而且作者手动验证了函子,合用函子和单子的公理。不过Successor也有性能缺点,(++)的右结合性意味着取第一个successor需要deconstruct整个左序列,我在想是不是可以把左右两边列表interleave在一起,类似Edward Yang在这篇文章[5]提到的Logic Monad,这样既能提高性能,又能改善shrink效果,等有时间研究一下。

data Succs a = Succs { current :: a, successor :: [a] } deriving (Show, Functor)
 
instance Applicative Succs where
  pure = flip Succs []
  Succs f fs <*> Succs a as = Succs (f a) ((($ a) <$> fs) ++ (f <$> as))
 
instance Monad Succs where
  return = flip Succs []
  Succs a as >>= mf = Succs (current (mf a)) (fmap (current . mf) as ++ successor (mf a))

现在我们可以定义Property类型了,简单一点可以用Distribution (Succs Result),这样会违反合用函子的公理,不同于之前这次我们不能简单忽略,因为Property往往是user code,如果用户自定义的话,pure f <*> x /= f <$> x会影响可复现reproducibility。另外也不直观,构造Property的时候我们丢掉许多结构信息。这里可以用我们的老朋友自由合用函子构造,这样既能保留最多信息,而且也非常清晰,Property其实包含的就是Distribution x0, Distribution x1, ..., Distribution xn,以及函数x0->x1->...->xn->Result,再加上可能的print和shrink函数。当然,前面也说了如果要利用GHC的类型推导,必须把它看作curry的形式,用Testable来抽象。

newtype Property = Prop { runProperty :: FreeA Distribution (Succs Result) }
 
success = (Prop . pure . pure) $ mempty { ok = Just True , numTests = 1 }
failure = (Prop . pure . pure) $ mempty { ok = Just False, numTests = 1 }
discard = (Prop . pure . pure) $ mempty { ok = Nothing   , numTests = 1 }
  
class Testable a where
  property :: a -> Property
 
instance Testable Bool where
  property b = if b then success else failure

forAll' :: Testable b => (a -> Succs a) -> (a -> String) -> Distribution a -> (a -> b) -> Property
forAll' shrinker printer da f = Prop $ do
  sa <- lift (fmap shrinker da)
  sg <- lift (pure <$> promote (unlift . runProperty . property))
  pure $ do
    g <- sg
    (b, arg) <- fmap (f &&& printer) sa
    logArg arg <$> g b

forAll :: (Arbitrary a, Show a, Testable b) => Distribution a -> (a -> b) -> Property
forAll = forAll' shrink show

instance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where
  property f = forAll' shrink show arbitrary f

最后可以写Property的运行器和设置预设的参数,我们的quickCheck函数就大功告成了。最后我还有几点建议,QuickCheck不是万能的,里面有很多隐藏的默认设置,需要结合problem domain来调整,用默认的分布可能会直接忽略一部分可能的取值,或者产生的大部分随机值都是无效输入,这是我不建议使用(==>)过滤,可以加一层newtype手动写arbitrary。另外Property的不同写法可能是同构的,但具体测试效果可能不同,比如a->b->Bool和(a,b)->Bool,我也建议结合问题手动写arbitrary。遇到要测试复杂嵌套的数据结构,写分布时还有一个技巧就是按照API抽象出状态机[6],比如要测试Dropbox,就可以先设计一个action类型,把常见的API-创建,删除,分享,修改等单独包装成Action,这样整个Dropbox其实就是初始状态加上Action的列表,这样写出来的分布测试时会更加有的放矢。

sample :: Show a => Distribution a -> [a]
sample g = runDist (sequenceA [resize n g | n <- [0..9]]) 10 (mkStdGen 10)
 
quickCheck :: Testable a => a -> Int -> Int -> Result
quickCheck a s r = foldMap id . take 100 $ zipWith3 (a b c -> small (execProperty a b c)) (repeat (property a)) sizes rands
  where
    sizes = (+1) <$> [s..]
    rands = fst  <$> iterate (split . snd) (split (mkStdGen r))
    small (Succs x xs) = if ok x /= Just False then x else maybe x id (find ((== Just False) . ok) xs) 
 
prop_rev :: Eq a => [a] -> [a] -> Bool
prop_rev = xs ys -> reverse (xs ++ ys) == reverse xs ++ reverse ys
 
prop_gcd :: Property
prop_gcd = forAll (choose (0,60)) $ a -> forAll (choose (0,60)) ((b -> a > 1 && b > 1 ==> gcd a b /= 3) :: Int -> Property)

prop_fuse :: (Int -> Int) -> (Int -> Int) -> [Int] -> Bool
prop_fuse = f g as -> fmap g (fmap f as) == fmap (f . g) as

附录

instance Testable Property where
  property = id
 
logSeed  s r = r { seed = s }
logArg   a (Result r l c as s n) = Result r l c (maybe as (const (a:as)) r) s n
logLabel l (Result r ls c a s n) = Result r (M.insertWith (+) l 1 ls) c a s n 
 
infixr 0 ==>
(==>) :: Testable a => Bool -> a -> Property
True  ==> a = property a
False ==> _ = discard
 
label :: Testable a => String -> a -> Property
label s a = Prop $ fmap (logLabel s) <$> (runProperty (property a))
 
classify :: Testable a => Bool -> String -> a -> Property
classify True = label
classify False = const property
 
collect :: (Show a, Testable b) => a -> b -> Property
collect = label . show

execProperty :: Property -> Int -> StdGen -> Succs Result
execProperty p = go (runProperty p)
  where
    go :: FreeA Distribution a -> Int -> StdGen -> a
    go (NilA a)    _ _ = a
    go (ConsA d f) s r = let (r1, r2) = split r in (go f s r1) (runDist d s r2)

instance Arbitrary () where
  arbitrary = pure ()
   
instance Arbitrary Bool where
  arbitrary = chooseAny
  shrink b = Succs b (if b then [False] else [])
   
instance Arbitrary Char where
  arbitrary = choose ('0', '127')
  shrink c = Succs c . nub . filter (`isLT` c) $ (toLower c : smalls)
    where
      smalls = "abc123 ABCn?"
      isLT a b = measure a < measure b
      measure c = (not (isLower c), not (isDigit c), (c /= ' '), not (isUpper c), not (isSpace c), not (c `elem` "n?."), c)
   
instance Arbitrary Int where
  arbitrary = sized $ n -> choose (-n, n)
  shrink n = Succs n ([abs n | n < 0] ++ halves) where
    halves = takeWhile (x -> abs x < abs n) (0:[ n - i | i <- tail (iterate (`quot` 2) n) ])
  
instance Arbitrary a => Arbitrary [a] where
  arbitrary = listOf arbitrary
  shrink [] = Succs [] []
  shrink as = Succs as ((flip take as <$> ns) ++ shrinkOne as)
    where
      ns = successor (shrink (length as))
      shrinkOne [] = []
      shrinkOne (x:xs) = [(x':xs) | x' <- successor (shrink x)] ++ [(x:xs') | xs' <- shrinkOne xs]
   
instance (Arbitrary a, Arbitrary b) => Arbitrary (a,b) where
  arbitrary = do { a <- arbitrary; b <- arbitrary; pure (a,b) }
  shrink (a, b) = do { a' <- shrink a; b' <- shrink b; pure (a', b') }  
     
instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
  arbitrary = oneOf [Left <$> arbitrary, Right <$> arbitrary]
  shrink (Left a)  = Left  <$> shrink a
  shrink (Right a) = Right <$> shrink a  

instance Coarbitrary () where
  coarbitrary a = id
 
instance Coarbitrary Bool where
  coarbitrary a = if a then variant 0 else variant 1
 
instance Coarbitrary Int where
  coarbitrary = variant

instance Coarbitrary Char where
  coarbitrary = variant . ord
 
instance (Coarbitrary a, Coarbitrary b) => Coarbitrary (a, b) where
  coarbitrary (a, b) = coarbitrary a . coarbitrary b
 
instance (Coarbitrary a, Coarbitrary b) => Coarbitrary (Either a b) where
  coarbitrary (Left a) = variant 0 . coarbitrary a
  coarbitrary (Right b) = variant 1 . coarbitrary b
 
instance Coarbitrary a => Coarbitrary [a] where
  coarbitrary [] = variant 0
  coarbitrary (a:as) = variant 1 . coarbitrary a . coarbitrary as
  
data FreeA f a where
  NilA  :: a -> FreeA f a
  ConsA :: f x -> FreeA f (x -> a) -> FreeA f a
 
instance Functor (FreeA f) where
  fmap f (NilA a)    = NilA (f a)
  fmap f (ConsA x g) = ConsA x ((f.) <$> g)
 
instance Applicative (FreeA f) where
  pure = NilA
  (NilA f)     <*> ga = f <$> ga
  (ConsA x gf) <*> ga = ConsA x $ do { f <- gf; a <- ga; pure (flip f a) }
 
type NatF f g = forall a. f a -> g a -- f, g must be Functor
type NatA f g = forall a. f a -> g a -- f, g must be Applicative
 
hoist :: (Functor f, Applicative g) => NatF f g -> NatA (FreeA f) g
hoist t (NilA a)    = pure a
hoist t (ConsA x g) = hoist t g <*> t x

lower :: (Functor f, Applicative g) => NatA (FreeA f) g -> NatF f g
lower t = t . flip ConsA (pure id)
 
lift :: Functor f => f a -> FreeA f a
lift = lower id
 
unlift :: Applicative f => FreeA f a -> f a
unlift = hoist id

参考

  1. ^Koen Claessen and John Hughes. 2000. QuickCheck: a lightweight tool for random testing of Haskell programs. SIGPLAN Not. 35, 9 (September 2000), 268-279. DOI: https://doi.org/10.1145/357766.351266
  2. ^https://fsharpforfunandprofit.com/posts/property-based-testing-2/
  3. ^Elliott, Conal. (2009). Denotational design with type class morphisms.
  4. ^https://github.com/CppCon/CppCon2016/tree/master/Presentations/What%20C%2B%2B%20Programmers%20Need%20to%20Know%20About%20random
  5. ^http://web.mit.edu/~ezyang/Public/threemonads.pdf
  6. ^https://jaspervdj.be/posts/2015-03-13-practical-testing-in-haskell.html#the-action-trick
已标记关键词 清除标记
表情包
插入表情
评论将由博主筛选后显示,对所有人可见 | 还能输入1000个字符
©️2020 CSDN 皮肤主题: 数字20 设计师:CSDN官方博客 返回首页