From d651a599766faa2f18d42f90f7eb1d0c4c2326f3 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 27 Jan 2024 18:16:25 +0800 Subject: [PATCH] Migrate rest to tasty --- filepath.cabal | 5 ++-- tests/TestUtil.hs | 33 ++-------------------- tests/abstract-filepath/Arbitrary.hs | 2 +- tests/abstract-filepath/OsPathSpec.hs | 1 - tests/filepath-tests/Test.hs | 40 ++++----------------------- 5 files changed, 10 insertions(+), 71 deletions(-) diff --git a/filepath.cabal b/filepath.cabal index d9ff661c..1fe1da50 100644 --- a/filepath.cabal +++ b/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 diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs index 8365c930..f238f10e 100644 --- a/tests/TestUtil.hs +++ b/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" diff --git a/tests/abstract-filepath/Arbitrary.hs b/tests/abstract-filepath/Arbitrary.hs index 7918eb16..57535234 100644 --- a/tests/abstract-filepath/Arbitrary.hs +++ b/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 diff --git a/tests/abstract-filepath/OsPathSpec.hs b/tests/abstract-filepath/OsPathSpec.hs index 2b50607c..95b96423 100644 --- a/tests/abstract-filepath/OsPathSpec.hs +++ b/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 ) diff --git a/tests/filepath-tests/Test.hs b/tests/filepath-tests/Test.hs index 75d50494..cdcffd27 100755 --- a/tests/filepath-tests/Test.hs +++ b/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 +