[Factored out some general testing functionality into TestUtilities.
Nils Anders Danielsson <nad@cs.chalmers.se>**20050527132206] {
hunk ./Test/ChasingBottoms/Nat/Tests.hs 8
+import Test.ChasingBottoms.TestUtilities
hunk ./Test/ChasingBottoms/Nat/Tests.hs 126
-tests = do
-  results <- mapM ($ testOptions) theTests
-  mapM_ (putStr . show) results
-  return $ all ok $ results
-  where
-  ok (TestOk {})       = True
-  ok (TestExausted {}) = True   -- We treat this as OK since the
-                                -- distribution of test data is displayed.
-  ok (TestFailed {})   = False
-  ok (TestAborted {})  = False
-
-  testOptions = TestOptions { no_of_tests     = 1000
-                            , length_of_tests = 0      -- No time limit.
-                            , debug_tests     = False
-                            }
-
-  theTests =
-    [ run prop_isSucc
-    , run prop_fromSucc
-    , run prop_natrec_add
-    , run prop_Nat_Enum_succ
-    , run prop_Nat_Enum_pred
-    , run prop_Nat_Eq_refl
-    , run prop_Nat_Eq_sym
-    , run prop_Nat_Eq_trans
-    , run prop_Nat_Eq_cong
-    , run prop_Nat_Eq_noteq
-    , run prop_Nat_Show
-    , run prop_Nat_Ord_refl
-    , run prop_Nat_Ord_antisym
-    , run prop_Nat_Ord_trans
-    , run prop_Nat_mul_iterated_sum
-    , run prop_Nat_plus_assoc
-    , run prop_Nat_plus_comm
-    , run prop_Nat_mul_assoc
-    , run prop_Nat_mul_comm
-    , run prop_Nat_mul_plus_left_dist
-    , run prop_Nat_mul_plus_zero
-    , run prop_Nat_mul_mul_unit
-    , run prop_Nat_minus
-    , run prop_Nat_signum_abs
-    , run prop_Nat_signum_zero
-    , run prop_Nat_fromInteger_plus
-    , run prop_Nat_fromInteger_mul
-    , run prop_Nat_to_from
-    , run prop_Nat_from_to
-    , run prop_Nat_quotRem
-    , run prop_Nat_divMod
-    , run prop_Nat_quot_rem
-    , run prop_Nat_div_mod
-    , run prop_Nat_toRational
-    ]
-
--- | Show instance for 'TestResult' suitable for the tests run above.
-
-instance Show TestResult where
-  show (TestOk _ n args) =
-    "OK, passed " ++ show n ++ " tests.\n" ++ showArgs args
-  show (TestExausted _ n args) =
-    "Arguments exhausted after " ++ show n ++ " tests.\n" ++ showArgs args
-  show (TestFailed _ _) = "Test failed.\n"
-  show (TestAborted _) = "Test resulted in exception.\n"
-
--- | Helper function for the 'TestResult' 'Show' instance.
-
-showArgs :: [[String]] -> String
-showArgs args
-  | all null args = ""
-  | otherwise     = unlines . map (indent . concat . intersperse ", ") $ args
-  where indent = ("  " ++)
+tests = runQuickCheckTests
+          [ run prop_isSucc
+          , run prop_fromSucc
+          , run prop_natrec_add
+          , run prop_Nat_Enum_succ
+          , run prop_Nat_Enum_pred
+          , run prop_Nat_Eq_refl
+          , run prop_Nat_Eq_sym
+          , run prop_Nat_Eq_trans
+          , run prop_Nat_Eq_cong
+          , run prop_Nat_Eq_noteq
+          , run prop_Nat_Show
+          , run prop_Nat_Ord_refl
+          , run prop_Nat_Ord_antisym
+          , run prop_Nat_Ord_trans
+          , run prop_Nat_mul_iterated_sum
+          , run prop_Nat_plus_assoc
+          , run prop_Nat_plus_comm
+          , run prop_Nat_mul_assoc
+          , run prop_Nat_mul_comm
+          , run prop_Nat_mul_plus_left_dist
+          , run prop_Nat_mul_plus_zero
+          , run prop_Nat_mul_mul_unit
+          , run prop_Nat_minus
+          , run prop_Nat_signum_abs
+          , run prop_Nat_signum_zero
+          , run prop_Nat_fromInteger_plus
+          , run prop_Nat_fromInteger_mul
+          , run prop_Nat_to_from
+          , run prop_Nat_from_to
+          , run prop_Nat_quotRem
+          , run prop_Nat_divMod
+          , run prop_Nat_quot_rem
+          , run prop_Nat_div_mod
+          , run prop_Nat_toRational
+          ]
addfile ./Test/ChasingBottoms/TestUtilities.hs
hunk ./Test/ChasingBottoms/TestUtilities.hs 1
+{-# OPTIONS -cpp #-}
+
+-- | Some utilities that are part of the testing framework.
+
+module Test.ChasingBottoms.TestUtilities (runQuickCheckTests) where
+
+#if __GLASGOW_HASKELL__ <= 602
+import Debug.QuickCheck
+import Debug.QuickCheck.Batch
+#else
+import Test.QuickCheck
+import Test.QuickCheck.Batch
+#endif
+import Data.List
+
+------------------------------------------------------------------------
+-- Batch execution of QuickCheck tests
+
+-- | Runs a bunch of QuickCheck tests, printing suitable information
+-- to standard output. Returns 'True' if no tests fail. Note that a
+-- test where the inputs are exhausted is considered to have
+-- succeeded.
+
+runQuickCheckTests :: [TestOptions -> IO TestResult]
+                      -- ^ Create the tests in this list from ordinary
+                      -- QuickCheck tests by using 'run'.
+                      -> IO Bool
+runQuickCheckTests tests = do
+  results <- mapM ($ testOptions) tests
+  mapM_ (putStr . show) results
+  return $ all ok $ results
+  where
+  ok (TestOk {})       = True
+  ok (TestExausted {}) = True   -- We treat this as OK since the
+                                -- distribution of test data is displayed.
+  ok (TestFailed {})   = False
+  ok (TestAborted {})  = False
+
+  testOptions = TestOptions { no_of_tests     = 1000
+                            , length_of_tests = 0      -- No time limit.
+                            , debug_tests     = False
+                            }
+
+-- | Show instance for 'TestResult' suitable for 'runQuickCheckTests'.
+
+instance Show TestResult where
+  show (TestOk _ n args) =
+    "OK, passed " ++ show n ++ " tests.\n" ++ showArgs args
+  show (TestExausted _ n args) =
+    "Arguments exhausted after " ++ show n ++ " tests.\n" ++ showArgs args
+  show (TestFailed _ _) = "Test failed.\n"
+  show (TestAborted _) = "Test resulted in exception.\n"
+
+-- | Helper function for the 'TestResult' 'Show' instance.
+
+showArgs :: [[String]] -> String
+showArgs args
+  | all null args = ""
+  | otherwise     = unlines . map (indent . concat . intersperse ", ") $ args
+  where indent = ("  " ++)
}