Migrate rest to tasty

filepath.cabal

@@ -117,7 +117,8 @@ test-suite filepath-tests
     , bytestring  >=0.11.3.0
     , filepath
     , os-string   >=2.0.1
-    , QuickCheck  >=2.7      && <2.15
+    , tasty
+    , tasty-quickcheck
 
   default-language: Haskell2010
   ghc-options:      -Wall
@@ -142,7 +143,6 @@ test-suite filepath-equivalent-tests
     , generic-random
     , generic-deriving
     , os-string   >=2.0.1
-    , QuickCheck  >=2.7      && <2.15
     , tasty
     , tasty-quickcheck
 
@@ -163,7 +163,6 @@ test-suite abstract-filepath
     , deepseq
     , filepath
     , os-string   >=2.0.1
-    , QuickCheck  >=2.7      && <2.15
     , quickcheck-classes-base ^>=0.6.2
     , tasty
     , tasty-quickcheck

tests/TestUtil.hs

@@ -4,12 +4,12 @@
 
 module TestUtil(
     module TestUtil,
-    module Test.QuickCheck,
+    module Test.Tasty.QuickCheck,
     module Data.List,
     module Data.Maybe
     ) where
 
-import Test.QuickCheck hiding ((==>))
+import Test.Tasty.QuickCheck hiding ((==>))
 import Data.ByteString.Short (ShortByteString)
 import Data.List
 import Data.Maybe
@@ -29,7 +29,6 @@ import System.OsString.Encoding.Internal
 import GHC.IO.Encoding.UTF16 ( mkUTF16le )
 import GHC.IO.Encoding.UTF8 ( mkUTF8 )
 import GHC.IO.Encoding.Failure
-import System.Environment
 
 
 infixr 0 ==>
@@ -158,31 +157,3 @@ instance Arbitrary PosixChar where
   arbitrary = PW <$> arbitrary
 #endif
 
-runTests :: [(String, Property)] -> IO ()
-runTests tests = do
-    args <- getArgs
-    let count   = case args of i:_   -> read i; _ -> 10000
-    let testNum = case args of
-                    _:i:_
-                      | let num = read i
-                      , num < 0    -> drop (negate num) tests
-                      | let num = read i
-                      , num > 0    -> take num          tests
-                      | otherwise  -> []
-                    _ -> tests
-    putStrLn $ "Testing with " ++ show count ++ " repetitions"
-    let total' = length testNum
-    let showOutput x = show x{output=""} ++ "\n" ++ output x
-    bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do
-        putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg
-        res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
-        case res of
-            Success{} -> pure Nothing
-            bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad)
-    if null bad then
-        putStrLn $ "Success, " ++ show total' ++ " tests passed"
-     else do
-        putStrLn $ show (length bad) ++ " FAILURES\n"
-        forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) ->
-            putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
-        fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"

tests/abstract-filepath/Arbitrary.hs

@@ -10,7 +10,7 @@ import qualified System.OsString.Posix as Posix
 import qualified System.OsString.Windows as Windows
 import Data.ByteString ( ByteString )
 import qualified Data.ByteString as ByteString
-import Test.QuickCheck
+import Test.Tasty.QuickCheck
 
 
 instance Arbitrary OsString where

tests/abstract-filepath/OsPathSpec.hs

@@ -20,7 +20,6 @@ import System.OsString.Windows as WindowsS hiding (map)
 import Control.Exception
 import Data.ByteString ( ByteString )
 import qualified Data.ByteString as BS
-import Test.QuickCheck
 import qualified Test.QuickCheck.Classes.Base as QC
 import GHC.IO.Encoding.UTF8 ( mkUTF8 )
 import GHC.IO.Encoding.UTF16 ( mkUTF16le )

tests/filepath-tests/Test.hs

@@ -1,39 +1,9 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Main where
 
-import System.Environment
-import TestGen
-import Control.Monad
-import Data.Maybe
-import Test.QuickCheck
-
+import TestGen (tests)
+import Test.Tasty
+import Test.Tasty.QuickCheck
 
 main :: IO ()
-main = do
-    args <- getArgs
-    let count   = case args of i:_   -> read i; _ -> 10000
-    let testNum = case args of
-                    _:i:_
-                      | let num = read i
-                      , num < 0    -> drop (negate num) tests
-                      | let num = read i
-                      , num > 0    -> take num          tests
-                      | otherwise  -> []
-                    _ -> tests
-    putStrLn $ "Testing with " ++ show count ++ " repetitions"
-    let total' = length testNum
-    let showOutput x = show x{output=""} ++ "\n" ++ output x
-    bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do
-        putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg
-        res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
-        case res of
-            Success{} -> pure Nothing
-            bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad)
-    if null bad then
-        putStrLn $ "Success, " ++ show total' ++ " tests passed"
-     else do
-        putStrLn $ show (length bad) ++ " FAILURES\n"
-        forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) ->
-            putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
-        fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"
+main = defaultMain $ testProperties "doctests" tests
+