{-# LANGUAGE ExistentialQuantification #-} -------------------------------------------------------------------------------- -- Properties.hs - Tests Splatch properties -- -- Authors: Christophe Poucet - -- License: See LICENSE -- Created: 10/07/2007 12:37:33 PM CEST -- -- Copyright 2007 © Christophe Poucet. All Rights Reserved. -------------------------------------------------------------------------------- module Properties where import Data.Monoid import Text.Splatch.Operation import Control.Monad import Control.Arrow (second) import Test.QuickCheck import Test.QuickCheck.Arbitrary import Text.Printf import System.Environment(getArgs) -- ----------------------------------------------------------------------------- -- Existential test cases data Test = forall a. Testable a => Test (a) instance Testable Test where property (Test x) = property x -- ----------------------------------------------------------------------------- -- QuickCheck properties for Splatch -- instance (Enum a, Num p, Arbitrary a, Arbitrary p) => Arbitrary (Operation a p) where arbitrary = sized arb where arb n = frequency [ (2, liftM2 Add letter position), (2, liftM2 Delete letter position), (1, extent Cut n), (1, extent Paste n), (n, recursive Sequence n), (n, recursive Atomic n)] recursive c n = do s <- choose (1,n) liftM c (vectorOf s (arb $ n `div` s)) position = elements . map fromInteger $ [0 .. 20] letter = elements . map (toEnum . fromEnum) $ ['a'..'c'] extent c n = do s <- choose (1,n) str <- vectorOf s letter begin <- position return $ c str begin (begin + (fromInteger . toInteger . length $ str)) -- -- * Tests -- type TestOperation = Operation Char Int -- ----------------------------------------------------------------------------- -- Inversion properties for operations -- prop_inverse_inverse_identity :: TestOperation -> Bool prop_inverse_inverse_identity op = (inverse . inverse) op == op -- ----------------------------------------------------------------------------- -- Monoidal properties for operations -- prop_mappend_left_identity :: TestOperation -> Bool prop_mappend_left_identity op = mempty `mappend` op == op prop_mappend_right_identity :: TestOperation -> Bool prop_mappend_right_identity op = op `mappend` mempty == op prop_mappend_produces_sequence :: TestOperation -> TestOperation -> Property prop_mappend_produces_sequence opA opB = (not . isEmpty $ opA) && (not . isEmpty $ opB) ==> isSequence (opA `mappend` opB) prop_mappend_top_flattens :: TestOperation -> TestOperation -> Property prop_mappend_top_flattens opA opB = isSequence opA && isSequence opB ==> isSequence opAPlusOpB && (seqLength opAPlusOpB == seqLength opA + seqLength opB) where opAPlusOpB = opA `mappend` opB seqLength = length . operations -- ----------------------------------------------------------------------------- -- Flattening properties for operations -- prop_flatten_idempotent :: TestOperation -> Bool prop_flatten_idempotent op = flattenOps flatOp == flatOp where flatOp = flattenOps op -- ----------------------------------------------------------------------------- -- Simplification properties for operations -- prop_simplify_idempotent :: TestOperation -> Bool prop_simplify_idempotent op = simplify simOp == simOp where simOp = simplify op prop_simplifyForAdd1 :: TestOperation -> Bool prop_simplifyForAdd1 op = (simplify $ Add 'a' 5 `mappend` Delete 'a' 5 `mappend` op ) == simplify op prop_simplifyForAdd2 :: TestOperation -> Bool prop_simplifyForAdd2 op = (simplify $ op `mappend` Add 'a' 5 `mappend` Delete 'a' 5 ) == simplify op prop_simplifyForAdd3 :: TestOperation -> Bool prop_simplifyForAdd3 op = (simplify $ Sequence [Add 'a' 5 `mappend` Delete 'a' 5] `mappend` op ) == simplify op prop_simplifyForAdd4 :: TestOperation -> Bool prop_simplifyForAdd4 op = (simplify $ op `mappend` Sequence [Add 'a' 5 `mappend` Delete 'a' 5]) == simplify op prop_simplifyForAdd5 :: TestOperation -> Bool prop_simplifyForAdd5 op = (simplify $ Sequence [Add 'a' 5] `mappend` Delete 'a' 5 `mappend` op ) == simplify op prop_simplifyForAdd6 :: TestOperation -> Bool prop_simplifyForAdd6 op = (simplify $ op `mappend` Sequence [Sequence [Add 'a' 5]] `mappend` Delete 'a' 5 ) == simplify op prop_simplifyForAdd7 :: TestOperation -> Bool prop_simplifyForAdd7 op = (simplify $ Atomic [Add 'a' 5 `mappend` Delete 'a' 5] `mappend` op ) == simplify op prop_simplifyForAdd8 :: TestOperation -> Bool prop_simplifyForAdd8 op = (simplify $ op `mappend` Atomic [Add 'a' 5 `mappend` Delete 'a' 5]) == simplify op prop_simplifyForAdd9 :: TestOperation -> Bool prop_simplifyForAdd9 op = (simplify $ Atomic [Add 'a' 5] `mappend` Delete 'a' 5 `mappend` op ) == simplify op prop_simplifyForAdd10 :: TestOperation -> Bool prop_simplifyForAdd10 op = (simplify $ op `mappend` Atomic [Add 'a' 5] `mappend` Delete 'a' 5 ) == simplify op prop_simplifyForDelete1 :: TestOperation -> Bool prop_simplifyForDelete1 op = (simplify $ Delete 'a' 5 `mappend` Add 'a' 5 `mappend` op ) == simplify op prop_simplifyForDelete2 :: TestOperation -> Bool prop_simplifyForDelete2 op = (simplify $ op `mappend` Delete 'a' 5 `mappend` Add 'a' 5 )== simplify op prop_conjugateByPreservesSemantics :: TestOperation -> TestOperation -> Bool prop_conjugateByPreservesSemantics opA opB = (simplify $ opB `mappend` inverse opB `mappend` opA) == simplify opA -------------------------------------------------------------------------------- -- Main test driver main :: IO () main = do args <- getArgs let n = if null args then 100 else read (head args) (results) <- mapM (\(s,a) -> printf "%-25s: " s >> a n) tests when (not . and $ results) $ fail "Not all tests passed!" where tests = [ ("inverse . inverse == id" , mytest prop_inverse_inverse_identity ), ("mappend left identity" , mytest prop_mappend_left_identity ), ("mappend right identity" , mytest prop_mappend_right_identity ), ("mappend of non-empties" , mytest prop_mappend_produces_sequence ), ("mappend top flattens" , mytest prop_mappend_top_flattens ), ("flatten is idempotent" , mytest prop_flatten_idempotent ), ("simplify is idempotent" , mytest prop_simplify_idempotent ), ("simplify add-delete1" , mytest prop_simplifyForAdd1 ), ("simplify add-delete2" , mytest prop_simplifyForAdd2 ), ("simplify add-delete3" , mytest prop_simplifyForAdd3 ), ("simplify add-delete4" , mytest prop_simplifyForAdd4 ), ("simplify add-delete5" , mytest prop_simplifyForAdd5 ), ("simplify add-delete6" , mytest prop_simplifyForAdd6 ), ("simplify add-delete7" , mytest prop_simplifyForAdd7 ), ("simplify add-delete8" , mytest prop_simplifyForAdd8 ), ("simplify add-delete9" , mytest prop_simplifyForAdd9 ), ("simplify add-delete10" , mytest prop_simplifyForAdd10 ), ("simplify delete-add1" , mytest prop_simplifyForDelete1 ), ("simplify add-delete2" , mytest prop_simplifyForDelete2 ), ("" , mytest prop_conjugateByPreservesSemantics ) ] main2 :: IO () main2 = do sample (resize 100 $ arbitrary :: Gen TestOperation) mytest :: Testable a => a -> Int -> IO Bool mytest a n = quickCheckWith n (5*n) 100 a