data-binary-ieee754 0.4 → 0.4.1
raw patch · 3 files changed
+244/−5 lines, 3 filesdep ~binarydep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: binary, bytestring
API changes (from Hackage documentation)
Files
- Tests.hs +200/−0
- data-binary-ieee754.cabal +16/−5
- data-binary-ieee754.tex +28/−0
+ Tests.hs view
@@ -0,0 +1,200 @@+{-+ Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+ + 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 3 of the License, or+ 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, see <http://www.gnu.org/licenses/>.+-}++module Main () where++import Test.QuickCheck+import Test.QuickCheck.Batch++import qualified Data.ByteString.Lazy as B+import Data.Word (Word8)+import Data.Binary.Get (Get, runGetState)+import Data.Binary.Put (Put, runPut)++import Data.Binary.IEEE754++runOnce = TestOptions+ { no_of_tests = 1+ , length_of_tests = 1+ , debug_tests = False+ }++runDeep = TestOptions+ { no_of_tests = 1000+ , length_of_tests = 0+ , debug_tests = False+ }++main = do+ runTests "parsing" runOnce . map (run . property) . concat $+ [ props_GetFloat16+ , props_GetFloat32+ , props_GetFloat64+ ]+ runTests "serialising" runOnce . map (run . property) . concat $+ [ props_PutFloat32+ , props_PutFloat64+ ]+ runTests "passthrough" runDeep . map run $+ [ property $ passthrough putFloat32le getFloat32le+ , property $ passthrough putFloat32be getFloat32be+ , property $ passthrough putFloat64le getFloat64le+ , property $ passthrough putFloat64be getFloat64be+ ]++props_GetFloat16 = let check = checkGet getFloat16be getFloat16le in+ [ check [0, 0] (and' (== 0.0) (not . isNegativeZero))+ , check [0x80, 0] isNegativeZero+ + -- Normalised+ , check [0x3C, 0] (== 1.0)+ , check [0xBC, 0] (== -1.0)+ + -- Denormalised+ , check [0x03, 0xFF] (== 6.097555e-5)+ , check [0x83, 0xFF] (== -6.097555e-5)+ + -- Infinity+ , check [0x7C, 0] (== inf32)+ , check [0xFC, 0] (== -inf32)+ + -- NaN+ , check [0x7E, 0] (and' isNaN (not . isNegativeNaN))+ , check [0xFE, 0] isNegativeNaN+ ]++props_GetFloat32 = let check = checkGet getFloat32be getFloat32le in+ [ check [0, 0, 0, 0] (and' (== 0.0) (not . isNegativeZero))+ , check [0x80, 0, 0, 0] isNegativeZero+ + -- Normalised+ , check [0x3F, 0x80, 0, 0] (== 1.0)+ , check [0xBF, 0x80, 0, 0] (== -1.0)+ + -- Denormalised+ , check [0x00, 0x7F, 0xFF, 0xFF] (== 1.1754942106924411e-38)+ , check [0x80, 0x7F, 0xFF, 0xFF] (== -1.1754942106924411e-38)+ + -- Infinity+ , check [0x7F, 0x80, 0, 0] (== inf32)+ , check [0xFF, 0x80, 0, 0] (== -inf32)+ + -- NaN and negative NaN+ , check [0x7F, 0xC0, 0, 0] (and' isNaN (not . isNegativeNaN))+ , check [0xFF, 0xC0, 0, 0] isNegativeNaN+ ]++props_GetFloat64 = let check = checkGet getFloat64be getFloat64le in+ [ check [0, 0, 0, 0, 0, 0, 0, 0] (and' (== 0.0) (not . isNegativeZero))+ , check [0x80, 0, 0, 0, 0, 0, 0, 0] isNegativeZero+ + -- Normalised+ , check [0x3F, 0xF0, 0, 0, 0, 0, 0, 0] (== 1.0)+ , check [0xBF, 0xF0, 0, 0, 0, 0, 0, 0] (== -1.0)+ + -- Denormalised+ , check [0x00, 0x0F, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF] (== 2.2250738585072009e-308)+ , check [0x80, 0x0F, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF] (== -2.2250738585072009e-308)+ + -- Infinity+ , check [0x7F, 0xF0, 0, 0, 0, 0, 0, 0] (== inf64)+ , check [0xFF, 0xF0, 0, 0, 0, 0, 0, 0] (== -inf64)+ + -- NaN+ , check [0x7F, 0xF8, 0, 0, 0, 0, 0, 0] (and' isNaN (not . isNegativeNaN))+ , check [0xFF, 0xF8, 0, 0, 0, 0, 0, 0] isNegativeNaN+ ]++props_PutFloat32 = let check = checkPut putFloat32be putFloat32le in+ [ check [0, 0, 0, 0] 0.0+ , check [0x80, 0, 0, 0] (-0.0)+ + -- Normalised+ , check [0x3F, 0x80, 0, 0] 1.0+ , check [0xBF, 0x80, 0, 0] (-1.0)+ + -- Denormalised+ , check [0x00, 0x7F, 0xFF, 0xFF] 1.1754942106924411e-38+ , check [0x80, 0x7F, 0xFF, 0xFF] (-1.1754942106924411e-38)+ + -- Infinity+ , check [0x7F, 0x80, 0, 0] inf32+ , check [0xFF, 0x80, 0, 0] (-inf32)+ + -- NaN+ , check [0x7F, 0xC0, 0, 0] nan32+ , check [0xFF, 0xC0, 0, 0] (-nan32)+ ]++props_PutFloat64 = let check = checkPut putFloat64be putFloat64le in+ [ check [0, 0, 0, 0, 0, 0, 0, 0] 0.0+ , check [0x80, 0, 0, 0, 0, 0, 0, 0] (-0.0)+ + -- Normalised+ , check [0x3F, 0xF0, 0, 0, 0, 0, 0, 0] 1.0+ , check [0xBF, 0xF0, 0, 0, 0, 0, 0, 0] (-1.0)+ + -- Denormalised+ , check [0x00, 0x0F, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF] 2.2250738585072009e-308+ , check [0x80, 0x0F, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF] (-2.2250738585072009e-308)+ + -- Infinity+ , check [0x7F, 0xF0, 0, 0, 0, 0, 0, 0] inf64+ , check [0xFF, 0xF0, 0, 0, 0, 0, 0, 0] (-inf64)+ + -- NaN+ , check [0x7F, 0xF8, 0, 0, 0, 0, 0, 0] nan64+ , check [0xFF, 0xF8, 0, 0, 0, 0, 0, 0] (-nan64)+ ]++checkGet :: (Show a, Eq a, RealFloat a) => Get a -> Get a -> [Word8] -> (a -> Bool) -> Property+checkGet getBE getLE bytes f = forAll (return bytes) (const valid) where+ valid = B.null remainingBE && B.null remainingLE && f xBE && f xLE+ (xBE, remainingBE, _) = runGetState getBE (B.pack bytes) 0+ (xLE, remainingLE, _) = runGetState getLE (B.pack (reverse bytes)) 0++checkPut :: Show a => (a -> Put) -> (a -> Put) -> [Word8] -> a -> Property+checkPut putBE putLE bytes x = forAll (return x) (const valid) where+ valid = sameResult && bytes == B.unpack bytesBE+ sameResult = bytesBE == B.reverse bytesLE+ bytesBE = runPut (putBE x)+ bytesLE = runPut (putLE x)++and' :: (a -> Bool) -> (a -> Bool) -> a -> Bool+and' f g x = f x && g x++isNegativeNaN :: RealFloat a => a -> Bool+isNegativeNaN x = isNaN x && (floor x > 0)++-- Verify that the given put and get functions are inverses.+passthrough :: Eq a => (a -> Put) -> Get a -> a -> Bool+passthrough put get x = x == x' && B.null remaining where+ bytes = runPut (put x)+ (x', remaining, _) = runGetState get bytes 0++-- Pseudo-literals for special values+inf32 :: Float+inf32 = read "Infinity"++inf64 :: Double+inf64 = read "Infinity"++nan32 :: Float+nan32 = read "NaN"++nan64 :: Double+nan64 = read "NaN"
data-binary-ieee754.cabal view
@@ -1,8 +1,8 @@ name: data-binary-ieee754-version: 0.4+version: 0.4.1 synopsis: Parser/Serialiser for IEEE-754 floating-point values description: Convert Float and Decimal values to/from raw octets.-license: GPL+license: GPL-3 license-file: License.txt author: John Millikin maintainer: jmillikin@gmail.com@@ -11,11 +11,22 @@ category: Data stability: experimental bug-reports: mailto:jmillikin@gmail.com+homepage: http://ianen.org/haskell/data-binary-ieee754/+tested-with: GHC==6.10.4, GHC==6.12.1 +extra-source-files:+ data-binary-ieee754.tex+ Tests.hs+ source-repository head type: darcs- location: http://patch-tag.com/r/data-binary-ieee754/pullrepo+ location: http://ianen.org/haskell/data-binary-ieee754/ library- build-depends: base >=3 && < 5, binary, bytestring- exposed-modules: Data.Binary.IEEE754+ build-depends:+ base >=3 && < 5+ , binary >= 0.4 && < 0.6+ , bytestring >= 0.9 && < 0.10++ exposed-modules:+ Data.Binary.IEEE754
+ data-binary-ieee754.tex view
@@ -0,0 +1,28 @@+\documentclass[12pt]{article}++\usepackage{textcomp}+\usepackage{booktabs}++% Smaller margins+\usepackage[left=1.5cm,top=2cm,right=1.5cm,nohead,nofoot]{geometry}++\usepackage{listings}+\lstnewenvironment{code}{+ \lstset+ {language=Haskell+ ,basicstyle=\footnotesize\tt+ ,showstringspaces=false+ ,frame=single+ ,upquote=true+ }}+ {}++\long\def\ignore#1{}++\makeindex++\begin{document}++\input{Data/Binary/IEEE754.lhs}++\end{document}