prefix-units 0.1.0.1 → 0.1.0.2
raw patch · 6 files changed
+119/−79 lines, 6 filesdep +HUnitdep +test-framework-hunitdep ~QuickCheckdep ~basedep ~test-frameworkPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, test-framework-hunit
Dependency ranges changed: QuickCheck, base, test-framework, test-framework-quickcheck2
API changes (from Hackage documentation)
Files
- CHANGES +0/−8
- CHANGES.md +16/−0
- Data/Prefix/Units.hs +26/−21
- Makefile +2/−1
- prefix-units.cabal +9/−6
- tests/Properties.hs +66/−43
− CHANGES
@@ -1,8 +0,0 @@-Version 0.1.0.1--* Trivial release updating upper package bounds (for testing), and- updating homepage/related settings as part of move to github--Version 0.1.0--* Initial release
+ CHANGES.md view
@@ -0,0 +1,16 @@+Version 0.1.0.2++* Trivial release for compatibility with QuickCheck 2.7 and older+ HUnit packages as found in Wheezy.+* The release switches the test suite to use Cabal macros, which might+ create issues in some cases.++Version 0.1.0.1++* Trivial release updating upper package bounds (for testing),+ updating homepage/related settings as part of move to github, and+ fixing a few documentation issues.++Version 0.1.0++* Initial release.
Data/Prefix/Units.hs view
@@ -336,11 +336,16 @@ -- supraunitary representation. In case we don't find any such value -- (e.g. for a zero value), then 'Nothing' is returned. recommendedUnit :: (Real a) => FormatMode -> a -> Maybe Unit-recommendedUnit fmt val =- let range = unitRange fmt- ratv = Prelude.toRational val- in foldr (\u a -> if ratv / unitMultiplier u >= 1 then Just u else a)- Nothing $ reverse range+recommendedUnit fmt val+ -- FIXME: this is not nice at all: we hardcode the set [1, 10)+ -- instead of having it naturally follow from a base unit or+ -- similar.+ | val >= 1 && val < 10 = Nothing+ | otherwise =+ let range = unitRange fmt+ ratv = Prelude.toRational val+ in foldr (\u a -> if ratv / unitMultiplier u >= 1 then Just u else a)+ Nothing $ reverse range -- | Computes the scaled value and unit for a given value formatValue :: (RationalConvertible a) =>@@ -415,25 +420,25 @@ -- | Helper for 'parseBinarySymbol' which only deals with upper-case -- strings.-helperParseBinary :: String -> Either String Unit-helperParseBinary "K" = Right Kibi-helperParseBinary "KI" = Right Kibi-helperParseBinary "M" = Right Mebi-helperParseBinary "MI" = Right Mebi-helperParseBinary "G" = Right Gibi-helperParseBinary "GI" = Right Gibi-helperParseBinary "T" = Right Tebi-helperParseBinary "TI" = Right Tebi-helperParseBinary "P" = Right Pebi-helperParseBinary "PI" = Right Pebi-helperParseBinary "E" = Right Exbi-helperParseBinary "EI" = Right Exbi--- FIXME: error message will contain upper-case version of the symbol-helperParseBinary symbol = unknownUnit symbol+helperParseBinary :: String -> Maybe Unit+helperParseBinary "K" = Just Kibi+helperParseBinary "KI" = Just Kibi+helperParseBinary "M" = Just Mebi+helperParseBinary "MI" = Just Mebi+helperParseBinary "G" = Just Gibi+helperParseBinary "GI" = Just Gibi+helperParseBinary "T" = Just Tebi+helperParseBinary "TI" = Just Tebi+helperParseBinary "P" = Just Pebi+helperParseBinary "PI" = Just Pebi+helperParseBinary "E" = Just Exbi+helperParseBinary "EI" = Just Exbi+helperParseBinary _ = Nothing -- | Parses a binary symbol. See 'ParseBinary' for details. parseBinarySymbol :: String -> Either String Unit-parseBinarySymbol = helperParseBinary . upperSym+parseBinarySymbol symbol =+ maybe (unknownUnit symbol) Right . helperParseBinary . upperSym $ symbol -- | Helper for 'parseKMGTSymbol' which only deals with upper-case strings. helperParseKMGT :: String -> Either String Unit
Makefile view
@@ -25,7 +25,8 @@ lint: @rm -f report.html- hlint --report -c Data+ hlint --cpp-define='MIN_VERSION_QuickCheck(a,b,c)=1' \+ --report -c Data tests clean: cabal clean
prefix-units.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.1.0.1+Version: 0.1.0.2 -- A short (one-line) description of the package. Synopsis: A basic library for SI/binary prefix units@@ -52,7 +52,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: README.md CHANGES Makefile+Extra-source-files: README.md CHANGES.md Makefile -- Constraint on the version of Cabal needed to build this package. Cabal-version: >= 1.8.0.2@@ -89,10 +89,13 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Properties.hs- build-depends: base >= 3 && < 5+ build-depends: base >= 3 , Cabal >= 1.9.2- , test-framework >= 0.6 && < 0.9- , test-framework-quickcheck2 >= 0.2.12 && < 0.4- , QuickCheck >= 2.4.2 && < 2.7+ , test-framework >= 0.6+ , test-framework-quickcheck2 >= 0.2.12+ , test-framework-hunit >= 0.2.7+ , QuickCheck >= 2.4.2+ , HUnit >= 1.2.4 , prefix-units ghc-options: -Wall -fno-warn-orphans+ Extensions: CPP
tests/Properties.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE CPP #-}+ {- -Copyright 2012, Google Inc.+Copyright 2012, 2014, Google Inc. All rights reserved. Redistribution and use in source and binary forms, with or without@@ -39,20 +41,30 @@ import Data.Char (toUpper) import Data.List+import Data.Maybe (isNothing) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit (testCase) import Test.QuickCheck+import Test.HUnit hiding (Test) import Data.Prefix.Units -- * Test helpers +#if MIN_VERSION_QuickCheck(2,7,0)+#else+-- | Forward-compatible name for QuickCheck < 2.7.+counterexample :: Test.QuickCheck.Testable prop => String -> prop -> Property+counterexample = printTestCase+#endif+ failTest :: String -> Property-failTest msg = printTestCase msg False+failTest msg = counterexample msg False -- | Checks for equality with proper annotation. (==?) :: (Show a, Eq a) => a -> a -> Property-(==?) x y = printTestCase+(==?) x y = counterexample ("Expected equality, but '" ++ show x ++ "' /= '" ++ show y ++ "'") (x == y) infix 3 ==?@@ -69,7 +81,7 @@ -> Either String a -> Property expectParseFailure fn (Left err) =- printTestCase "Unexpected error message" $ fn err+ counterexample "Unexpected error message" $ fn err expectParseFailure _ (Right v) = failTest $ "Unexpected parse with result " ++ show v @@ -77,7 +89,7 @@ expectParse :: (Real a, Real b) => a -> Unit -> Either String b -> Property expectParse _ unit (Left err) = failParseUnit unit err expectParse v unit (Right v') =- printTestCase "Parsed wrong value: " $+ counterexample "Parsed wrong value: " $ toRational v' ==? toRational v * unitMultiplier unit -- * Instances@@ -98,36 +110,36 @@ -- ** Definitions -testUniqueNames :: Property+testUniqueNames :: Assertion testUniqueNames = let names = map unitName allUnits- in names ==? nub names+ in nub names @=? names -testUniqueSymbols :: Property+testUniqueSymbols :: Assertion testUniqueSymbols = let symbols = map unitSymbol allUnits- in symbols ==? nub symbols+ in nub symbols @=? symbols -testUniqueFancySymbols :: Property+testUniqueFancySymbols :: Assertion testUniqueFancySymbols = let symbols = map fancySymbol allUnits- in symbols ==? nub symbols+ in nub symbols @=? symbols -testOrdering :: Property-testOrdering =+testOrdering :: Assertion+testOrdering = do let si_mult = map unitMultiplier $ sort siUnits bin_mult = map unitMultiplier $ sort binaryUnits all_mult = map unitMultiplier allUnits -- no sorting here!- in si_mult ==? sort si_mult .&&.- bin_mult ==? sort bin_mult .&&.- all_mult ==? sort all_mult+ sort si_mult @=? si_mult+ sort bin_mult @=? bin_mult+ sort all_mult @=? all_mult -testSIBinary :: Property+testSIBinary :: Assertion testSIBinary =- printTestCase "SI unit lists contain binary prefixes" $- (null (siUnits `intersect` binaryUnits)) .&&.- (null (siKMGT `intersect` binaryUnits)) .&&.- (null (siSupraunitary `intersect` binaryUnits))+ assertBool "SI unit lists contain binary prefixes" $+ null (siUnits `intersect` binaryUnits) &&+ null (siKMGT `intersect` binaryUnits) &&+ null (siSupraunitary `intersect` binaryUnits) -- ** Parsing @@ -135,19 +147,19 @@ testNullUnitInt v pmode = case parseValue pmode (show v) of Left err -> failTest $ "Failed to parse empty unit: " ++ err- Right v' -> printTestCase "Parsed wrong value:" (v ==? v')+ Right v' -> counterexample "Parsed wrong value:" (v ==? v') testNullUnitFrac :: Double -> ParseMode -> Property testNullUnitFrac d pmode = case parseValue pmode (show d) of Left err -> failTest $ "Failed to parse empty unit: " ++ err- Right d' -> printTestCase "Parsed wrong value:" (d ==? d')+ Right d' -> counterexample "Parsed wrong value:" (d ==? d') testSymbolParsingExact :: Unit -> Property testSymbolParsingExact unit = case parseExactSymbol (unitSymbol unit) of Left err -> failParseUnit unit err- Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')+ Right unit' -> counterexample "Parsed wrong unit: " (unit ==? unit') -- | Binary units should parse themselves in explicit binary mode. testSymbolParsingBinary :: Property@@ -155,7 +167,7 @@ forAll (elements binaryUnits) $ \unit -> case parseBinarySymbol (unitSymbol unit) of Left err -> failParseUnit unit err- Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')+ Right unit' -> counterexample "Parsed wrong unit: " (unit ==? unit') -- | Binary units should parse themselves in all parsing modes. testSymbolParsingBinaryAbbrev :: Property@@ -163,7 +175,7 @@ forAll (elements binaryUnits) $ \unit -> case parseSymbol ParseBinary (take 1 (unitSymbol unit)) of Left err -> failParseUnit unit err- Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')+ Right unit' -> counterexample "Parsed wrong unit: " (unit ==? unit') -- | Binary units should parse themselves in all parsing modes. testSymbolParsingBinaryAll :: ParseMode -> Property@@ -171,13 +183,13 @@ forAll (elements binaryUnits) $ \unit -> case parseSymbol mode (unitSymbol unit) of Left err -> failParseUnit unit err- Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')+ Right unit' -> counterexample "Parsed wrong unit: " (unit ==? unit') -- | Fail to parse invalid symbols in any mode. testSymbolParsingFail :: ParseMode -> Property testSymbolParsingFail mode = expectParseFailure (("NO-SUCH" `isInfixOf`) . map toUpper) $- parseSymbol mode ("no-such")+ parseSymbol mode "no-such" -- | Parsed values should be correct. testParsingIntKMGT :: Int -> Property@@ -200,9 +212,9 @@ testParsingDouble :: Unit -> Double -> Property testParsingDouble unit d = let str = show d ++ unitSymbol unit in- case (parseValue ParseExact str)::Either String Double of+ case parseValue ParseExact str::Either String Double of Left err -> failParseUnit unit err- Right d' -> printTestCase ("Parsing of " ++ str ++ " failed: ") $+ Right d' -> counterexample ("Parsing of " ++ str ++ " failed: ") $ d' ==? fromRational (toRational d * unitMultiplier unit) -- | Parsed values should be correct.@@ -262,16 +274,26 @@ testRecommend = forAll (elements [FormatSiAll, FormatBinary]) $ \fmt -> forAll (elements (unitRange fmt)) $ \unit ->- case recommendedUnit fmt (unitMultiplier unit) of+ let value = unitMultiplier unit in+ case recommendedUnit fmt value of Nothing -> failTest $ "Expected recommendation of unit " ++- unitName unit ++ " but got nothing"- Just unit' -> printTestCase "Mismatch in recommended unit: " $- unit ==? unit'+ unitName unit ++ " for " ++ show value ++ " but got nothing"+ Just unit' -> counterexample ("Mismatch in recommended unit for value " +++ show value ++ ": ") $ unit ==? unit' +-- | Test that small values in [1, 10) are not scaled.+testRecommendSmall :: Property+testRecommendSmall =+ forAll (elements [FormatSiAll, FormatBinary]) $ \fmt ->+ forAll (choose (1.0::Double, 10) `suchThat` (< 10)) $ \value ->+ let result = recommendedUnit fmt value+ in counterexample ("Expected Nothing but got recommended unit " +++ show result) $ isNothing result+ testForceUnit :: Unit -> Rational -> Property testForceUnit unit v = case formatValue (Right unit) v of- (v', Just u') -> printTestCase "Invalid value/unit computed" $+ (v', Just u') -> counterexample "Invalid value/unit computed" $ unit ==? u' .&&. v ==? v' * unitMultiplier unit x -> failTest $ "Invalid result from formatValue: " ++ show x@@ -294,14 +316,14 @@ testShowIntegralBinary = forAll (elements binaryUnits) $ \ unit -> let value = truncate (unitMultiplier unit)::Integer in- printTestCase ("Formatting/showing unit " ++ show unit) $- showValue (Left FormatBinary) value ==? "1" ++ unitSymbol unit+ counterexample ("Formatting/showing unit " ++ show unit) $+ showValue (Left FormatBinary) value ==? '1' : unitSymbol unit testShowRational :: Unit -> Property testShowRational unit = let fmtmode = if unit `elem` binaryUnits then FormatBinary else FormatSiAll value = unitMultiplier unit- in printTestCase ("Formatting/showing unit " ++ show unit) $+ in counterexample ("Formatting/showing unit " ++ show unit) $ showValue (Left fmtmode) value ==? "1 % 1" ++ unitSymbol unit -- * Test harness@@ -312,11 +334,11 @@ tests :: [Test] tests = [ testGroup "definitions"- [ testProperty "unique names" testUniqueNames- , testProperty "unique symbols" testUniqueSymbols- , testProperty "unique fancy symbols" testUniqueFancySymbols- , testProperty "ordering" testOrdering- , testProperty "type mixup" testSIBinary+ [ testCase "unique names" testUniqueNames+ , testCase "unique symbols" testUniqueSymbols+ , testCase "unique fancy symbols" testUniqueFancySymbols+ , testCase "ordering" testOrdering+ , testCase "type mixup" testSIBinary ] , testGroup "parsing" [ testProperty "null unit integral" testNullUnitInt@@ -341,6 +363,7 @@ , testProperty "trivial formatting/fmt" testTrivialFormattingFmt , testProperty "trivial formatting/show" testTrivialFormattingShow , testProperty "recommend" testRecommend+ , testProperty "recommend small units" testRecommendSmall , testProperty "force unit" testForceUnit , testProperty "format/int" testFormatIntegral , testProperty "format/frac" testFormatFractional