diff --git a/MissingH.cabal b/MissingH.cabal --- a/MissingH.cabal +++ b/MissingH.cabal @@ -1,11 +1,17 @@ Name: MissingH -Version: 1.0.3 +Version: 1.1.0 License: GPL Maintainer: John Goerzen Author: John Goerzen -Copyright: Copyright (c) 2004-2008 John Goerzen +Copyright: Copyright (c) 2004-2009 John Goerzen license-file: COPYRIGHT -extra-source-files: COPYING +extra-source-files: COPYING, + testsrc/gzfiles/empty.gz, + testsrc/gzfiles/t1.gz, + testsrc/gzfiles/t1bad.gz, + testsrc/gzfiles/t2.gz, + testsrc/gzfiles/zeros.gz, + testsrc/mime.types.test homepage: http://software.complete.org/missingh Category: Unclassified synopsis: Large utility library @@ -14,7 +20,7 @@ be extremely portable and easy to use. Stability: Beta Build-Type: Simple -Cabal-Version: >=1.2 +Cabal-Version: >=1.2.3 Flag splitBase description: Choose the new smaller, split-up base package. @@ -25,7 +31,6 @@ Data.String.Utils, System.IO.Utils, System.IO.Binary, Data.List.Utils, System.Daemon, Text.ParserCombinators.Parsec.Utils, - Test.HUnit.Utils, Network.Email.Mailbox, Control.Concurrent.Thread.Utils, Network.Email.Sendmail, @@ -69,7 +74,7 @@ filepath, hslogger If flag(splitBase) - Build-Depends: base >= 3, directory, random, process, old-time, + Build-Depends: base >= 4, base <= 5, directory, random, process, old-time, containers, old-locale, array Else Build-Depends: base < 3 @@ -80,5 +85,6 @@ Buildable: False Main-Is: runtests.hs HS-Source-Dirs: testsrc, . + Build-Depends: testpack, QuickCheck >= 1.0 && <2.0, HUnit Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances, CPP, PatternSignatures diff --git a/src/Data/BinPacking.hs b/src/Data/BinPacking.hs --- a/src/Data/BinPacking.hs +++ b/src/Data/BinPacking.hs @@ -53,7 +53,7 @@ Calling 'show' on this value will produce a nice error message suitable for display. -} data (Num size, Ord size, Show size, Show obj) => BinPackerError size obj = - BPTooFewBins [(size, obj)] -- ^ Ran out of bins; attached value is the list of objects that don't fit + BPTooFewBins [(size, obj)] -- ^ Ran out of bins; attached value is the list of objects that do not fit | BPSizeTooLarge size (size, obj) -- ^ Bin size1 exceeded by at least the given object and size | BPOther String -- ^ Other error deriving (Eq, Read) @@ -72,7 +72,7 @@ {- | The primary type for bin-packing functions. These functions take a list of size of bins. If every bin is the same size, -you can pass @(repeat binSize)@ to pass an infinite list of bins if the +you can pass @repeat binSize@ to pass an infinite list of bins if the same size. Any surplus bins will simply be ignored. -} type BinPacker = (Num size, Ord size, Show size, Show obj) => [size] -- ^ The sizes of bins diff --git a/src/System/Path/Glob.hs b/src/System/Path/Glob.hs --- a/src/System/Path/Glob.hs +++ b/src/System/Path/Glob.hs @@ -36,7 +36,7 @@ import Data.List.Utils (hasAny) import System.IO.HVFS import System.FilePath (splitFileName) -import Control.Exception (tryJust, ioErrors) +import Control.Exception (tryJust) import System.Path.WildMatch (wildCheckCase) import Data.List (isSuffixOf) @@ -70,8 +70,11 @@ expandGlob :: HVFS a => a -> FilePath -> IO [FilePath] expandGlob fs fn = - case dirname of - "." -> runGlob fs "." basename + case dirnameslash of + "./" -> runGlob fs "." basename + "/" -> do + rgs <- runGlob fs "/" basename + return $ map ('/' :) rgs _ -> do dirlist <- if hasWild dirname then expandGlob fs dirname else return [dirname] @@ -91,7 +94,10 @@ expandWildBase :: FilePath -> IO [FilePath] expandWildBase dname = do dirglobs <- runGlob fs dname basename - return $ map (\globfn -> dname ++ "/" ++ globfn) dirglobs + return $ map withD dirglobs + where withD = case dname of + "" -> id + _ -> \globfn -> dname ++ "/" ++ globfn expandNormalBase :: FilePath -> IO [FilePath] expandNormalBase dname = @@ -112,3 +118,5 @@ in if head patt == '.' then return matches else return $ filter (\x -> head x /= '.') matches + where ioErrors :: IOError -> Maybe IOError + ioErrors e = Just e diff --git a/src/Test/HUnit/Utils.hs b/src/Test/HUnit/Utils.hs deleted file mode 100644 --- a/src/Test/HUnit/Utils.hs +++ /dev/null @@ -1,93 +0,0 @@ -{- arch-tag: Test utilities -Copyright (C) 2004 - 2005 John Goerzen - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --} - -{- | - Module : Test.HUnit.Utils - Copyright : Copyright (C) 2004-2005 John Goerzen - License : GNU GPL, version 2 or above - - Maintainer : John Goerzen - Stability : provisional - Portability: portable - -Utilities for HUnit unit testing. - -Written by John Goerzen, jgoerzen\@complete.org --} - -module Test.HUnit.Utils (assertRaises, mapassertEqual, qccheck, qctest) - where -import Test.HUnit -import Test.QuickCheck as QC -import qualified Control.Exception -import System.Random - -{- | Asserts that a specific exception is raised by a given action. -} -assertRaises :: Show a => String -> Control.Exception.Exception -> IO a -> IO () -assertRaises msg selector action = - let thetest e = if e == selector then return () - else assertFailure $ msg ++ "\nReceived unexpected exception: " - ++ (show e) ++ "\ninstead of exception: " ++ (show selector) - in do - r <- Control.Exception.try action - case r of - Left e -> thetest e - Right _ -> assertFailure $ msg ++ "\nReceived no exception, but was expecting exception: " ++ (show selector) - -mapassertEqual :: (Show b, Eq b) => String -> (a -> b) -> [(a, b)] -> [Test] -mapassertEqual _ _ [] = [] -mapassertEqual descrip func ((inp,result):xs) = - (TestCase $ assertEqual descrip result (func inp)) : mapassertEqual descrip func xs - --- * Turn QuickCheck tests into HUnit tests --- | qccheck turns the quickcheck test into an hunit test -qccheck :: (QC.Testable a) => - QC.Config -- ^ quickcheck config - -> String -- ^ label for the property - -> a -- ^ quickcheck property - -> Test -qccheck config lbl property = - TestLabel lbl $ TestCase $ - do rnd <- newStdGen - tests config (evaluate property) rnd 0 0 [] - --- | qctest is equivalent to 'qccheck defaultConfig' -qctest :: (QC.Testable a) => String -> a -> Test -qctest lbl = qccheck defaultConfig lbl - --- | modified version of the tests function from Test.QuickCheck -tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () -tests config gen rnd0 ntest nfail stamps - | ntest == configMaxTest config = return () - | nfail == configMaxFail config = assertFailure $ "Arguments exhausted after " ++ show ntest ++ " tests." - | otherwise = - do putStr (configEvery config ntest (arguments result)) - case ok result of - Nothing -> - tests config gen rnd1 ntest (nfail+1) stamps - Just True -> - tests config gen rnd1 (ntest+1) nfail (stamp result:stamps) - Just False -> - assertFailure $ ( "Falsifiable, after " - ++ show ntest - ++ " tests:\n" - ++ unlines (arguments result) - ) - where - result = generate (configSize config ntest) rnd2 gen - (rnd1,rnd2) = split rnd0 diff --git a/testsrc/gzfiles/empty.gz b/testsrc/gzfiles/empty.gz new file mode 100644 Binary files /dev/null and b/testsrc/gzfiles/empty.gz differ diff --git a/testsrc/gzfiles/t1.gz b/testsrc/gzfiles/t1.gz new file mode 100644 Binary files /dev/null and b/testsrc/gzfiles/t1.gz differ diff --git a/testsrc/gzfiles/t1bad.gz b/testsrc/gzfiles/t1bad.gz new file mode 100644 Binary files /dev/null and b/testsrc/gzfiles/t1bad.gz differ diff --git a/testsrc/gzfiles/t2.gz b/testsrc/gzfiles/t2.gz new file mode 100644 Binary files /dev/null and b/testsrc/gzfiles/t2.gz differ diff --git a/testsrc/gzfiles/zeros.gz b/testsrc/gzfiles/zeros.gz new file mode 100644 Binary files /dev/null and b/testsrc/gzfiles/zeros.gz differ diff --git a/testsrc/mime.types.test b/testsrc/mime.types.test new file mode 100644 --- /dev/null +++ b/testsrc/mime.types.test @@ -0,0 +1,24 @@ +# arch-tag: test file for MIMETypes +# Here are some comments +# +## + +# and some fun blank lines + + + +# Some types with nothing + +application/activemessage +application/applefile +application/atomicmail # comment here + +# Some lines with real stuff + +application/andrew-inset ez # blah + +# Some lines with multiple things + +video/x-dv dif dv +text/x-c++hdr h++ hpp hxx hh # foo + diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs new file mode 100644 --- /dev/null +++ b/testsrc/runtests.hs @@ -0,0 +1,25 @@ +{- arch-tag: Test runner +Copyright (C) 2004 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +module Main where + +import Test.HUnit +import Tests + +main = runTestTT tests +