diff --git a/t/basics.hs b/t/basics.hs index 132b69c..eb5905c 100644 --- a/t/basics.hs +++ b/t/basics.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} import Data.Default import Data.Int @@ -11,40 +13,59 @@ import qualified Data.Set as S import qualified Data.IntMap as IM import qualified Data.IntSet as IS import Data.Tree (Tree(..)) +import Data.Functor.Identity +import Control.Applicative +import Data.Proxy +#if MIN_VERSION_base(4, 16, 0) +import Data.Tuple +#endif +import GHC.Generics +import Foreign.C.Types +import Foreign.Ptr +#if MIN_VERSION_base(4, 18, 0) +import Foreign.C.ConstPtr +#endif -import Control.Monad (when) +import Control.Monad (when, join) import Control.Monad.Reader import Data.IORef import System.Exit (exitFailure) import System.IO -newtype Test a = Test{ unTest :: ReaderT (IORef Int) IO a } - deriving (Functor, Applicative, Monad, MonadIO, MonadReader (IORef Int)) +data TestState = TestState + { testState_count :: !(IORef Int) + , testState_ok :: !(IORef Bool) + } + +newtype Test a = Test{ unTest :: ReaderT TestState IO a } + deriving (Functor, Applicative, Monad, MonadIO, MonadReader TestState) runTest :: (MonadIO m) => Test a -> m a runTest t = liftIO $ do hSetBuffering stdout LineBuffering - r <- newIORef 1 - runReaderT (unTest t) r + rc <- newIORef 0 + rk <- newIORef True + x <- runReaderT (unTest t) TestState{ testState_count = rc, testState_ok = rk } + c <- readIORef rc + putStrLn $ "1.." ++ show c + k <- readIORef rk + when (not k) exitFailure + pure x + instance (Default a) => Default (Test a) where def = return def -withRef :: (IORef Int -> IO a) -> Test a +withRef :: (IORef Int -> IO () -> IO a) -> Test a withRef f = do - r <- ask - liftIO (f r) - -planTests :: Int -> Test () -planTests n = liftIO $ do - putStrLn $ "1.." ++ show n + TestState rc rk <- ask + liftIO (f rc (atomicWriteIORef rk False)) ok :: Bool -> String -> Test () -ok b s = withRef $ \r -> do - c <- atomicModifyIORef r ((,) =<< succ) +ok b s = withRef $ \ref lose -> do + c <- atomicModifyIORef' ref (join (,) . succ) putStrLn $ (if b then "" else "not ") ++ "ok " ++ show c ++ " - " ++ s - when (not b) - exitFailure + when (not b) lose is {-, isNot-} :: (Show a, Eq a) => a -> a -> Test () is x y = ok (x == y) (show x ++ " == " ++ show y) @@ -54,9 +75,16 @@ is x y = ok (x == y) (show x ++ " == " ++ show y) -- diag s = liftIO $ do -- putStrLn $ "# " ++ s +data T0 a b + = C0 a a + | C1 + | C2 b + deriving (Eq, Show, Generic) + +instance (Default a) => Default (T0 a b) + main :: IO () main = runTest $ do - planTests 35 is def () is def (Nothing :: Maybe (Int, Ordering, [Float])) is def "" @@ -73,6 +101,13 @@ main = runTest $ do is def (First Nothing :: First ()) is def (Sum (0 :: Integer)) is def (Product (1 :: Rational)) + is def (Identity ()) + is def (Const 0 :: Const Int Char) + is def (Proxy :: Proxy Char) +#if MIN_VERSION_base(4, 16, 0) + is def (pure () :: Solo ()) +#endif + is def False is def (0 :: Int) is def (0 :: Integer) is def (0 :: Float) @@ -88,7 +123,39 @@ main = runTest $ do is def (0 :: Word16) is def (0 :: Word32) is def (0 :: Word64) + is def (0 :: CShort) + is def (0 :: CUShort) + is def (0 :: CInt) + is def (0 :: CUInt) + is def (0 :: CLong) + is def (0 :: CULong) + is def (0 :: CLLong) + is def (0 :: CULLong) + is def (0 :: CPtrdiff) + is def (0 :: CSize) + is def (0 :: CSigAtomic) + is def (0 :: CIntPtr) + is def (0 :: CUIntPtr) + is def (0 :: CIntMax) + is def (0 :: CUIntMax) + is def (0 :: CClock) + is def (0 :: CTime) + is def (0 :: CUSeconds) + is def (0 :: CSUSeconds) + is def (0 :: CFloat) + is def (0 :: CDouble) + is def (0 :: IntPtr) + is def (0 :: WordPtr) +#if MIN_VERSION_base(4, 10, 0) + is def (0 :: CBool) +#endif + is def nullPtr + is def nullFunPtr +#if MIN_VERSION_base(4, 18, 0) + is def (ConstPtr nullPtr) +#endif is def ((def, def) :: ((), Maybe ((), ()))) is def ((def, def, def) :: ((), Maybe ((), ()), [Ordering])) is def ((def, def, def, def) :: ((), Maybe ((), ()), [Ordering], Float)) is def ((def, def, def, def, def, def, def) :: ((), (), (), (), (), (), ())) + is def (C0 0 0 :: T0 Int Char)