Bryan O'Sullivan avatar Bryan O'Sullivan committed f731a98

Do a tiny amount of actual testing

Comments (0)

Files changed (3)

---module Bench where
-
 import BenchUtils
 import System.Mem 
 import Control.Concurrent
 import Data.Char
-import Data.Array.IArray
 import System.CPUTime
 import System.IO
 import System.IO.Unsafe

tests/Properties.hs

 import Text.Show.Functions
 
 import Prelude 
+import Text.Printf
+import System.Environment
+import Control.Applicative
+import Control.Monad
 import qualified Data.Text as T
 import Data.Text (pack,unpack)
 import qualified Data.Text.Fusion as S
 prop_elemIndex c s   = L.elemIndex c s == T.elemIndex c (pack s)
 prop_zipWith c s1 s2 = L.zipWith c s1 s2 == unpack (T.zipWith c (pack s1) (pack s2))
 prop_words s         = L.words s == L.map unpack (T.words (pack s))
+
+main = run tests =<< getArgs
+
+run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
+run tests args = do
+  let n = case args of
+            [s] -> read s
+            []  -> 100
+            _   -> error "too many arguments"
+  (results,passed) <- unzip <$> mapM (\(s,a) -> printf "%-40s: " s >> a n) tests
+  printf "Passed %d tests!\n" (sum passed)
+  when (not . and $ results) $
+      fail "Not all tests passed!"
+
+tests :: [(String, Int -> IO (Bool, Int))]
+tests = [("prop_pack_unpack", mytest prop_pack_unpack)]

tests/QuickCheckUtils.hs

 module QuickCheckUtils where
 
+import Data.List
+import qualified Data.Text as T
+import System.IO
+import System.Random
 import Test.QuickCheck
-import Test.QuickCheck.Batch
-
-import Data.Char
-
-import Data.Text
-import Data.Text.Internal
 
 instance Arbitrary Char where
     arbitrary    = oneof [choose ('\0','\55295'), choose ('\57334','\1114111')]
-    coarbitrary c = variant (ord c `rem` 4)
+    coarbitrary c = variant (fromEnum c `rem` 4)
 
-instance Arbitrary Text where
-    arbitrary     = pack `fmap` arbitrary
-    coarbitrary s = coarbitrary (unpack s)
+instance Arbitrary T.Text where
+    arbitrary     = T.pack `fmap` arbitrary
+    coarbitrary s = coarbitrary (T.unpack s)
+
+debug = False
+
+mytest :: Testable a => a -> Int -> IO (Bool, Int)
+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 (Bool, Int)
+mycheck config a =
+  do rnd <- newStdGen
+     mytests config (evaluate a) rnd 0 0 []
+
+mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)
+mytests config gen rnd0 ntest nfail stamps
+    | ntest == configMaxTest config = done "OK," ntest stamps >> return (True, ntest)
+    | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)
+    | 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 >> return (False, ntest)
+     where
+      result      = generate (configSize config ntest) rnd2 gen
+      (rnd1,rnd2) = split rnd0
+
+done :: String -> Int -> [[String]] -> IO ()
+done mesg ntest stamps =
+  do 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) ++ "%"
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.