perdure 0.1.1 → 0.1.2
raw patch · 5 files changed
+346/−2 lines, 5 filesdep ~perdure
Dependency ranges changed: perdure
Files
- exe-src/Database/Perdure/TestMap.hs +30/−0
- exe-src/Database/Perdure/TestPersistent.hs +137/−0
- exe-src/Database/Perdure/TestState.hs +131/−0
- exe-src/Database/Perdure/TestStoreFile.hs +42/−0
- perdure.cabal +6/−2
+ exe-src/Database/Perdure/TestMap.hs view
@@ -0,0 +1,30 @@+{- +Copyright 2010-2012 Cognimeta Inc. + +Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in +compliance with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software distributed under the License is +distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express +or implied. See the License for the specific language governing permissions and limitations under the License. +-} + +module Database.Perdure.TestMap( + testMap + ) where + +import Prelude hiding (null, lookup) +import Database.Perdure.Data.Map +import Test.QuickCheck +import Data.List(foldl') + +testMap :: [String] -> IO () +testMap _ = + (quickCheckWith (Args Nothing n n n True) $ insertList [1 .. k] empty == insertList (reverse [1 .. k]) empty) >> + (quickCheckWith (Args Nothing n n n True) $ deleteList [1 .. k] (insertList (reverse [1 .. k]) $ insertList [1 .. k] empty) == empty) where + insertList l m = foldl' (\z n -> insert n n z) m l + deleteList l m = foldl' (\z n -> delete n z) m l + n = 5 + k = n * 10000
+ exe-src/Database/Perdure/TestPersistent.hs view
@@ -0,0 +1,137 @@+{- +Copyright 2010-2012 Cognimeta Inc. + +Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in +compliance with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software distributed under the License is +distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express +or implied. See the License for the specific language governing permissions and limitations under the License. +-} + +{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, GeneralizedNewtypeDeriving, TypeFamilies, TupleSections, DeriveDataTypeable #-} + +-- To view the modules dependencies in Database.Perdure: +-- graphmod Database.Perdure.TestPersistent -R Cgm.Data -R Cgm.System -R Cgm.Control -r Cgm.Prelude -r Profile | dot -Tpng -oCgm_Persist.png + +module Database.Perdure.TestPersistent ( + testPersistentMap, + testPersistent, + testSeqPersistent + ) where + +import Prelude() +import Cgm.Prelude +import Control.Exception +import Control.DeepSeq +import Data.Ix +import Data.Word +import Data.Functor.Identity +import Test.QuickCheck +import Test.QuickCheck.Property +import Database.Perdure.State +import Database.Perdure.SizeRef +import Database.Perdure.RNF +import Database.Perdure.ReplicatedFile +import Cgm.Control.Combinators +import Database.Perdure.Count(Address) +import Cgm.System.Endian +import Debug.Trace +import Cgm.Control.Profile +import qualified Control.Monad.State.Strict as Std +import Cgm.Control.Monad.State +import Cgm.Data.Either +import Control.Monad.Error +import qualified Database.Perdure.Data.Map as PMap +import Database.Perdure.Ref +import Cgm.Data.Super +import Database.Perdure.RNF +import Database.Perdure.CSerializer +import Database.Perdure.CDeserializer +import Database.Perdure.RNF +import Cgm.Data.Nat +import Cgm.Data.WordN +import Database.Perdure.Data.MapMultiset +import Database.Perdure.SpaceTree +import Control.Monad.Random +import Control.Concurrent.MVar +import Cgm.Data.Typeable +import Database.Perdure.TestState +import Database.Perdure + +-- | We test with some type of tree with variable arity and nodes of various sizes. +data TestTree a = Leaf a | Node [a] [SRef (TestTree a)] deriving (Show, Eq, Typeable) + +-- | Some regular values for TestTree of growing complexity. +generateTestTree :: (Persistent a, Num a, Ix a) => Int -> TestTree a +generateTestTree n = + if n==0 + then Leaf 0 + else Node (range (0, fromIntegral n)) $ ref <$> generateTestTree <$> range (0, n - 1) + +instance (Persistent a, Typeable a, Arbitrary a) => Arbitrary (TestTree a) where + arbitrary = sized g where + g n = bool (Leaf <$> arbitrary) (Node <$> listOf arbitrary <*> promote ((ref <$>) . g <$> range (0, n - 1))) $ n > 0 + +-- | We establish a default persister for TestTree, which will simply persist it according to the internal structure. +instance (Persistent a, Typeable a) => Persistent (TestTree a) where persister = structureMap persister + +testInitState :: (Typeable a, Persistent a) => ReplicatedFile -> a -> IO (PState a) +testInitState f a = fmap defaultRootLocation (newCachedFile 1000 f) >>= \l -> + initState l + (addSpan (sortedPair (2 * apply super (getLen rootAllocSize)) $ 100 * 1000000) emptySpace) + a + +writeReadTestFile :: (Eq a, Persistent a, Typeable a) => a -> String -> IO Bool +writeReadTestFile a name = fmap fromRight $ runErrorT $ withFileStoreFile name $ (. (ReplicatedFile . pure)) $ \f -> do + putCpuTime "Data creation" $ evaluate $ prnf persister a + putCpuTime "Write time" $ + newCachedFile 1000 f >>= + createPVar a (mega 100) . defaultRootLocation + putCpuTime "Read time" $ + newCachedFile 1000 f >>= + fmap (fromMaybe $ error "Read error") . openPVar . defaultRootLocation >>= \v -> + updatePVar v $ get >>= liftIO . evaluate . (a ==) + + +testPersistent :: a -> IO () +testPersistent args = quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $ + writeReadTestFile (generateTestTree 15 :: TestTree Word32) "testPersistent.dag" + +testPersistentMap :: a -> IO () +testPersistentMap args = quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $ + writeReadTestFile (foldl' (\z n -> PMap.insert n n z) PMap.empty [(1 :: Integer) .. 10000]) "testPersistentMap.dag" + +propPersister :: forall a p. (Show a, Eq a) => Persister a -> a -> Property +propPersister p a = morallyDubiousIOProperty $ return $ (== a) $ + deserializeFromFullArray (unsafeSeqDeserializer p) $ fullArrayRange $ (id :: Id (PrimArray Pinned Word64)) $ serializeToArray p a + +propPersistent :: (Show a, Eq a, Persistent a) => a -> Property +propPersistent = propPersister persister + +myCheck :: Testable p => Int -> p -> IO () +myCheck n = quickCheckWith (Args Nothing n n n True) + +testSeqPersistent :: a -> IO () +testSeqPersistent args = do + myCheck 5 $ propPersistent . (id :: Id Bool) + myCheck 50 $ propPersistent . (id :: Id Word8) + myCheck 50 $ propPersistent . (id :: Id (Word8, Word8)) + myCheck 50 $ propPersistent . (id :: Id Word16) + myCheck 50 $ propPersistent . (id :: Id Word32) + myCheck 50 $ propPersistent . (id :: Id (Word32, Word32)) + myCheck 50 $ propPersistent . (id :: Id Word64) + myCheck 50 $ propPersistent . (id :: Id (Word8, Word64, Word8)) + myCheck 50 $ propPersistent . (id :: Id (RWord64 D63, Word64)) + myCheck 50 $ propPersistent . (id :: Id (RWord64 D32, Word64)) + myCheck 50 $ propPersistent . (id :: Id (Word8, Word16, Word32, Word64)) + myCheck 10 $ propPersistent . (id :: Id [Bool]) + myCheck 9 $ propPersistent . (id :: Id (Maybe Bool)) + myCheck 16 $ propPersistent . (id :: Id (Either Bool Bool)) + myCheck 50 $ propPersistent . (id :: Id ((Either (Either Word8 Word16) (Either Word32 Word64)), Word8)) + myCheck 20 $ propPersister ((persister >. (persister :: Persister (RWord8 D7))) &. persister) . (id :: Id (Word8, Word32)) + myCheck 20 $ propPersister ((persister >. (persister :: Persister (RWord64 D63))) &. persister) . (id :: Id (Word64, Word32)) + +deriveStructured ''TestTree
+ exe-src/Database/Perdure/TestState.hs view
@@ -0,0 +1,131 @@+{-+Copyright 2010-2012 Cognimeta Inc.++Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in+compliance with the License. You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software distributed under the License is+distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express+or implied. See the License for the specific language governing permissions and limitations under the License.+-}++{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, GeneralizedNewtypeDeriving, TypeFamilies, TupleSections, DeriveDataTypeable #-}++module Database.Perdure.TestState (+ testStates,+ testStatesDag,+ testStatesDestroysRaw1,+ SRef(..),+ mega+ ) where++import Prelude()+import Cgm.Prelude+import Control.Exception+import Control.DeepSeq+import Data.Ix+import Data.Word+import Data.Functor.Identity+import Test.QuickCheck+import Test.QuickCheck.Property+import Database.Perdure.State+import Database.Perdure.SizeRef+import Database.Perdure.RNF+import Database.Perdure.ReplicatedFile+import Cgm.Control.Combinators+import Database.Perdure.Count(Address)+import Cgm.System.Endian+import Debug.Trace+import Cgm.Control.Profile+import qualified Control.Monad.State.Strict as Std+import Cgm.Control.Monad.State+import Cgm.Data.Either+import Control.Monad.Error hiding (sequence_)+import qualified Database.Perdure.Data.Map as PMap+import Database.Perdure.Ref+import Cgm.Data.Super+import Database.Perdure.RNF+import Database.Perdure.CSerializer+import Database.Perdure.CDeserializer+import Database.Perdure.RNF+import Cgm.Data.Nat+import Cgm.Data.WordN+import Database.Perdure.Data.MapMultiset+import Database.Perdure.SpaceTree+import Control.Monad.Random+import Control.Concurrent.MVar+import Cgm.Data.Typeable+import Database.Perdure++-- | A reference type which automatically puts its referent is a separately loadable allocation when its size is >= 2^12 bytes (4K)+type SRef = CRef (SizeRef D12)++-- | A list with an SRef that automatically cuts it up into separately loadable segments of more than 4K.+data RList a = EmptyRList | ConsRList a (SRef (RList a)) deriving (Show, Typeable)+instance (Persistent a, Typeable a) => Persistent (RList a) where persister = structureMap persister++testStates :: a -> IO ()+testStates _ =+ quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $ (>>= either fail return) $ runErrorT $ (True <$) $+ withReplicatedFiles "testStates" testStatesF++testStatesF :: ReplicatedFile -> IO ()+testStatesF f =+ newCachedFile 1000 f >>=+ createPVar (EmptyRList :: RList Word32) (mega 100) . defaultRootLocation >>= \v ->+ for_ [0 .. 19] $ \c -> do+ print c+ updatePVar v $ replicateM_ 5000 $ modify $ ConsRList (c :: Word32) . ref++withReplicatedFiles :: String -> (ReplicatedFile -> IO a) -> ErrorT String IO a+withReplicatedFiles n z = ErrorT $ fmap join $+ runErrorT $ withFileStoreFile (n ++ "0.dag") $ \f0 ->+ runErrorT $ withFileStoreFile (n ++ "1.dag") $ \f1 ->+ z $ ReplicatedFile [f0, f1]++-- | Here we perform the test on a (single) raw device+testStatesDestroysRaw1 :: a -> IO ()+testStatesDestroysRaw1 _ =+ quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $ (>>= either fail return) $ runErrorT $ (True <$) $+ withRawDeviceStoreFile "/dev/raw/raw1" $ (. (ReplicatedFile . pure)) $ testStatesF++----------++-- | A Rose tree of empty nodes, each separately loadable (here we do not use SizeRef), to test complex acyclic graphs.+data Dag = Dag (CDRef [Dag]) deriving Typeable++dagChildren :: Dag -> [Dag]+dagChildren (Dag r) = deref r++instance Persistent Dag where persister = structureMap persister++-- Selects an element at random in the dag, and can also return Nothing+dagElem :: RandomGen g => Dag -> Rand g (Maybe Dag)+dagElem d = getRandomR (0 :: Int, 9) >>= \r -> if r == 0 then return $ Just d else + let c = dagChildren d + in if null c then return Nothing else getRandomR (0, length c - 1) >>= dagElem . (c !!)+ +-- Like dagElem but when Nothing would be returned d is returned. +dagElem' :: RandomGen g => Dag -> Rand g Dag+dagElem' d = fmap (fromMaybe d) $ dagElem d++dagBuild :: RandomGen g => Dag -> Rand g Dag+dagBuild d = fmap (Dag . ref) $ Cgm.Prelude.sequence $ replicate 10 (dagElem' d)++testStatesDag :: a -> IO ()+testStatesDag _ =+ quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $ (>>= either fail return) $ runErrorT $ (True <$) $+ withReplicatedFiles "testStatesDag" $ \f -> + newCachedFile 1000 f >>=+ createPVar (Dag $ ref []) (mega 100) . defaultRootLocation >>= \v ->+ for_ [0 .. 1999] $ \c -> do+ print c+ updatePVar v $ StateT $ fmap (((),) . Just) . evalRandIO . dagBuild++mega :: Num a => a -> a+mega = (1000000 *)++deriveStructured ''RList+deriveStructured ''Dag
+ exe-src/Database/Perdure/TestStoreFile.hs view
@@ -0,0 +1,42 @@+{- +Copyright 2010-2012 Cognimeta Inc. + +Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in +compliance with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software distributed under the License is +distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express +or implied. See the License for the specific language governing permissions and limitations under the License. +-} + +{-# LANGUAGE ScopedTypeVariables #-} + +module Database.Perdure.TestStoreFile ( + testStoreFile + ) where + +import Data.Word +import Foreign.Ptr +import Foreign.Marshal.Array +import Database.Perdure.StoreFile +import Database.Perdure.LocalStoreFile +import Database.Perdure.SingleStoreFile +import Cgm.Data.Word +import Cgm.Data.Either +import Cgm.Data.Len +import Cgm.Data.Array +import Cgm.System.Endian +import Control.Exception +import Control.Monad.Error + +testStoreFile :: [String] -> IO () +testStoreFile args = fmap fromRight $ runErrorT $ withFileStoreFile "testStoreFile.dag" $ (. SingleStoreFile) $ + \f -> do + let a :: PrimArray Pinned Word32 = mkArrayWith 130000 $ fromIntegral . getLen + r <- storeFileWrite f 0 platformWordEndianness [a] + storeFileFullBarrier f + ma <- await1 $ storeFileRead f r platformWordEndianness Validator0 + assert (ma == Just (fullArrayRange a)) $ return () +
perdure.cabal view
@@ -1,5 +1,5 @@ Name: perdure-version: 0.1.1+version: 0.1.2 cabal-version: >= 1.8 build-type: Simple license: OtherLicense@@ -228,6 +228,10 @@ hs-source-dirs: exe-src main-is: Main.hs other-modules: + Database.Perdure.TestMap+ Database.Perdure.TestPersistent+ Database.Perdure.TestState+ Database.Perdure.TestStoreFile build-depends: base >= 4.5.0.0, template-haskell >= 2.7.0.0,@@ -235,7 +239,7 @@ mtl >= 2.1.2, deepseq, QuickCheck >=2.4.0.1,- perdure >= 0.1.1,+ perdure >= 0.1.2, transformers >= 0.3.0.0, bytestring >= 0.9.2.1, containers >= 0.4.2.1,