move tests into subdir

darcs-hash:20070308120448-9c5c1-f29440447ae30679dd8c8dbd53efea1f906cbce3

1 files changed, 4 insertions, 171 deletions

diff --git a/StackSet.hs b/StackSet.hs
index 7c388f2..9f8cdb6 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS -cpp #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  StackSet
@@ -17,13 +16,15 @@
 
 module StackSet (
 
-    StackSet,          -- abstract
+    StackSet,           -- abstract
 
     -- * Introduction
     empty,              -- :: Int -> StackSet a
     fromList,           -- :: [[a]] -> StackSet a
+    toList,             -- :: StackSet -> [[a]]
 
     -- * Inspection
+    size,               -- :: StackSet -> Int
     member,             -- :: Ord a => a -> StackSet a -> Bool
     peek,               -- :: StackSet a -> Maybe a
     stack,              -- :: StackSet a -> [a]
@@ -38,6 +39,7 @@ module StackSet (
 
     -- * Modification to arbitrary stacks
     delete,             -- :: Ord a => a -> StackSet a -> StackSet a
+    insert,             -- :: Ord a => a -> Int -> StackSet a -> StackSet a
 
     -- * Changing which stack is 'current'
     view,               -- :: Int -> StackSet a -> StackSet a
@@ -50,17 +52,6 @@ import qualified Data.List     as L
 import qualified Data.Map      as M
 import qualified Data.Sequence as S
 
--- All for testing:
-#if TESTING
-import Control.Exception    (assert)
-import Control.Monad
-import Test.QuickCheck
-import System.IO
-import System.Random
-import Text.Printf
-import Data.List            (sort,group,sort,intersperse)
-#endif
-
 ------------------------------------------------------------------------
 
 -- | The StackSet data structure. A table of stacks, with a cursor
@@ -223,161 +214,3 @@ delete k w = case M.lookup k (cache w) of
 unsafeModify :: ([a] -> [a]) -> StackSet a -> StackSet a
 unsafeModify f w = w { stacks = S.adjust f (cursor w) (stacks w) }
 
-
-#if TESTING
--- ---------------------------------------------------------------------
--- QuickCheck properties
-
--- | Height of stack 'n'
-height :: Int -> StackSet a -> Int
-height i w = length (S.index (stacks w) i)
-
--- build (non-empty) StackSets with between 1 and 100 stacks
-instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where
-    arbitrary = do
-        sz <- choose (1,20)
-        n  <- choose (0,sz-1)
-        ls <- vector sz
-        return $ fromList (n,ls)
-    coarbitrary = error "no coarbitrary for StackSet"
-
-prop_id x = fromList (toList x) == x
-    where _ = x :: StackSet Int
-
-prop_uniq_pushpop i x = not (member i x) ==>
-    (pop . push i) x == x
-    where _ = x :: StackSet Int
-
-prop_pushpop i x =
-    (pop . push i) x == delete i x
-    where _ = x :: StackSet Int
-
--- popping an empty stack leaves an empty stack
-prop_popempty x = height (cursor x) x == 0 ==> pop x == x
-    where _ = x :: StackSet Int
-
-prop_popone   x =
-    let l = height (cursor x) x
-    in l > 0 ==> height (cursor x) (pop x) == l-1
-    where _ = x :: StackSet Int
-
--- check the cache of the size works
-prop_size_length x =
-    size x == S.length (stacks x)
-    where _ = x :: StackSet Int
-
-prop_delete_uniq i x = not (member i x) ==>
-    delete i x == x
-    where _ = x :: StackSet Int
-
-prop_delete2 i x =
-    delete i x == delete i (delete i x)
-    where _ = x :: StackSet Int
-
-prop_uniq_insertdelete i n x = not (member i x) ==>
-    delete i (insert i n x) == x
-    where _ = x :: StackSet Int
-
-prop_insertdelete i n x =
-    delete i (insert i n x) == delete i x
-    where _ = x :: StackSet Int
-
-prop_rotaterotate x   = rotate LT (rotate GT x) == x
-    where _ = x :: StackSet Int
-
-prop_viewview r  x   =
-    let n  = cursor x
-        sz = size x
-        i  = r `mod` sz
-    in
-        view n (view i x) == x
-
-    where _ = x :: StackSet Int
-
-prop_shiftshift r x =
-    let n  = cursor x
-    in
-        shift n (shift r x) == x
-    where _ = x :: StackSet Int
-
-------------------------------------------------------------------------
-
-testall :: IO ()
-testall = mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
- where
-    n = 100
-
-    tests =
-        [("fromList.toList  ", mytest prop_id)
-        ,("pop/push         ", mytest prop_uniq_pushpop)
-        ,("pop/push/delete  ", mytest prop_pushpop)
-        ,("pop/empty        ", mytest prop_popempty)
-        ,("size/length      ", mytest prop_size_length)
-        ,("delete/not.member", mytest prop_delete_uniq)
-        ,("delete idempotent", mytest prop_delete2)
-        ,("delete/insert new", mytest prop_uniq_insertdelete)
-        ,("delete/insert    ", mytest prop_insertdelete)
-        ,("rotate/rotate    ", mytest prop_rotaterotate)
-        ,("pop one          ", mytest prop_popone)
-        ,("view/view        ", mytest prop_viewview)
-        ]
-
-debug = False
-
-mytest :: Testable a => a -> Int -> IO ()
-mytest a n = mycheck defaultConfig
-    { configMaxTest=n
-    , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
-
-mycheck :: Testable a => Config -> a -> IO ()
-mycheck config a = do
-    rnd <- newStdGen
-    mytests config (evaluate a) rnd 0 0 []
-
-mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()
-mytests config gen rnd0 ntest nfail stamps
-    | ntest == configMaxTest config = do done "OK," ntest stamps
-    | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
-    | otherwise               =
-      do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
-         case ok result of
-           Nothing    ->
-             mytests config gen rnd1 ntest (nfail+1) stamps
-           Just True  ->
-             mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
-           Just False ->
-             putStr ( "Falsifiable after "
-                   ++ show ntest
-                   ++ " tests:\n"
-                   ++ unlines (arguments result)
-                    ) >> hFlush stdout
-     where
-      result      = generate (configSize config ntest) rnd2 gen
-      (rnd1,rnd2) = split rnd0
-
-done :: String -> Int -> [[String]] -> IO ()
-done mesg ntest stamps = putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
-  where
-    table = display
-            . map entry
-            . reverse
-            . sort
-            . map pairLength
-            . group
-            . sort
-            . filter (not . null)
-            $ stamps
-
-    display []  = ".\n"
-    display [x] = " (" ++ x ++ ").\n"
-    display xs  = ".\n" ++ unlines (map (++ ".") xs)
-
-    pairLength xss@(xs:_) = (length xss, xs)
-    entry (n, xs)         = percentage n ntest
-                       ++ " "
-                       ++ concat (intersperse ", " xs)
-
-    percentage n m        = show ((100 * n) `div` m) ++ "%"
-
-------------------------------------------------------------------------
-#endif