Hello community, here is the log from the commit of package ghc-extra for openSUSE:Factory checked in at 2016-05-03 09:37:11 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-extra (Old) and /work/SRC/openSUSE:Factory/.ghc-extra.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-extra" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-extra/ghc-extra.changes 2016-01-11 19:12:05.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-extra.new/ghc-extra.changes 2016-05-03 10:16:42.000000000 +0200 @@ -1,0 +2,9 @@ +Sat Apr 30 16:02:30 UTC 2016 - [email protected] + +- update to 1.4.5 +* change fileEq on files that do not exist to be an error +* add mconcatMap and mconcatMapM +* add fileEq +* add isMac + +------------------------------------------------------------------- Old: ---- extra-1.4.3.tar.gz New: ---- extra-1.4.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-extra.spec ++++++ --- /var/tmp/diff_new_pack.GHZpYG/_old 2016-05-03 10:16:43.000000000 +0200 +++ /var/tmp/diff_new_pack.GHZpYG/_new 2016-05-03 10:16:43.000000000 +0200 @@ -21,7 +21,7 @@ %global debug_package %{nil} %bcond_with tests Name: ghc-extra -Version: 1.4.3 +Version: 1.4.5 Release: 0 Summary: Extra functions I use License: BSD-3-Clause ++++++ extra-1.4.3.tar.gz -> extra-1.4.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/CHANGES.txt new/extra-1.4.5/CHANGES.txt --- old/extra-1.4.3/CHANGES.txt 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/CHANGES.txt 2016-04-29 21:36:57.000000000 +0200 @@ -1,5 +1,11 @@ Changelog for Extra +1.4.5 + #17, change fileEq on files that do not exist to be an error +1.4.4 + #14, add mconcatMap and mconcatMapM + #16, add fileEq + #15, add isMac 1.4.3 Add Data.Version.Extra 1.4.2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/Generate.hs new/extra-1.4.5/Generate.hs --- old/extra-1.4.3/Generate.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/Generate.hs 2016-04-29 21:36:57.000000000 +0200 @@ -1,3 +1,5 @@ +-- This module generates the files src/Extra.hs and test/TestGen.hs. +-- Either call "runhaskell Generate" or start "ghci" and use ":generate". module Generate(main) where @@ -24,7 +26,10 @@ let tests = mapMaybe (stripPrefix "-- > ") $ lines src return (mod, funcs, tests) writeFileBinaryChanged "src/Extra.hs" $ unlines $ - ["-- | This module documents all the functions available in this package." + ["-- GENERATED CODE - DO NOT MODIFY" + ,"-- See Generate.hs for details of how to generate" + ,"" + ,"-- | This module documents all the functions available in this package." ,"--" ,"-- Most users should import the specific modules (e.g. @\"Data.List.Extra\"@), which" ,"-- also reexport their non-@Extra@ modules (e.g. @\"Data.List\"@)." @@ -37,7 +42,10 @@ ,""] ++ ["import " ++ x | x <- mods] writeFileBinaryChanged "test/TestGen.hs" $ unlines $ - ["{-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, ViewPatterns #-}" + ["-- GENERATED CODE - DO NOT MODIFY" + ,"-- See Generate.hs for details of how to generate" + ,"" + ,"{-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, ViewPatterns #-}" ,"module TestGen(tests) where" ,"import TestUtil" ,"default(Maybe Bool,Int,Double,Maybe (Maybe Bool),Maybe (Maybe Char))" @@ -67,8 +75,8 @@ tweakTest x | Just x <- stripSuffix " == undefined" x = if not $ "\\" `isPrefixOf` x then - "erroneous $ " ++ trim x + (if "fileEq" `isInfixOf` x then "erroneousIO $ " else "erroneous $ ") ++ trim x else let (a,b) = breakOn "->" $ trim x - in a ++ "-> erroneous $ " ++ drop 2 b + in a ++ "-> erroneous $ " ++ trim (drop 2 b) | otherwise = x diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/extra.cabal new/extra-1.4.5/extra.cabal --- old/extra-1.4.3/extra.cabal 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/extra.cabal 2016-04-29 21:36:57.000000000 +0200 @@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: extra -version: 1.4.3 +version: 1.4.5 license: BSD3 license-file: LICENSE category: Development @@ -15,7 +15,7 @@ The module "Extra" documents all functions provided by this library. Modules such as "Data.List.Extra" provide extra functions over "Data.List" and also reexport "Data.List". Users are recommended to replace "Data.List" imports with "Data.List.Extra" if they need the extra functionality. homepage: https://github.com/ndmitchell/extra#readme bug-reports: https://github.com/ndmitchell/extra/issues -tested-with: GHC==7.10.1, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2 +tested-with: GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 extra-doc-files: CHANGES.txt diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/src/Control/Monad/Extra.hs new/extra-1.4.5/src/Control/Monad/Extra.hs --- old/extra-1.4.3/src/Control/Monad/Extra.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/src/Control/Monad/Extra.hs 2016-04-29 21:36:57.000000000 +0200 @@ -11,7 +11,7 @@ -- * Loops loopM, whileM, -- * Lists - partitionM, concatMapM, mapMaybeM, findM, firstJustM, + partitionM, concatMapM, mconcatMapM, mapMaybeM, findM, firstJustM, -- * Booleans whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM ) where @@ -19,6 +19,7 @@ import Control.Monad import Control.Applicative import Data.Maybe +import Data.Monoid import Prelude -- General utilities @@ -61,6 +62,10 @@ concatMapM op = foldr f (return []) where f x xs = do x <- op x; if null x then xs else do xs <- xs; return $ x++xs +-- | A version of 'mconcatMapM' that works with a monadic predicate. +mconcatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b +mconcatMapM f = liftM mconcat . mapM f + -- | A version of 'mapMaybe' that works with a monadic predicate. mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b] {-# INLINE mapMaybeM #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/src/Data/List/Extra.hs new/extra-1.4.5/src/Data/List/Extra.hs --- old/extra-1.4.3/src/Data/List/Extra.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/src/Data/List/Extra.hs 2016-04-29 21:36:57.000000000 +0200 @@ -16,7 +16,7 @@ wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, -- * Basics - list, uncons, unsnoc, cons, snoc, drop1, + list, uncons, unsnoc, cons, snoc, drop1, mconcatMap, -- * List operations groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, @@ -33,6 +33,7 @@ import Data.Function import Data.Char import Data.Tuple.Extra +import Data.Monoid import Prelude @@ -381,6 +382,14 @@ drop1 (x:xs) = xs +-- | Version on `concatMap` generalised to a `Monoid` rather than just a list. +-- +-- > mconcatMap Sum [1,2,3] == Sum 6 +-- > \f xs -> mconcatMap f xs == concatMap f xs +mconcatMap :: Monoid b => (a -> b) -> [a] -> b +mconcatMap f = mconcat . map f + + -- | Find the first instance of @needle@ in @haystack@. -- The first element of the returned tuple -- is the prefix of @haystack@ before @needle@ is matched. The second diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/src/Extra.hs new/extra-1.4.5/src/Extra.hs --- old/extra-1.4.3/src/Extra.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/src/Extra.hs 2016-04-29 21:36:57.000000000 +0200 @@ -1,3 +1,6 @@ +-- GENERATED CODE - DO NOT MODIFY +-- See Generate.hs for details of how to generate + -- | This module documents all the functions available in this package. -- -- Most users should import the specific modules (e.g. @"Data.List.Extra"@), which @@ -11,7 +14,7 @@ retry, retryBool, showException, stringException, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool, -- * Control.Monad.Extra -- | Extra functions available in @"Control.Monad.Extra"@. - whenJust, whenJustM, unit, loopM, whileM, partitionM, concatMapM, mapMaybeM, findM, firstJustM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, + whenJust, whenJustM, unit, loopM, whileM, partitionM, concatMapM, mconcatMapM, mapMaybeM, findM, firstJustM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, -- * Data.Either.Extra -- | Extra functions available in @"Data.Either.Extra"@. isLeft, isRight, fromLeft, fromRight, fromEither, @@ -20,7 +23,7 @@ modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef', -- * Data.List.Extra -- | Extra functions available in @"Data.List.Extra"@. - lower, upper, trim, trimStart, trimEnd, word1, dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, list, uncons, unsnoc, cons, snoc, drop1, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, nubOn, groupOn, sortOn, disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip, concatUnzip3, replace, merge, mergeBy, + lower, upper, trim, trimStart, trimEnd, word1, dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, list, uncons, unsnoc, cons, snoc, drop1, mconcatMap, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, nubOn, groupOn, sortOn, disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip, concatUnzip3, replace, merge, mergeBy, -- * Data.Tuple.Extra -- | Extra functions available in @"Data.Tuple.Extra"@. first, second, (***), (&&&), dupe, both, fst3, snd3, thd3, @@ -38,10 +41,10 @@ getExecutablePath, lookupEnv, -- * System.Info.Extra -- | Extra functions available in @"System.Info.Extra"@. - isWindows, + isWindows, isMac, -- * System.IO.Extra -- | Extra functions available in @"System.IO.Extra"@. - captureOutput, withBuffering, readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, newTempFile, newTempDir, + captureOutput, withBuffering, readFileEncoding, readFileUTF8, readFileBinary, readFile', readFileEncoding', readFileUTF8', readFileBinary', writeFileEncoding, writeFileUTF8, writeFileBinary, withTempFile, withTempDir, newTempFile, newTempDir, fileEq, -- * System.Process.Extra -- | Extra functions available in @"System.Process.Extra"@. system_, systemOutput, systemOutput_, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/src/System/IO/Extra.hs new/extra-1.4.5/src/System/IO/Extra.hs --- old/extra-1.4.3/src/System/IO/Extra.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/src/System/IO/Extra.hs 2016-04-29 21:36:57.000000000 +0200 @@ -16,10 +16,13 @@ writeFileEncoding, writeFileUTF8, writeFileBinary, -- * Temporary files withTempFile, withTempDir, newTempFile, newTempDir, + -- * File comparison + fileEq, ) where import System.IO import Control.Concurrent.Extra +import Control.Monad.Extra import Control.Exception.Extra as E import GHC.IO.Handle(hDuplicate,hDuplicateTo) import System.Directory.Extra @@ -30,7 +33,11 @@ import Data.Time.Clock import Data.Tuple.Extra import Data.IORef - +import Foreign.Ptr +import Foreign.Marshal.Alloc +import Foreign.C.Types +import Data.Functor +import Prelude -- File reading @@ -53,24 +60,24 @@ -- Strict file reading +-- | A strict version of 'hGetContents'. +hGetContents' :: Handle -> IO String +hGetContents' h = do + s <- hGetContents h + void $ evaluate $ length s + return s + -- | A strict version of 'readFile'. When the string is produced, the entire -- file will have been read into memory and the file handle will have been closed. -- Closing the file handle does not rely on the garbage collector. -- -- > \(filter isHexDigit -> s) -> fmap (== s) $ withTempFile $ \file -> do writeFile file s; readFile' file readFile' :: FilePath -> IO String -readFile' file = withFile file ReadMode $ \h -> do - s <- hGetContents h - evaluate $ length s - return s +readFile' file = withFile file ReadMode hGetContents' -- | A strict version of 'readFileEncoding', see 'readFile'' for details. readFileEncoding' :: TextEncoding -> FilePath -> IO String -readFileEncoding' e file = withFile file ReadMode $ \h -> do - hSetEncoding h e - s <- hGetContents h - evaluate $ length s - return s +readFileEncoding' e file = withFile file ReadMode $ \h -> hSetEncoding h e >> hGetContents' h -- | A strict version of 'readFileUTF8', see 'readFile'' for details. readFileUTF8' :: FilePath -> IO String @@ -78,10 +85,7 @@ -- | A strict version of 'readFileBinary', see 'readFile'' for details. readFileBinary' :: FilePath -> IO String -readFileBinary' file = withBinaryFile file ReadMode $ \h -> do - s <- hGetContents h - evaluate $ length s - return s +readFileBinary' file = withBinaryFile file ReadMode hGetContents' -- File writing @@ -109,7 +113,7 @@ -- -- > captureOutput (print 1) == return ("1\n",()) captureOutput :: IO a -> IO (String, a) -captureOutput act = withTempFile $ \file -> do +captureOutput act = withTempFile $ \file -> withFile file ReadWriteMode $ \h -> do res <- clone stdout h $ clone stderr h $ do hClose h @@ -137,6 +141,8 @@ --------------------------------------------------------------------- -- TEMPORARY FILE +-- We don't use GHC's temp file code, because its buggy, see: +-- https://ghc.haskell.org/trac/ghc/ticket/10731 {-# NOINLINE tempRef #-} tempRef :: IORef Int @@ -194,7 +200,7 @@ let dir = tmpdir </> "extra-dir-" ++ show v catchBool isAlreadyExistsError (createDirectoryPrivate dir >> return dir) $ - \e -> create tmpdir + \_ -> create tmpdir -- | Create a temporary directory inside the system temporary directory. @@ -207,3 +213,36 @@ withTempDir act = do (dir,del) <- newTempDir act dir `finally` del + +-- | Returns 'True' when both files have the same size. +sameSize :: Handle -> Handle -> IO Bool +sameSize h1 h2 = liftM2 (==) (hFileSize h1) (hFileSize h2) + +foreign import ccall unsafe "string.h memcmp" memcmp + :: Ptr CUChar -> Ptr CUChar -> CSize -> IO CInt + +-- | Returs 'True' when the contents of both files is the same. +sameContent :: Handle -> Handle -> IO Bool +sameContent h1 h2 = sameSize h1 h2 &&^ withb (\b1 -> withb $ \b2 -> eq b1 b2) + where eq b1 b2 = do + r1 <- hGetBuf h1 b1 bufsz + r2 <- hGetBuf h2 b2 bufsz + if r1 == 0 + then return $ r2 == 0 + else return (r1 == r2) &&^ bufeq b1 b2 r1 &&^ eq b1 b2 + bufeq b1 b2 s = (==0) <$> memcmp b1 b2 (fromIntegral s) + withb = allocaBytesAligned bufsz 4096 + bufsz = 64*1024 + +-- | Returns 'True' if both files have the same content. +-- Raises an error if either file is missing. +-- +-- > fileEq "does_not_exist1" "does_not_exist2" == undefined +-- > fileEq "does_not_exist" "does_not_exist" == undefined +-- > withTempFile $ \f1 -> fileEq "does_not_exist" f1 == undefined +-- > withTempFile $ \f1 -> withTempFile $ \f2 -> fileEq f1 f2 +-- > withTempFile $ \f1 -> withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "a" >> fileEq f1 f2 +-- > withTempFile $ \f1 -> withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "b" >> notM (fileEq f1 f2) +fileEq :: FilePath -> FilePath -> IO Bool +fileEq p1 p2 = withH p1 $ \h1 -> withH p2 $ \h2 -> sameContent h1 h2 + where withH p = withBinaryFile p ReadMode diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/src/System/Info/Extra.hs new/extra-1.4.5/src/System/Info/Extra.hs --- old/extra-1.4.3/src/System/Info/Extra.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/src/System/Info/Extra.hs 2016-04-29 21:36:57.000000000 +0200 @@ -3,7 +3,8 @@ -- | Extra functions for the current system info. module System.Info.Extra( module System.Info, - isWindows + isWindows, + isMac, ) where import System.Info @@ -23,3 +24,11 @@ #else isWindows = False #endif + +-- | Return 'True' on Mac OS X and 'False' otherwise. +isMac :: Bool +#if defined(darwin_HOST_OS) +isMac = True +#else +isMac = False +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/src/System/Time/Extra.hs new/extra-1.4.5/src/System/Time/Extra.hs --- old/extra-1.4.3/src/System/Time/Extra.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/src/System/Time/Extra.hs 2016-04-29 21:36:57.000000000 +0200 @@ -56,8 +56,8 @@ -- -- > timeout (-3) (print 1) == return Nothing -- > timeout 0.1 (print 1) == fmap Just (print 1) +-- > do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return $ t < 1 -- > timeout 0.1 (sleep 2 >> print 1) == return Nothing --- > do (t, _) <- duration $ timeout 0.1 $ sleep 1000; return $ t < 1 timeout :: Seconds -> IO a -> IO (Maybe a) -- Copied from GHC with a few tweaks. timeout n f diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/test/TestGen.hs new/extra-1.4.5/test/TestGen.hs --- old/extra-1.4.3/test/TestGen.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/test/TestGen.hs 2016-04-29 21:36:57.000000000 +0200 @@ -1,3 +1,6 @@ +-- GENERATED CODE - DO NOT MODIFY +-- See Generate.hs for details of how to generate + {-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, ViewPatterns #-} module TestGen(tests) where import TestUtil @@ -47,9 +50,9 @@ testGen "findM (Just . isUpper) \"test\" == Just Nothing" $ findM (Just . isUpper) "test" == Just Nothing testGen "findM (Just . const True) [\"x\",undefined] == Just (Just \"x\")" $ findM (Just . const True) ["x",undefined] == Just (Just "x") testGen "\\x -> fromLeft (Left x) == x" $ \x -> fromLeft (Left x) == x - testGen "\\x -> fromLeft (Right x) == undefined" $ \x -> erroneous $ fromLeft (Right x) + testGen "\\x -> fromLeft (Right x) == undefined" $ \x -> erroneous $ fromLeft (Right x) testGen "\\x -> fromRight (Right x) == x" $ \x -> fromRight (Right x) == x - testGen "\\x -> fromRight (Left x) == undefined" $ \x -> erroneous $ fromRight (Left x) + testGen "\\x -> fromRight (Left x) == undefined" $ \x -> erroneous $ fromRight (Left x) testGen "\\x -> fromEither (Left x ) == x" $ \x -> fromEither (Left x ) == x testGen "\\x -> fromEither (Right x) == x" $ \x -> fromEither (Right x) == x testGen "\\xs -> repeatedly (splitAt 3) xs == chunksOf 3 xs" $ \xs -> repeatedly (splitAt 3) xs == chunksOf 3 xs @@ -142,6 +145,8 @@ testGen "drop1 \"\" == \"\"" $ drop1 "" == "" testGen "drop1 \"test\" == \"est\"" $ drop1 "test" == "est" testGen "\\xs -> drop 1 xs == drop1 xs" $ \xs -> drop 1 xs == drop1 xs + testGen "mconcatMap Sum [1,2,3] == Sum 6" $ mconcatMap Sum [1,2,3] == Sum 6 + testGen "\\f xs -> mconcatMap f xs == concatMap f xs" $ \f xs -> mconcatMap f xs == concatMap f xs testGen "breakOn \"::\" \"a::b::c\" == (\"a\", \"::b::c\")" $ breakOn "::" "a::b::c" == ("a", "::b::c") testGen "breakOn \"/\" \"foobar\" == (\"foobar\", \"\")" $ breakOn "/" "foobar" == ("foobar", "") testGen "\\needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack" $ \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack @@ -209,11 +214,17 @@ testGen "withTempDir doesDirectoryExist == return True" $ withTempDir doesDirectoryExist == return True testGen "(doesDirectoryExist =<< withTempDir return) == return False" $ (doesDirectoryExist =<< withTempDir return) == return False testGen "withTempDir listFiles == return []" $ withTempDir listFiles == return [] + testGen "fileEq \"does_not_exist1\" \"does_not_exist2\" == undefined" $ erroneousIO $ fileEq "does_not_exist1" "does_not_exist2" + testGen "fileEq \"does_not_exist\" \"does_not_exist\" == undefined" $ erroneousIO $ fileEq "does_not_exist" "does_not_exist" + testGen "withTempFile $ \\f1 -> fileEq \"does_not_exist\" f1 == undefined" $ erroneousIO $ withTempFile $ \f1 -> fileEq "does_not_exist" f1 + testGen "withTempFile $ \\f1 -> withTempFile $ \\f2 -> fileEq f1 f2" $ withTempFile $ \f1 -> withTempFile $ \f2 -> fileEq f1 f2 + testGen "withTempFile $ \\f1 -> withTempFile $ \\f2 -> writeFile f1 \"a\" >> writeFile f2 \"a\" >> fileEq f1 f2" $ withTempFile $ \f1 -> withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "a" >> fileEq f1 f2 + testGen "withTempFile $ \\f1 -> withTempFile $ \\f2 -> writeFile f1 \"a\" >> writeFile f2 \"b\" >> notM (fileEq f1 f2)" $ withTempFile $ \f1 -> withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "b" >> notM (fileEq f1 f2) testGen "fmap (round . fst) (duration $ sleep 1) == return 1" $ fmap (round . fst) (duration $ sleep 1) == return 1 testGen "timeout (-3) (print 1) == return Nothing" $ timeout (-3) (print 1) == return Nothing testGen "timeout 0.1 (print 1) == fmap Just (print 1)" $ timeout 0.1 (print 1) == fmap Just (print 1) + testGen "do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return $ t < 1" $ do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return $ t < 1 testGen "timeout 0.1 (sleep 2 >> print 1) == return Nothing" $ timeout 0.1 (sleep 2 >> print 1) == return Nothing - testGen "do (t, _) <- duration $ timeout 0.1 $ sleep 1000; return $ t < 1" $ do (t, _) <- duration $ timeout 0.1 $ sleep 1000; return $ t < 1 testGen "\\a b -> a > b ==> subtractTime a b > 0" $ \a b -> a > b ==> subtractTime a b > 0 testGen "showDuration 3.435 == \"3.44s\"" $ showDuration 3.435 == "3.44s" testGen "showDuration 623.8 == \"10m24s\"" $ showDuration 623.8 == "10m24s" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.4.3/test/TestUtil.hs new/extra-1.4.5/test/TestUtil.hs --- old/extra-1.4.3/test/TestUtil.hs 2016-01-07 15:22:49.000000000 +0100 +++ new/extra-1.4.5/test/TestUtil.hs 2016-04-29 21:36:57.000000000 +0200 @@ -1,6 +1,6 @@ -{-# LANGUAGE ScopedTypeVariables, CPP #-} +{-# LANGUAGE ScopedTypeVariables, CPP, FlexibleInstances #-} -module TestUtil(runTests, testGen, testRaw, erroneous, (====), module X) where +module TestUtil(runTests, testGen, testRaw, erroneous, erroneousIO, (====), module X) where import Test.QuickCheck import Test.QuickCheck.Test @@ -20,6 +20,7 @@ import Data.Function as X import Data.List as X import Data.Char as X +import Data.Monoid as X import Data.Tuple as X import Data.Version as X import System.Directory as X @@ -48,6 +49,9 @@ erroneous :: a -> Bool erroneous x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate x +erroneousIO :: IO a -> Bool +erroneousIO x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate =<< x + (====) :: (Show a, Eq a) => a -> a -> Bool a ==== b = if a == b then True else error $ "Not equal!\n" ++ show a ++ "\n" ++ show b
