From d651a599766faa2f18d42f90f7eb1d0c4c2326f3 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
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 d9ff661..1fe1da5 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 8365c93..f238f10 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 7918eb1..5753523 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 2b50607..95b9642 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 75d5049..cdcffd2 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
+
--
GitLab