mysql-haskell 1.1.6 → 1.1.7
raw patch · 18 files changed
+260/−282 lines, 18 filesdep +tasty-expected-failuredep −containersdep ~QuickCheckdep ~attoparsecdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: tasty-expected-failure
Dependencies removed: containers
Dependency ranges changed: QuickCheck, attoparsec, base, bytestring-lexing, case-insensitive, data-default-class, directory, filepath, http-types, quickcheck-instances, scanner, tasty-hunit, tasty-quickcheck, unordered-containers
API changes (from Hackage documentation)
Files
- ChangeLog.md +11/−0
- README.md +0/−10
- mysql-haskell.cabal +46/−33
- src/Data/Int/Int24.hs +2/−0
- src/Data/Word/Word24.hs +2/−0
- test/Aeson.hs +1/−10
- test/AesonBP.hs +2/−13
- test/ExecuteMany.hs +0/−2
- test/JSON.hs +0/−1
- test/Orphans.hs +25/−0
- test/QC/ByteString.hs +2/−6
- test/QC/Combinator.hs +0/−4
- test/QC/Common.hs +0/−13
- test/QCUtils.hs +0/−26
- test/TCPStreams.hs +9/−5
- test/TextRow.hs +43/−44
- test/TextRowNew.hs +32/−33
- test/Word24.hs +85/−82
ChangeLog.md view
@@ -1,5 +1,16 @@ # Revision history for mysql-haskell +## 1.1.7 -- 2025.08.23 ++ bump constraints++ upgrade cabal file++ add upper bounds to all the warnings+ + it was only the test suite so I made them broad.++ Disable inline-rule-shadowing for Int24 and Word24.+ those rules fire fine. you can test it our yourself with+ the Main.hs in the main repository.+ There is a stanza to do so in cabal.++ clean up cabal file a bit, use GHC2021+ ## 1.1.6 -- 2024.10.23 + bump constraints
README.md view
@@ -130,16 +130,6 @@ * Set `max_allowed_packet` to larger than 256M(for test large packet). -New features will be automatically tested by inspecting MySQL server's version, travis is keeping an eye on following combinations:--+ CABALVER=1.18 GHCVER=7.8.4 MYSQLVER=5.5-+ CABALVER=1.22 GHCVER=7.10.2 MYSQLVER=5.5-+ CABALVER=1.24 GHCVER=8.0.1 MYSQLVER=5.5-+ CABALVER=1.24 GHCVER=8.0.1 MYSQLVER=5.6-+ CABALVER=1.24 GHCVER=8.0.1 MYSQLVER=5.7--Please reference `.travis.yml` if you have problems with setting up test environment.- Enter benchmark directory and run `./bench.sh` to benchmark 1) c++ version 2) mysql-pure 3) FFI version mysql, you may need to: + Modify `bench.sh`(change the include path) to get c++ version compiled.
mysql-haskell.cabal view
@@ -1,6 +1,6 @@-cabal-version: 2.2+cabal-version: 3.4 name: mysql-haskell-version: 1.1.6+version: 1.1.7 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver. license: BSD-3-Clause@@ -42,7 +42,21 @@ type: git location: git://github.com/winterland1989/mysql-haskell.git ++common common-options+ ghc-options:+ -Wall -Wincomplete-uni-patterns+ -Wincomplete-record-updates -Widentities -Wredundant-constraints+ -Wcpp-undef -fwarn-tabs -Wpartial-fields+ -Wunused-packages+ -fenable-th-splice-warnings+ -fno-omit-yields+ build-depends:+ base >=4.9.1.0 && <4.21.0+ default-language: GHC2021+ library+ import: common-options exposed-modules: Data.Binary.Parser Data.Binary.Parser.Numeric@@ -72,7 +86,6 @@ hs-source-dirs: src other-modules: Database.MySQL.Query build-depends:- base >=4.7 && <4.19.0 || ^>=4.19.0 || ^>=4.20.0, binary >=0.8.3 && <0.9, blaze-textual >=0.2 && <0.3, bytestring >=0.10.2.0 && <0.12 || ^>=0.12.0,@@ -81,7 +94,7 @@ crypton-x509 >=1.5 && <2.0, crypton-x509-store >=1.5 && <2.0, crypton-x509-system >=1.5 && <2.0,- data-default-class >=0.1.2 && <0.2,+ data-default-class >=0.1.2 && <0.2 || ^>=0.2.0, deepseq >=1.4.6 && <1.5 || ^>=1.5.0, io-streams >=1.2 && <2.0, memory >=0.14.4 && <0.19,@@ -95,20 +108,15 @@ vector >=0.8 && <0.13 || ^>=0.13.0, word-compat >=0.0 && <0.1 - default-language: Haskell2010 default-extensions: DeriveDataTypeable DeriveGeneric MultiWayIf OverloadedStrings - ghc-options:- -Wall -Wincomplete-uni-patterns- -Wincomplete-record-updates -Widentities -Wredundant-constraints- -Wcpp-undef -fwarn-tabs -Wpartial-fields- -Wunused-packages -fenable-th-splice-warnings test-suite test+ import: common-options type: exitcode-stdio-1.0 main-is: Main.hs other-modules:@@ -124,7 +132,7 @@ QC.ByteString QC.Combinator QC.Common- QCUtils+ Orphans TCPStreams TextRow TextRowNew@@ -132,37 +140,35 @@ hs-source-dirs: test build-depends:- attoparsec,- base,+ attoparsec < 1.0, binary >=0.8, bytestring >=0.10,- bytestring-lexing >=0.5,- containers, deepseq,- directory,- filepath,+ directory < 2.0,+ filepath < 2.0, io-streams, mysql-haskell, network,- QuickCheck >=2.7,- quickcheck-instances,+ QuickCheck >=2.7 && <3.0,+ quickcheck-instances < 1.0, scientific >=0.3.0, tasty >=0.11 && <2.0,- tasty-hunit,- tasty-quickcheck >=0.8,+ tasty-hunit < 1.0,+ tasty-quickcheck >=0.8 && < 1.0,+ tasty-expected-failure < 1.0, text, time,- unordered-containers,+ unordered-containers < 1.0, vector default-extensions: MultiWayIf OverloadedStrings - ghc-options: -threaded- default-language: Haskell2010+ ghc-options: -threaded benchmark binary-parsers-bench+ import: common-options other-modules: Aeson AesonBP@@ -173,37 +179,44 @@ build-depends: attoparsec,- base, binary, bytestring,- case-insensitive,+ case-insensitive < 2, criterion >=1.1 && <1.2 || ^>=1.6.3, deepseq,- directory,- filepath,- http-types,+ directory < 1.4,+ filepath < 1.6,+ http-types < 1.0, mysql-haskell,- scanner,+ scanner < 0.4, scientific, text, unordered-containers, vector - default-language: Haskell2010 hs-source-dirs: binary-parser-bench main-is: Bench.hs type: exitcode-stdio-1.0 ghc-options: -O2 benchmark bench24- default-language: Haskell2010+ import: common-options type: exitcode-stdio-1.0 hs-source-dirs: word24-bench main-is: Benchmark.hs build-depends:- base, criterion >=1.1, deepseq >=1.2 && <2, mysql-haskell ghc-options: -O2++-- enable to debug the RULES +-- executable exe+-- import: common-options+-- main-is: Main.hs+-- hs-source-dirs:+-- app+-- build-depends:+-- mysql-haskell+-- ghc-options: -Wno-unused-packages
src/Data/Int/Int24.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}+ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}
src/Data/Word/Word24.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}+ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}
test/Aeson.hs view
@@ -6,27 +6,18 @@ import Data.ByteString.Builder (Builder, byteString, toLazyByteString, charUtf8, word8) -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((*>), (<$>), (<*), pure)-import Data.Monoid (mappend, mempty)-#endif--import Control.Applicative (liftA2) import Control.DeepSeq (NFData(..))-import Control.Monad (forM) import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific, skipSpace, string) import Data.Bits ((.|.), shiftL) import Data.ByteString (ByteString) import Data.Char (chr)-import Data.List (sort) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8') import Data.Vector as Vector (Vector, foldl', fromList) import Data.Word (Word8)-import System.Directory (getDirectoryContents)-import System.FilePath ((</>), dropExtension)+import System.FilePath ((</>)) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Lazy as L import qualified Data.Attoparsec.Zepto as Z
test/AesonBP.hs view
@@ -6,25 +6,14 @@ import Data.ByteString.Builder (Builder, byteString, toLazyByteString, charUtf8, word8) -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((*>), (<$>), (<*), pure)-import Data.Monoid (mappend, mempty)-#endif--import Control.Applicative (liftA2)-import Control.DeepSeq (NFData(..))-import Control.Monad (forM) import Data.Bits ((.|.), shiftL) import Data.ByteString (ByteString) import Data.Char (chr)-import Data.List (sort)-import Data.Scientific (Scientific) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8')-import Data.Vector as Vector (Vector, foldl', fromList)+import Data.Vector as Vector (Vector, fromList) import Data.Word (Word8)-import System.Directory (getDirectoryContents)-import System.FilePath ((</>), dropExtension)+import System.FilePath ((</>)) import qualified Data.Attoparsec.Zepto as Z import Data.Binary.Get (Get) import qualified Data.Binary.Parser as BP
test/ExecuteMany.hs view
@@ -3,11 +3,9 @@ module ExecuteMany where -import Control.Applicative import Data.Time.Calendar (fromGregorian) import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..)) import Database.MySQL.Base-import qualified System.IO.Streams as Stream import Test.Tasty.HUnit tests :: MySQLConn -> Assertion
test/JSON.hs view
@@ -1,7 +1,6 @@ module JSON where import Control.Monad-import Control.Applicative import qualified Data.ByteString as B import Test.Tasty.HUnit import Test.Tasty (TestTree)
+ test/Orphans.hs view
@@ -0,0 +1,25 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- https://tech.freckle.com/2018/12/12/a-home-for-orphan-instances/+module Orphans where++import Test.QuickCheck++import Data.Int.Int24+import Data.Word.Word24++-- Arbitrary/CoArbitrary instances for Int24 and Word24++instance Arbitrary Int24 where+ arbitrary = arbitraryBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Int24 where+ coarbitrary = coarbitraryIntegral++instance Arbitrary Word24 where+ arbitrary = arbitraryBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Word24 where+ coarbitrary = coarbitraryIntegral
test/QC/ByteString.hs view
@@ -1,14 +1,11 @@ {-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-} module QC.ByteString (tests) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif-import Data.Char (chr, ord, toUpper)+import Data.Char (chr, ord) import Data.Int (Int64) import Data.Word (Word8) import Prelude hiding (take, takeWhile)-import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)+import QC.Common (liftOp, parseBS, toStrictBS) import Test.Tasty (TestTree) import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck@@ -17,7 +14,6 @@ import qualified Data.Binary.Parser as P import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8
test/QC/Combinator.hs view
@@ -2,9 +2,6 @@ module QC.Combinator where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif import qualified Control.Monad as M (replicateM) import Data.Maybe (fromJust, isJust) import Data.Word (Word8)@@ -14,7 +11,6 @@ import Test.QuickCheck import qualified Data.Binary.Parser as P import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8 import qualified Data.Foldable as Foldable (asum) asum :: NonEmptyList (NonEmptyList Word8) -> Gen Property
test/QC/Common.hs view
@@ -12,25 +12,12 @@ , liftOp ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif import Data.Char (isAlpha) import Test.QuickCheck import Test.QuickCheck.Instances () import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Binary.Parser as P--#if !MIN_VERSION_base(4,4,0)--- This should really be a dependency on the random package :-(-instance Random Word8 where- randomR = integralRandomR- random = randomR (minBound,maxBound)--instance Arbitrary Word8 where- arbitrary = choose (minBound, maxBound)-#endif parseBS :: P.Get r -> BL.ByteString -> Maybe r parseBS p lbs = case P.parseLazy p lbs of
− test/QCUtils.hs
@@ -1,26 +0,0 @@-module QCUtils where--import Test.QuickCheck-import Test.QuickCheck.Arbitrary-import Test.QuickCheck.Gen--import Data.Int-import Data.Int.Int24-import Data.Word-import Data.Word.Word24---- Arbitrary/CoArbitrary instances for Int24 and Word24--instance Arbitrary Int24 where- arbitrary = arbitraryBoundedIntegral- shrink = shrinkIntegral--instance CoArbitrary Int24 where- coarbitrary = coarbitraryIntegral--instance Arbitrary Word24 where- arbitrary = arbitraryBoundedIntegral- shrink = shrinkIntegral--instance CoArbitrary Word24 where- coarbitrary = coarbitraryIntegral
test/TCPStreams.hs view
@@ -9,10 +9,9 @@ import qualified Network.Socket as N import System.Timeout (timeout) import Test.Tasty-import Test.Tasty.HUnit hiding (Test)+import Test.Tasty.HUnit import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L-import System.Directory (removeFile) ------------------------------------------------------------------------------ import qualified Data.TLSSetting as TLS import Data.Connection@@ -21,9 +20,12 @@ import qualified System.IO.Streams.TLS as TLS ------------------------------------------------------------------------------ +import Test.Tasty.ExpectedFailure (ignoreTestBecause)+ tests :: TestTree tests = testGroup "tests" [ testGroup "TCP" tcpTests , testGroup "TLS" tlsTests+ , testGroup "HTTPS" [testHTTPS] ] ------------------------------------------------------------------------------@@ -41,7 +43,7 @@ go = do portMVar <- newEmptyMVar resultMVar <- newEmptyMVar- forkIO $ client portMVar resultMVar+ _ <- forkIO $ client portMVar resultMVar server portMVar l <- takeMVar resultMVar assertEqual "testSocket" l ["ok"]@@ -79,7 +81,7 @@ go = do portMVar <- newEmptyMVar resultMVar <- newEmptyMVar- forkIO $ client portMVar resultMVar+ _ <- forkIO $ client portMVar resultMVar server portMVar l <- takeMVar resultMVar assertEqual "testSocket" l ["ok"]@@ -102,7 +104,9 @@ close conn testHTTPS :: TestTree-testHTTPS = testCase "network/https" $+testHTTPS =+ ignoreTestBecause "can't connect to socket in a nix container, the build becomes no longer reproducible." $+ testCase "network/https" $ N.withSocketsDo $ do x <- timeout (10 * 10^(6::Int)) go assertEqual "ok" (Just 1024) x
test/TextRow.hs view
@@ -3,7 +3,6 @@ module TextRow where -import Control.Applicative import Data.Time.Calendar (fromGregorian) import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..)) import Database.MySQL.Base@@ -13,7 +12,7 @@ tests :: MySQLConn -> Assertion tests c = do- (f, is) <- query_ c "SELECT * FROM test"+ (f, is1) <- query_ c "SELECT * FROM test" assertEqual "decode Field types" (columnType <$> f) [ mySQLTypeLong@@ -48,8 +47,8 @@ , mySQLTypeString ] - Just v <- Stream.read is- assertEqual "decode NULL values" v+ Just v1 <- Stream.read is1+ assertEqual "decode NULL values" v1 [ MySQLInt32 0 , MySQLNull , MySQLNull@@ -82,11 +81,11 @@ , MySQLNull ] - Stream.skipToEof is+ Stream.skipToEof is1 let bitV = 57514 -- 0b1110000010101010 - execute_ c "UPDATE test SET \+ _ <- execute_ c "UPDATE test SET \ \__bit = b'1110000010101010' ,\ \__tinyInt = -128 ,\ \__tinyIntU = 255 ,\@@ -117,10 +116,10 @@ \__enum = 'foo' ,\ \__set = 'foo,bar' WHERE __id=0" - (_, is) <- query_ c "SELECT * FROM test"- Just v <- Stream.read is+ (_, is2) <- query_ c "SELECT * FROM test"+ Just v2 <- Stream.read is2 - assertEqual "decode text protocol" v+ assertEqual "decode text protocol" v2 [ MySQLInt32 0 , MySQLBit bitV , MySQLInt8 (-128)@@ -153,15 +152,15 @@ , MySQLText "foo,bar" ] - Stream.skipToEof is+ Stream.skipToEof is2 - (_, is') <- queryVector_ c "SELECT * FROM test"- Just v' <- Stream.read is'- Stream.skipToEof is'+ (_, is3) <- queryVector_ c "SELECT * FROM test"+ Just v3 <- Stream.read is3+ Stream.skipToEof is3 - assertEqual "decode text protocol(queryVector_)" v (V.toList v')+ assertEqual "decode text protocol(queryVector_)" v2 (V.toList v3) - execute c "UPDATE test SET \+ _ <- execute c "UPDATE test SET \ \__bit = ? ,\ \__tinyInt = ? ,\ \__tinyIntU = ? ,\@@ -222,10 +221,10 @@ , MySQLText "foo,bar" ] - (_, is) <- query_ c "SELECT * FROM test"- Just v <- Stream.read is+ (_, is4) <- query_ c "SELECT * FROM test"+ Just v4 <- Stream.read is4 - assertEqual "roundtrip text protocol" v+ assertEqual "roundtrip text protocol" v4 [ MySQLInt32 0 , MySQLBit bitV , MySQLInt8 (-128)@@ -258,18 +257,18 @@ , MySQLText "foo,bar" ] - Stream.skipToEof is+ Stream.skipToEof is4 - execute_ c "UPDATE test SET \+ _ <- execute_ c "UPDATE test SET \ \__mediumInt = null ,\ \__double = null ,\ \__text = null WHERE __id=0" - (_, is) <- query_ c "SELECT * FROM test"- Just v <- Stream.read is+ (_, is5) <- query_ c "SELECT * FROM test"+ Just v5 <- Stream.read is5 - assertEqual "decode text protocol with null" v+ assertEqual "decode text protocol with null" v5 [ MySQLInt32 0 , MySQLBit bitV , MySQLInt8 (-128)@@ -302,18 +301,18 @@ , MySQLText "foo,bar" ] - Stream.skipToEof is+ Stream.skipToEof is5 - execute c "UPDATE test SET \+ _ <- execute c "UPDATE test SET \ \__decimal = ? ,\ \__date = ? ,\ \__timestamp = ? WHERE __id=0" [MySQLNull, MySQLNull, MySQLNull] - (_, is) <- query_ c "SELECT * FROM test"- Just v <- Stream.read is+ (_, is6) <- query_ c "SELECT * FROM test"+ Just v6 <- Stream.read is6 - assertEqual "roundtrip text protocol with null" v+ assertEqual "roundtrip text protocol with null" v6 [ MySQLInt32 0 , MySQLBit bitV , MySQLInt8 (-128)@@ -346,47 +345,47 @@ , MySQLText "foo,bar" ] - Stream.skipToEof is+ Stream.skipToEof is6 - execute_ c "UPDATE test SET \+ _ <- execute_ c "UPDATE test SET \ \__time = '199:59:59' ,\ \__year = 0 WHERE __id=0" - (_, is) <- query_ c "SELECT __time, __year FROM test"- Just v <- Stream.read is+ (_, is7) <- query_ c "SELECT __time, __year FROM test"+ Just v7 <- Stream.read is7 - assertEqual "decode text protocol 2" v+ assertEqual "decode text protocol 2" v7 [ MySQLTime 0 (TimeOfDay 199 59 59) , MySQLYear 0 ] - Stream.skipToEof is+ Stream.skipToEof is7 - execute_ c "UPDATE test SET \+ _ <- execute_ c "UPDATE test SET \ \__text = '' ,\ \__blob = '' WHERE __id=0" - (_, is) <- query_ c "SELECT __text, __blob FROM test"- Just v <- Stream.read is+ (_, is8) <- query_ c "SELECT __text, __blob FROM test"+ Just v8 <- Stream.read is8 - assertEqual "decode text protocol 3" v+ assertEqual "decode text protocol 3" v8 [ MySQLText "" , MySQLBytes "" ] - Stream.skipToEof is+ Stream.skipToEof is8 - execute c "UPDATE test SET \+ _ <- execute c "UPDATE test SET \ \__time = ? ,\ \__year = ? WHERE __id=0" [ MySQLTime 0 (TimeOfDay 199 59 59), MySQLYear 0] - (_, is) <- query_ c "SELECT __time, __year FROM test"- Just v <- Stream.read is+ (_, is9) <- query_ c "SELECT __time, __year FROM test"+ Just v9 <- Stream.read is9 - assertEqual "roundtrip text protocol 2" v+ assertEqual "roundtrip text protocol 2" v9 [ MySQLTime 0 (TimeOfDay 199 59 59) , MySQLYear 0 ] - Stream.skipToEof is+ Stream.skipToEof is9
test/TextRowNew.hs view
@@ -3,7 +3,6 @@ module TextRowNew where -import Control.Applicative import Data.Time.Calendar (fromGregorian) import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..)) import Database.MySQL.Base@@ -12,7 +11,7 @@ tests :: MySQLConn -> Assertion tests c = do- (f, is) <- query_ c "SELECT * FROM test_new"+ (f, is5) <- query_ c "SELECT * FROM test_new" assertEqual "decode Field types" (columnType <$> f) [ mySQLTypeLong@@ -21,51 +20,51 @@ , mySQLTypeTime ] - Just v <- Stream.read is- assertEqual "decode NULL values" v+ Just v1 <- Stream.read is5+ assertEqual "decode NULL values" v1 [ MySQLInt32 0 , MySQLNull , MySQLNull , MySQLNull ] - Stream.skipToEof is+ Stream.skipToEof is5 - execute_ c "UPDATE test_new SET \+ _ <- execute_ c "UPDATE test_new SET \ \__datetime = '2016-08-08 17:25:59.12' ,\ \__timestamp = '2016-08-08 17:25:59.1234' ,\ \__time = '-199:59:59.123456' WHERE __id=0" - (_, is) <- query_ c "SELECT * FROM test_new"- Just v <- Stream.read is+ (_, is4) <- query_ c "SELECT * FROM test_new"+ Just v2 <- Stream.read is4 - assertEqual "decode text protocol" v+ assertEqual "decode text protocol" v2 [ MySQLInt32 0 , MySQLDateTime (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.12)) , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.1234)) , MySQLTime 1 (TimeOfDay 199 59 59.123456) ] - Stream.skipToEof is+ Stream.skipToEof is4 - execute_ c "UPDATE test_new SET \+ _ <- execute_ c "UPDATE test_new SET \ \__datetime = '2016-08-08 17:25:59.1' ,\ \__timestamp = '2016-08-08 17:25:59.12' ,\ \__time = '199:59:59.1234' WHERE __id=0" - (_, is) <- query_ c "SELECT * FROM test_new"- Just v <- Stream.read is+ (_, is0) <- query_ c "SELECT * FROM test_new"+ Just v3 <- Stream.read is0 - assertEqual "decode text protocol 2" v+ assertEqual "decode text protocol 2" v3 [ MySQLInt32 0 , MySQLDateTime (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.1)) , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.12)) , MySQLTime 0 (TimeOfDay 199 59 59.1234) ] - Stream.skipToEof is+ Stream.skipToEof is0 - execute c "UPDATE test_new SET \+ _ <- execute c "UPDATE test_new SET \ \__datetime = ? ,\ \__timestamp = ? ,\ \__time = ? WHERE __id=0"@@ -75,19 +74,19 @@ ] - (_, is) <- query_ c "SELECT * FROM test_new"- Just v <- Stream.read is+ (_, is1) <- query_ c "SELECT * FROM test_new"+ Just v4 <- Stream.read is1 - assertEqual "roundtrip text protocol" v+ assertEqual "roundtrip text protocol" v4 [ MySQLInt32 0 , MySQLDateTime (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.12)) , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.1234)) , MySQLTime 1 (TimeOfDay 199 59 59.123456) ] - Stream.skipToEof is+ Stream.skipToEof is1 - execute c "UPDATE test_new SET \+ _ <- execute c "UPDATE test_new SET \ \__datetime = ? ,\ \__timestamp = ? ,\ \__time = ? WHERE __id=0"@@ -96,17 +95,17 @@ , MySQLTime 0 (TimeOfDay 199 59 59.1234) ] - (_, is) <- query_ c "SELECT * FROM test_new"- Just v <- Stream.read is+ (_, is2) <- query_ c "SELECT * FROM test_new"+ Just v5 <- Stream.read is2 - assertEqual "roundtrip text protocol 2" v+ assertEqual "roundtrip text protocol 2" v5 [ MySQLInt32 0 , MySQLDateTime (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.1)) , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.12)) , MySQLTime 0 (TimeOfDay 199 59 59.1234) ] - Stream.skipToEof is+ Stream.skipToEof is2 let row0 = [ MySQLInt32 0@@ -120,13 +119,13 @@ , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 09) (TimeOfDay 18 25 59.12)) , MySQLTime 0 (TimeOfDay 299 59 59.1234) ]- execute c "UPDATE test_new SET \+ _ <- execute c "UPDATE test_new SET \ \__id = ? ,\ \__datetime = ? ,\ \__timestamp = ? ,\ \__time = ? WHERE __id=0" row0- execute c "INSERT INTO test_new VALUES(\+ _ <- execute c "INSERT INTO test_new VALUES(\ \?,\ \?,\ \?,\@@ -134,13 +133,13 @@ \)" row1 - (_, is) <- query c "SELECT * FROM test_new WHERE __id IN (?) ORDER BY __id" [Many [MySQLInt32 0, MySQLInt32 1]]- Just v0 <- Stream.read is- Just v1 <- Stream.read is+ (_, is3) <- query c "SELECT * FROM test_new WHERE __id IN (?) ORDER BY __id" [Many [MySQLInt32 0, MySQLInt32 1]]+ Just v6 <- Stream.read is3+ Just v7 <- Stream.read is3 - assertEqual "select list of ids" [v0, v1] [row0, row1]+ assertEqual "select list of ids" [v6, v7] [row0, row1] - Stream.skipToEof is- execute_ c "DELETE FROM test_new where __id=1"+ Stream.skipToEof is3+ _ <- execute_ c "DELETE FROM test_new where __id=1" return ()
test/Word24.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- module Word24(tests) where import Prelude as P@@ -9,7 +7,7 @@ import Test.QuickCheck hiding ((.&.)) -import QCUtils+import Orphans() import Data.Int import Data.Int.Int24 import Data.Word@@ -18,129 +16,156 @@ import Foreign.Storable import GHC.Real +prop_enum3 :: Int -> Bool+prop_addIdent :: Word24 -> Bool+prop_multIdent :: Word24 -> Bool+prop_unsigned :: Word24 -> Bool+prop_smaller :: Word16 -> Bool+prop_show :: Word16 -> Bool+prop_read :: Word24 -> Bool+prop_adder :: Word16 -> Word16 -> Property+prop_negate :: Word24 -> Bool+prop_abs :: Word24 -> Bool+prop_signum :: Word24 -> Bool+prop_real :: Word24 -> Bool+prop_enum1 :: Word24 -> Property+prop_enum2 :: Word24 -> Property+prop_enum4 :: Word24 -> Property+prop_enum5 :: Word24 -> Word8 -> Bool+prop_enum6 :: Word24 -> Word24 -> Bool+prop_quot :: Word24 -> Word24 -> Bool+prop_rem :: Word24 -> Word24 -> Bool+prop_div :: Word24 -> Word24 -> Bool+prop_mod :: Word24 -> Word24 -> Bool+prop_quotrem :: Word24 -> Word24 -> Bool+prop_divmod :: Word24 -> Word24 -> Bool+prop_and :: Word16 -> Word16 -> Bool+prop_or :: Word16 -> Word16 -> Bool+prop_xor :: Word16 -> Word16 -> Bool+prop_xor_ident :: Word24 -> Word24 -> Bool+prop_shiftL :: Word24 -> Bool+prop_shiftR :: Word24 -> Property+prop_shiftR2 :: Word24 -> Int -> Property+prop_shiftL_ident :: Word24 -> Bool+prop_rotate :: Word24 -> Int -> Bool+prop_comp :: Word24 -> Bool+prop_byteSwap :: Word24 -> Bool+prop_clz :: Word24 -> Bool+prop_ctz :: Word24 -> Bool+prop_bit_ident :: Bits a => a -> NonNegative Int -> Bool+prop_sizeOf :: Word24 -> Bool+prop_align :: Word24 -> Bool+prop_addIdentI :: Int24 -> Bool+prop_multIdentI :: Int24 -> Bool+prop_smallerI :: Int16 -> Bool+prop_showI :: Int16 -> Bool+prop_readI :: Int24 -> Bool+prop_adderI :: Int16 -> Int16 -> Bool+prop_negateI :: Int24 -> Bool+prop_absI :: Int24 -> Bool+prop_signumI :: Int24 -> Bool+prop_realI :: Int24 -> Bool+prop_enum1I :: Int24 -> Property+prop_enum2I :: Int24 -> Property+prop_enum3I :: Int -> Bool+prop_enum4I :: Int24 -> Property+prop_enum5I :: Int24 -> Word8 -> Bool+prop_enum6I :: Int24 -> Int24 -> Bool+prop_quotI :: Int24 -> Int24 -> Bool+prop_remI :: Int24 -> Int24 -> Bool+prop_divI :: Int24 -> Int24 -> Bool+prop_modI :: Int24 -> Int24 -> Bool+ -- ---------------------------------------- -- Word24 Properties prop_addIdent a = a - a == 0- where types = a :: Word24 prop_multIdent a = a * 1 == a- where types = a :: Word24 prop_unsigned a = a >= 0- where types = a :: Word24 prop_smaller a = (fromIntegral ((fromIntegral a) :: Word24) :: Word16) == a prop_show a = show a == show (fromIntegral a :: Word24)- where types = a :: Word16 prop_read a = a == (read . show) a- where types = a :: Word24 prop_adder a b = (a < ub) && (b < ub) ==> fromIntegral (a + b) == ((fromIntegral a + fromIntegral b) :: Word24)- where types = (a :: Word16, b :: Word16)+ where ub :: Word16 ub = maxBound `div` 2 prop_negate a = a == negate (negate a)- where types = a :: Word24 prop_abs a = a == abs a- where types = a :: Word24 prop_signum a = if a == 0 then signum a == a else signum a == 1- where types = a :: Word24 prop_real a = let r = toRational a in numerator r == fromIntegral a- where types = a :: Word24 -- Word24 Enum properties prop_enum1 a = a < maxBound ==> succ a == a + 1- where types = a :: Word24 prop_enum2 a = a > minBound ==> pred a == a - 1- where types = a :: Word24 prop_enum3 a = let a' = abs a in- toEnum a' == fromIntegral a'- where types = a :: Int+ toEnum a' == fromIntegral @_ @Integer a' prop_enum4 a = a < maxBound ==> take 2 (enumFrom a) == [a, a+1]- where types = a :: Word24 prop_enum5 a b = let b' = fromIntegral b in enumFromTo a (a + b') == map fromIntegral (enumFromTo (fromIntegral a :: Integer) (fromIntegral (a + b') :: Integer))- where types = (a :: Word24, b :: Word8) prop_enum6 a b = take 2 (enumFromThen a b) == [a,b]- where types = (a :: Word24, b :: Word24) -- Word24 Integral properties prop_quot a b = quot a b == fromIntegral (quot (fromIntegral a :: Word32) (fromIntegral b :: Word32))- where types = a :: Word24 prop_rem a b = rem a b == fromIntegral (rem (fromIntegral a :: Word32) (fromIntegral b :: Word32))- where types = a :: Word24 prop_div a b = div a b == fromIntegral (div (fromIntegral a :: Word32) (fromIntegral b :: Word32))- where types = a :: Word24 prop_mod a b = mod a b == fromIntegral (mod (fromIntegral a :: Word32) (fromIntegral b :: Word32))- where types = a :: Word24 prop_quotrem a b = let (j, k) = quotRem a b in a == (b * j) + k- where types = (a :: Word24, b :: Word24) prop_divmod a b = divMod a b == (div a b, mod a b)- where types = (a :: Word24, b :: Word24) -- binary Word properties prop_and a b = (a .&. b) == fromIntegral ( (fromIntegral a :: Word24) .&. (fromIntegral b :: Word24))- where types = (a :: Word16, b :: Word16) prop_or a b = (a .|. b) == fromIntegral ( (fromIntegral a :: Word24) .|. (fromIntegral b :: Word24))- where types = (a :: Word16, b :: Word16) prop_xor a b = (a `xor` b) == fromIntegral ( (fromIntegral a :: Word24) `xor` (fromIntegral b :: Word24))- where types = (a :: Word16, b :: Word16) prop_xor_ident a b = (a `xor` b) `xor` b == a- where types = (a :: Word24, b :: Word24) prop_shiftL a = a `shiftL` 1 == a * 2- where types = a :: Word24 prop_shiftR a = a < maxBound `div` 2 ==> (a * 2) `shift` (-1) == a- where types = a :: Word24 prop_shiftR2 a n = n >= 0 ==> a `shiftR` n == a `shift` (negate n)- where types = a :: Word24 prop_shiftL_ident a = a `shiftL` 0 == a- where types = a :: Word24 prop_rotate a b = (a `rotate` b) `rotate` (negate b) == a- where types = (a :: Word24, b :: Int) prop_comp a = complement (complement a) == a- where types = a :: Word24 prop_byteSwap a = byteSwap24 (byteSwap24 a) == a- where types = a :: Word24 -#if MIN_VERSION_base(4,8,0) prop_clz a = countLeadingZeros a == countLeadingZeros' a where countLeadingZeros' :: Word24 -> Int@@ -161,21 +186,21 @@ | testBit x i = i | otherwise = go (i+1) w = finiteBitSize x-#endif prop_bit_ident q (NonNegative j) = testBit (bit j `asTypeOf` q) j == (j < 24) +prop_popCount :: (Integral a1, Num a2, FiniteBits a1,+ FiniteBits a2) =>+ a1 -> a2 -> a1 -> Bool prop_popCount s t a = if a >= 0 then popCount (a `asTypeOf` s) == popCount (fromIntegral a `asTypeOf` t) else- bitSize s - popCount (a `asTypeOf` s) == bitSize t - popCount (fromIntegral a `asTypeOf` t)+ finiteBitSize s - popCount (a `asTypeOf` s) == finiteBitSize t - popCount (fromIntegral a `asTypeOf` t) -- Word Storable properties prop_sizeOf a = sizeOf a == 3- where types = a :: Word24 prop_align a = alignment a == 3- where types = a :: Word24 @@ -183,117 +208,98 @@ -- Int24 Properties prop_addIdentI a = a - a == 0- where types = a :: Int24 prop_multIdentI a = a * 1 == a- where types = a :: Int24 prop_smallerI a = (fromIntegral ((fromIntegral a) :: Int24) :: Int16) == a prop_showI a = show a == show (fromIntegral a :: Int24)- where types = a :: Int16 prop_readI a = a == (read . show) a- where types = a :: Int24 prop_adderI a b = ((fromIntegral a + fromIntegral b) :: Int) == fromIntegral ((fromIntegral a + fromIntegral b) :: Int24)- where types = (a :: Int16, b :: Int16) prop_negateI a = a == negate (negate a)- where types = a :: Int24 prop_absI a = if a >= 0 then a == abs a else a == negate (abs a)- where types = a :: Int24 prop_signumI a = signum a == fromIntegral (signum (fromIntegral a :: Int))- where types = a :: Int24 prop_realI a = let r = toRational a in numerator r == fromIntegral a- where types = a :: Int24 -- Int24 Enum Properties prop_enum1I a = a < maxBound ==> succ a == a + 1- where types = a :: Int24 prop_enum2I a = a > minBound ==> pred a == a - 1- where types = a :: Int24 prop_enum3I a = let a' = abs a in- toEnum a' == fromIntegral a'- where types = a :: Int+ toEnum a' == fromIntegral @_ @Integer a' prop_enum4I a = a < maxBound ==> take 2 (enumFrom a) == [a, a+1]- where types = a :: Int24 prop_enum5I a b = let b' = fromIntegral b in enumFromTo a (a + b') == map fromIntegral (enumFromTo (fromIntegral a :: Integer) (fromIntegral (a + b') :: Integer))- where types = (a :: Int24, b :: Word8) prop_enum6I a b = take 2 (enumFromThen a b) == [a,b]- where types = (a :: Int24, b :: Int24) -- Int24 Integral properties prop_quotI a b = quot a b == fromIntegral (quot (fromIntegral a :: Int32) (fromIntegral b :: Int32))- where types = a :: Int24 prop_remI a b = rem a b == fromIntegral (rem (fromIntegral a :: Int32) (fromIntegral b :: Int32))- where types = a :: Int24 prop_divI a b = div a b == fromIntegral (div (fromIntegral a :: Int32) (fromIntegral b :: Int32))- where types = a :: Int24 prop_modI a b = mod a b == fromIntegral (mod (fromIntegral a :: Int32) (fromIntegral b :: Int32))- where types = a :: Int24 +prop_quotremI :: Int24 -> Int24 -> Bool prop_quotremI a b = let (j, k) = quotRem a b in a == (b * j) + k- where types = (a :: Int24, b :: Int24) +prop_divmodI :: Int24 -> Int24 -> Bool prop_divmodI a b = divMod a b == (div a b, mod a b)- where types = (a :: Int24, b :: Int24) -- binary Int properties+prop_andI :: Int16 -> Int16 -> Bool prop_andI a b = (a .&. b) == fromIntegral ( (fromIntegral a :: Int24) .&. (fromIntegral b :: Int24))- where types = (a :: Int16, b :: Int16) +prop_orI :: Int16 -> Int16 -> Bool prop_orI a b = (a .|. b) == fromIntegral ( (fromIntegral a :: Int24) .|. (fromIntegral b :: Int24))- where types = (a :: Int16, b :: Int16) +prop_xorI :: Int16 -> Int16 -> Bool prop_xorI a b = (a `xor` b) == fromIntegral ( (fromIntegral a :: Int24) `xor` (fromIntegral b :: Int24))- where types = (a :: Int16, b :: Int16) +prop_xor_identI :: Int24 -> Int24 -> Bool prop_xor_identI a b = (a `xor` b) `xor` b == a- where types = (a :: Int24, b :: Int24) +prop_shiftLI :: Int24 -> Bool prop_shiftLI a = a `shiftL` 1 == a * 2- where types = a :: Int24 +prop_shiftL_identI :: Int24 -> Bool prop_shiftL_identI a = a `shiftL` 0 == a- where types = a :: Int24 +prop_shiftRI :: Int24 -> Property prop_shiftRI a = (a < maxBound `div` 2) && (a > minBound `div` 2) ==> (a * 2) `shift` (-1) == a- where types = a :: Int24 +prop_shiftR2I :: Int24 -> Int -> Property prop_shiftR2I a n = n >= 0 ==> a `shiftR` n == a `shift` (negate n)- where types = a :: Int24 +prop_rotateI :: Int24 -> Int -> Bool prop_rotateI a b = (a `rotate` b) `rotate` (negate b) == a- where types = (a :: Int24, b :: Int) +prop_compI :: Int24 -> Bool prop_compI a = complement (complement a) == a- where types = a :: Int24 -#if MIN_VERSION_base(4,8,0)+prop_clzI :: Int24 -> Bool prop_clzI a = countLeadingZeros a == countLeadingZeros' a where countLeadingZeros' :: Int24 -> Int@@ -305,6 +311,7 @@ w = finiteBitSize x +prop_ctzI :: Int24 -> Bool prop_ctzI a = countTrailingZeros a == countTrailingZeros' a where countTrailingZeros' :: Int24 -> Int@@ -314,18 +321,18 @@ | testBit x i = i | otherwise = go (i+1) w = finiteBitSize x-#endif -- Int Storable properties+prop_sizeOfI :: Int24 -> Bool prop_sizeOfI a = sizeOf a == 3- where types = a :: Int24 +prop_alignI :: Int24 -> Bool prop_alignI a = alignment a == 3- where types = a :: Int24 -- ---------------------------------------- -- tests+tests :: [TestTree] tests = [ testGroup "Word24" [ testGroup "basic" [@@ -369,11 +376,9 @@ ,testProperty "binary rotate" prop_rotate ,testProperty "binary complement" prop_comp ,testProperty "binary byteSwap24" prop_byteSwap-#if MIN_VERSION_base(4,8,0) ,testProperty "binary countLeadingZeros" prop_clz ,testProperty "binary countTrailingZeros" prop_ctz ,testProperty "binary countTrailingZeros 0" (prop_ctz (0::Word24))-#endif ,testProperty "bit/testBit" (prop_bit_ident (0::Word24)) ,testProperty "popCount" (prop_popCount (0::Word24) (0::Word)) ]@@ -422,11 +427,9 @@ ,testProperty "binary shiftR" prop_shiftR2I ,testProperty "binary rotate" prop_rotateI ,testProperty "binary complement" prop_compI-#if MIN_VERSION_base(4,8,0) ,testProperty "binary countLeadingZeros" prop_clzI ,testProperty "binary countTrailingZeros" prop_ctzI ,testProperty "binary countTrailingZeros 0" (prop_ctzI (0::Int24))-#endif ,testProperty "bit/testBit" (prop_bit_ident (0::Int24)) ,testProperty "popCount" (prop_popCount (0::Int24) (0::Int)) ]