-------------------------------------------------------------------------
--  
--         QCStoreTest.hs   
--  
--         QuickCheck tests for stores.                         --                                  
--         (c) Addison-Wesley, 1996-2011.                   
--  
-------------------------------------------------------------------------


module QCStoreTest  where

import StoreTest
import Test.QuickCheck

prop_Update1 :: Char -> Integer -> Store -> Bool

prop_Update1 :: Char -> Integer -> Store -> Bool
prop_Update1 Char
ch Integer
int Store
st =
    Store -> Char -> Integer
value (Store -> Char -> Integer -> Store
update Store
st Char
ch Integer
int) Char
ch Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
int

prop_Update2 :: Char -> Char -> Integer -> Store -> Bool

prop_Update2 :: Char -> Char -> Integer -> Store -> Bool
prop_Update2 Char
ch1 Char
ch2 Integer
int Store
st =
    Char
ch1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
ch2 Bool -> Bool -> Bool
|| Store -> Char -> Integer
value (Store -> Char -> Integer -> Store
update Store
st Char
ch2 Integer
int) Char
ch1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Store -> Char -> Integer
value Store
st Char
ch1

prop_Initial :: Char -> Bool

prop_Initial :: Char -> Bool
prop_Initial Char
ch =
   Store -> Char -> Integer
value Store
initial Char
ch Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0