Hello community, here is the log from the commit of package ghc-attoparsec for openSUSE:Factory checked in at 2016-04-30 23:30:08 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-attoparsec (Old) and /work/SRC/openSUSE:Factory/.ghc-attoparsec.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-attoparsec" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-attoparsec/ghc-attoparsec.changes 2016-01-08 15:22:39.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-attoparsec.new/ghc-attoparsec.changes 2016-04-30 23:30:09.000000000 +0200 @@ -1,0 +2,9 @@ +Tue Apr 26 07:59:37 UTC 2016 - [email protected] + +- update to 0.13.0.2 +- remove useless _service +* Restore the fast specialised character set implementation for Text +* Move testsuite from test-framework to tasty +* Performance optimization of takeWhile and takeWhile1 + +------------------------------------------------------------------- Old: ---- _service attoparsec-0.13.0.1.tar.gz New: ---- attoparsec-0.13.0.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-attoparsec.spec ++++++ --- /var/tmp/diff_new_pack.2CO8XX/_old 2016-04-30 23:30:10.000000000 +0200 +++ /var/tmp/diff_new_pack.2CO8XX/_new 2016-04-30 23:30:10.000000000 +0200 @@ -20,15 +20,15 @@ %bcond_with tests -Name: ghc-%{pkg_name} -Version: 0.13.0.1 +Name: ghc-attoparsec +Version: 0.13.0.2 Release: 0 Summary: Fast combinator parsing for bytestrings and text License: BSD-3-Clause Group: System/Libraries -Url: http://hackage.haskell.org/package/%{pkg_name} -Source0: http://hackage.haskell.org/packages/archive/%{pkg_name}/%{version}/%{pkg_name}-%{version}.tar.gz +Url: https://hackage.haskell.org/package/%{pkg_name} +Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: ghc-Cabal-devel @@ -44,8 +44,8 @@ %if %{with tests} BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-quickcheck-unicode-devel -BuildRequires: ghc-test-framework-devel -BuildRequires: ghc-test-framework-quickcheck2-devel +BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-quickcheck-devel BuildRequires: ghc-vector-devel %endif # End cabal-rpm deps @@ -58,7 +58,6 @@ %package devel Summary: Haskell %{pkg_name} library development files Group: Development/Libraries/Other -Provides: %{name}-static = %{version}-%{release} Requires: ghc-compiler = %{ghc_version} Requires(post): ghc-compiler = %{ghc_version} Requires(postun): ghc-compiler = %{ghc_version} ++++++ attoparsec-0.13.0.1.tar.gz -> attoparsec-0.13.0.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/ByteString/Internal.hs new/attoparsec-0.13.0.2/Data/Attoparsec/ByteString/Internal.hs --- old/attoparsec-0.13.0.1/Data/Attoparsec/ByteString/Internal.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/Data/Attoparsec/ByteString/Internal.hs 2016-04-22 02:38:31.000000000 +0200 @@ -257,15 +257,24 @@ -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. takeWhile :: (Word8 -> Bool) -> Parser ByteString -takeWhile p = (B.concat . reverse) `fmap` go [] +takeWhile p = do + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then takeWhileAcc p [s] + else return s +{-# INLINE takeWhile #-} + +takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString +takeWhileAcc p = go where go acc = do s <- B8.takeWhile p <$> get continue <- inputSpansChunks (B.length s) if continue then go (s:acc) - else return (s:acc) -{-# INLINE takeWhile #-} + else return $ concatReverse (s:acc) +{-# INLINE takeWhileAcc #-} takeRest :: Parser [ByteString] takeRest = go [] @@ -329,16 +338,13 @@ -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString -scan = scan_ $ \_ chunks -> - case chunks of - [x] -> return x - xs -> return $! B.concat $ reverse xs +scan = scan_ $ \_ chunks -> return $! concatReverse chunks {-# INLINE scan #-} -- | Like 'scan', but generalized to return the final state of the -- scanner. runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) -runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s) +runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s) {-# INLINE runScanner #-} -- | Consume input as long as the predicate returns 'True', and return @@ -358,8 +364,9 @@ advance len eoc <- endOfChunk if eoc - then (s<>) `fmap` takeWhile p + then takeWhileAcc p [s] else return s +{-# INLINE takeWhile1 #-} -- | Match any byte in a set. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Internal.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Internal.hs --- old/attoparsec-0.13.0.1/Data/Attoparsec/Internal.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/Data/Attoparsec/Internal.hs 2016-04-22 02:38:31.000000000 +0200 @@ -20,10 +20,12 @@ , endOfInput , atEnd , satisfyElem + , concatReverse ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +import Data.Monoid (Monoid, mconcat) #endif import Data.Attoparsec.Internal.Types import Data.ByteString (ByteString) @@ -159,3 +161,11 @@ | otherwise -> lose t pos more [] "satisfyElem" Nothing -> satisfySuspended p t pos more lose succ {-# INLINE satisfyElem #-} + +-- | Concatenate a monoid after reversing its elements. Used to +-- glue together a series of textual chunks that have been accumulated +-- \"backwards\". +concatReverse :: Monoid m => [m] -> m +concatReverse [x] = x +concatReverse xs = mconcat (reverse xs) +{-# INLINE concatReverse #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Buffer.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Buffer.hs --- old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Buffer.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Buffer.hs 2016-04-22 02:38:31.000000000 +0200 @@ -82,10 +82,12 @@ instance Monoid Buffer where mempty = Buf A.empty 0 0 0 0 + {-# INLINE mempty #-} mappend (Buf _ _ _ 0 _) b = b mappend a (Buf _ _ _ 0 _) = a mappend buf (Buf arr off len _ _) = append buf arr off len + {-# INLINE mappend #-} mconcat [] = mempty mconcat xs = foldl1' mappend xs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Text/FastSet.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Text/FastSet.hs --- old/attoparsec-0.13.0.1/Data/Attoparsec/Text/FastSet.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/Data/Attoparsec/Text/FastSet.hs 2016-04-22 02:38:31.000000000 +0200 @@ -1,38 +1,118 @@ +{-# LANGUAGE BangPatterns #-} + +------------------------------------------------------------------------------ -- | --- Module : Data.Attoparsec.Text.FastSet --- Copyright : Bryan O'Sullivan 2015 +-- Module : Data.Attoparsec.FastSet +-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015 -- License : BSD3 -- --- Maintainer : [email protected] +-- Maintainer : [email protected] -- Stability : experimental -- Portability : unknown -- --- Fast set membership tests for 'Char' values. - +-- Fast set membership tests for 'Char' values. We test for +-- membership using a hashtable implemented with Robin Hood +-- collision resolution. The set representation is unboxed, +-- and the characters and hashes interleaved, for efficiency. +-- +-- +----------------------------------------------------------------------------- module Data.Attoparsec.Text.FastSet ( -- * Data type FastSet -- * Construction , fromList + , set -- * Lookup , member -- * Handy interface , charClass ) where -import qualified Data.IntSet as I -import Data.Char (ord) +import Data.Bits ((.|.), (.&.), shiftR) +import Data.Function (on) +import Data.List (sort, sortBy) +import qualified Data.Array.Base as AB +import qualified Data.Array.Unboxed as A +import qualified Data.Text as T + +data FastSet = FastSet { + table :: {-# UNPACK #-} !(A.UArray Int Int) + , mask :: {-# UNPACK #-} !Int + } + +data Entry = Entry { + key :: {-# UNPACK #-} !Char + , initialIndex :: {-# UNPACK #-} !Int + , index :: {-# UNPACK #-} !Int + } + +offset :: Entry -> Int +offset e = index e - initialIndex e + +resolveCollisions :: [Entry] -> [Entry] +resolveCollisions [] = [] +resolveCollisions [e] = [e] +resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries) + where (a', b') + | index a < index b = (a, b) + | offset a < offset b = (b { index=index a }, a { index=index a + 1 }) + | otherwise = (a, b { index=index a + 1 }) + +pad :: Int -> [Entry] -> [Entry] +pad = go 0 + where -- ensure that we pad enough so that lookups beyond the + -- last hash in the table fall within the array + go !_ !m [] = replicate (max 1 m + 1) empty + go k m (e:entries) = map (const empty) [k..i - 1] ++ e : + go (i + 1) (m + i - k - 1) entries + where i = index e + empty = Entry '\0' maxBound 0 + +nextPowerOf2 :: Int -> Int +nextPowerOf2 0 = 1 +nextPowerOf2 x = go (x - 1) 1 + where go y 32 = y + 1 + go y k = go (y .|. (y `shiftR` k)) $ k * 2 -newtype FastSet = FastSet I.IntSet +fastHash :: Char -> Int +fastHash = fromEnum fromList :: String -> FastSet -fromList = FastSet . I.fromList . map ord +fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved) + mask' + where s' = ordNub (sort s) + l = length s' + mask' = nextPowerOf2 ((5 * l) `div` 4) - 1 + entries = pad mask' . + resolveCollisions . + sortBy (compare `on` initialIndex) . + zipWith (\c i -> Entry c i i) s' . + map ((.&. mask') . fastHash) $ s' + interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e]) + entries + +ordNub :: Eq a => [a] -> [a] +ordNub [] = [] +ordNub (y:ys) = go y ys + where go x (z:zs) + | x == z = go x zs + | otherwise = x : go z zs + go x [] = [x] + +set :: T.Text -> FastSet +set = fromList . T.unpack -- | Check the set for membership. member :: Char -> FastSet -> Bool -member c (FastSet s) = I.member (ord c) s -{-# INLINE member #-} +member c a = go (2 * i) + where i = fastHash c .&. mask a + lookupAt j b = (i' <= i) && (c == c' || b) + where c' = toEnum $ AB.unsafeAt (table a) j + i' = AB.unsafeAt (table a) $ j + 1 + go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) . + lookupAt (j + 6) . go $ j + 8 charClass :: String -> FastSet charClass = fromList . go diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Internal.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Internal.hs --- old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Internal.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Internal.hs 2016-04-22 02:38:31.000000000 +0200 @@ -269,14 +269,25 @@ -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. takeWhile :: (Char -> Bool) -> Parser Text -takeWhile p = (T.concat . reverse) `fmap` go [] +takeWhile p = do + h <- T.takeWhile p <$> get + continue <- inputSpansChunks (size h) + -- only use slow concat path if necessary + if continue + then takeWhileAcc p [h] + else return h +{-# INLINE takeWhile #-} + +takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text +takeWhileAcc p = go where go acc = do h <- T.takeWhile p <$> get continue <- inputSpansChunks (size h) if continue then go (h:acc) - else return (h:acc) + else return $ concatReverse (h:acc) +{-# INLINE takeWhileAcc #-} takeRest :: Parser [Text] takeRest = go [] @@ -334,16 +345,13 @@ -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. scan :: s -> (s -> Char -> Maybe s) -> Parser Text -scan = scan_ $ \_ chunks -> - case chunks of - [x] -> return x - xs -> return . T.concat . reverse $ xs +scan = scan_ $ \_ chunks -> return $! concatReverse chunks {-# INLINE scan #-} -- | Like 'scan', but generalized to return the final state of the -- scanner. runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s) -runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s) +runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s) {-# INLINE runScanner #-} -- | Consume input as long as the predicate returns 'True', and return @@ -361,8 +369,9 @@ advance size' eoc <- endOfChunk if eoc - then (h<>) `fmap` takeWhile p + then takeWhileAcc p [h] else return h +{-# INLINE takeWhile1 #-} -- | Match any character in a set. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/attoparsec.cabal new/attoparsec-0.13.0.2/attoparsec.cabal --- old/attoparsec-0.13.0.1/attoparsec.cabal 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/attoparsec.cabal 2016-04-22 02:38:31.000000000 +0200 @@ -1,12 +1,12 @@ name: attoparsec -version: 0.13.0.1 +version: 0.13.0.2 license: BSD3 license-file: LICENSE category: Text, Parsing author: Bryan O'Sullivan <[email protected]> maintainer: Bryan O'Sullivan <[email protected]> stability: experimental -tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10 +tested-with: GHC == 7.0.1, GHC == 7.2.1, GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3 synopsis: Fast combinator parsing for bytestrings and text cabal-version: >= 1.8 homepage: https://github.com/bos/attoparsec @@ -89,6 +89,7 @@ QC.Rechunked QC.Simple QC.Text + QC.Text.FastSet ghc-options: -Wall -threaded -rtsopts @@ -100,13 +101,12 @@ array, base >= 4 && < 5, bytestring, - containers, deepseq >= 1.1, QuickCheck >= 2.7, quickcheck-unicode, scientific, - test-framework >= 0.8.0.2, - test-framework-quickcheck2 >= 0.3.0.3, + tasty >= 0.11, + tasty-quickcheck >= 0.8, text, transformers, vector @@ -136,7 +136,6 @@ base == 4.*, bytestring >= 0.10.4.0, case-insensitive, - containers, criterion >= 1.0, deepseq >= 1.1, directory, @@ -146,6 +145,7 @@ parsec >= 3.1.2, scientific, text >= 1.1.1.0, + transformers, unordered-containers, vector diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/Benchmarks.hs new/attoparsec-0.13.0.2/benchmarks/Benchmarks.hs --- old/attoparsec-0.13.0.1/benchmarks/Benchmarks.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/benchmarks/Benchmarks.hs 2016-04-22 02:38:31.000000000 +0200 @@ -71,10 +71,14 @@ , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl , bench "isAlpha_iso8859_15" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl + , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile isAlpha)) t + , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile isAlpha)) tl ] , bgroup "takeWhile1" [ bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl + , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile1 isAlpha)) t + , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile1 isAlpha)) tl ] , bench "word32LE" $ nf (AB.parse word32LE) b , bgroup "scan" [ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/Main.hs new/attoparsec-0.13.0.2/benchmarks/Main.hs --- old/attoparsec-0.13.0.1/benchmarks/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/attoparsec-0.13.0.2/benchmarks/Main.hs 2016-04-22 02:38:31.000000000 +0200 @@ -0,0 +1,4 @@ +import Sets +import Criterion.Main + +main = defaultMain [Sets.benchmarks] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/TextFastSet.hs new/attoparsec-0.13.0.2/benchmarks/TextFastSet.hs --- old/attoparsec-0.13.0.1/benchmarks/TextFastSet.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/benchmarks/TextFastSet.hs 2016-04-22 02:38:31.000000000 +0200 @@ -62,7 +62,9 @@ pad :: Int -> [Entry] -> [Entry] pad = go 0 - where go !_ !m [] = replicate (max 1 m) empty + where -- ensure that we pad enough so that lookups beyond the + -- last hash in the table fall within the array + go !_ !m [] = replicate (max 1 m + 1) empty go k m (e:entries) = map (const empty) [k..i - 1] ++ e : go (i + 1) (m + i - k - 1) entries where i = index e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/attoparsec-benchmarks.cabal new/attoparsec-0.13.0.2/benchmarks/attoparsec-benchmarks.cabal --- old/attoparsec-0.13.0.1/benchmarks/attoparsec-benchmarks.cabal 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/benchmarks/attoparsec-benchmarks.cabal 2016-04-22 02:38:31.000000000 +0200 @@ -17,6 +17,7 @@ Numbers Network.Wai.Handler.Warp.ReadInt Sets + TextFastSet Warp hs-source-dirs: .. . warp-3.0.1.1 ghc-options: -O2 -Wall -rtsopts diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/changelog.md new/attoparsec-0.13.0.2/changelog.md --- old/attoparsec-0.13.0.1/changelog.md 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/changelog.md 2016-04-22 02:38:31.000000000 +0200 @@ -1,3 +1,9 @@ +0.13.0.2 + +* Restore the fast specialised character set implementation for Text +* Move testsuite from test-framework to tasty +* Performance optimization of takeWhile and takeWhile1 + 0.13.0.1 * Fixed a bug in the implementations of inClass and notInClass for diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Buffer.hs new/attoparsec-0.13.0.2/tests/QC/Buffer.hs --- old/attoparsec-0.13.0.1/tests/QC/Buffer.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC/Buffer.hs 2016-04-22 02:38:31.000000000 +0200 @@ -8,8 +8,8 @@ import Data.Monoid (Monoid(mconcat)) #endif import QC.Common () -import Test.Framework (Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck import qualified Data.Attoparsec.ByteString.Buffer as BB import qualified Data.Attoparsec.Text.Buffer as BT @@ -82,7 +82,7 @@ i <- choose (0, T.lengthWord16 t) return $ T.dropWord16 i t === BT.dropWord16 i buf -tests :: [Test] +tests :: [TestTree] tests = [ testProperty "b_unbuffer" b_unbuffer , testProperty "t_unbuffer" t_unbuffer diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/ByteString.hs new/attoparsec-0.13.0.2/tests/QC/ByteString.hs --- old/attoparsec-0.13.0.1/tests/QC/ByteString.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC/ByteString.hs 2016-04-22 02:38:31.000000000 +0200 @@ -9,8 +9,8 @@ import Data.Word (Word8) import Prelude hiding (take, takeWhile) import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS) -import Test.Framework (Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck import qualified Data.Attoparsec.ByteString as P import qualified Data.Attoparsec.ByteString.Char8 as P8 @@ -155,7 +155,7 @@ nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s' where set = S.fromList s -tests :: [Test] +tests :: [TestTree] tests = [ testProperty "anyWord8" anyWord8 , testProperty "endOfInput" endOfInput diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Combinator.hs new/attoparsec-0.13.0.2/tests/QC/Combinator.hs --- old/attoparsec-0.13.0.1/tests/QC/Combinator.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC/Combinator.hs 2016-04-22 02:38:31.000000000 +0200 @@ -8,8 +8,8 @@ import Data.Maybe (fromJust, isJust) import Data.Word (Word8) import QC.Common (Repack, parseBS, repackBS, toLazyBS) -import Test.Framework (Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck import qualified Data.Attoparsec.ByteString.Char8 as P import qualified Data.Attoparsec.Combinator as C @@ -43,7 +43,7 @@ B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y' ] -tests :: [Test] +tests :: [TestTree] tests = [ testProperty "choice" choice , testProperty "count" count diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/IPv6.hs new/attoparsec-0.13.0.2/tests/QC/IPv6.hs --- old/attoparsec-0.13.0.1/tests/QC/IPv6.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC/IPv6.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,322 +0,0 @@ --- ----------------------------------------------------------------------------- - --- | --- Module : Text.IPv6Addr --- Copyright : Copyright © Michel Boucey 2011-2015 --- License : BSD-Style --- Maintainer : [email protected] --- --- Dealing with IPv6 address text representations, canonization and manipulations. --- - --- ----------------------------------------------------------------------------- - -{-# LANGUAGE OverloadedStrings #-} - -module Text.IPv6Addr.Internal - ( expandTokens - , macAddr - , maybeIPv6AddrTokens - , ipv4AddrToIPv6AddrTokens - , ipv6TokensToText - , ipv6TokensToIPv6Addr - , isIPv6Addr - , maybeTokIPv6Addr - , maybeTokPureIPv6Addr - , fromDoubleColon - , fromIPv6Addr - , toDoubleColon - , networkInterfacesIPv6AddrList - ) where - -import Control.Monad (replicateM) -import Data.Attoparsec.Text -import Data.Char (isDigit,isHexDigit,toLower) -import Data.Monoid ((<>)) -import Control.Applicative ((<|>),(<*)) -import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse) -import Numeric (showHex) -import qualified Data.Text as T -import qualified Data.Text.Read as R (decimal) -import Data.Maybe (fromJust) -import Network.Info - -import Text.IPv6Addr.Types - -tok0 = "0" - --- | Returns the 'T.Text' of an IPv6 address. -fromIPv6Addr :: IPv6Addr -> T.Text -fromIPv6Addr (IPv6Addr t) = t - --- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'. -ipv6TokensToText :: [IPv6AddrToken] -> T.Text -ipv6TokensToText l = T.concat $ map ipv6TokenToText l - --- | Returns the corresponding 'T.Text' of an IPv6 address token. -ipv6TokenToText :: IPv6AddrToken -> T.Text -ipv6TokenToText (SixteenBit s) = s -ipv6TokenToText Colon = ":" -ipv6TokenToText DoubleColon = "::" -ipv6TokenToText AllZeros = tok0 -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1) -ipv6TokenToText (IPv4Addr a) = a - --- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. -isIPv6Addr :: [IPv6AddrToken] -> Bool -isIPv6Addr [] = False -isIPv6Addr [DoubleColon] = True -isIPv6Addr [DoubleColon,SixteenBit tok1] = True -isIPv6Addr tks = - diffNext tks && (do - let cdctks = countDoubleColon tks - let lentks = length tks - let lasttk = last tks - let lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1) - firstValidToken tks && - (case countIPv4Addr tks of - 0 -> case lasttk of - SixteenBit _ -> lenconst - DoubleColon -> lenconst - AllZeros -> lenconst - _ -> False - 1 -> case lasttk of - IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1) - _ -> False - otherwise -> False)) - where diffNext [] = False - diffNext [_] = True - diffNext (t:ts) = do - let h = head ts - case t of - SixteenBit _ -> case h of - SixteenBit _ -> False - AllZeros -> False - _ -> diffNext ts - AllZeros -> case h of - SixteenBit _ -> False - AllZeros -> False - _ -> diffNext ts - _ -> diffNext ts - firstValidToken l = - case head l of - SixteenBit _ -> True - DoubleColon -> True - AllZeros -> True - _ -> False - countDoubleColon l = length $ elemIndices DoubleColon l - tok1 = "1" - -countIPv4Addr = foldr oneMoreIPv4Addr 0 - where - oneMoreIPv4Addr t c = case t of - IPv4Addr _ -> c + 1 - otherwise -> c - --- | This is the main function which returns 'Just' the list of a tokenized IPv6 --- address text representation validated against RFC 4291 and canonized --- in conformation with RFC 5952, or 'Nothing'. -maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken] -maybeTokIPv6Addr t = - case maybeIPv6AddrTokens t of - Just ltks -> if isIPv6Addr ltks - then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks - else Nothing - Nothing -> Nothing - where - ipv4AddrReplacement ltks = - if ipv4AddrRewrite ltks - then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks) - else ltks - --- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an --- embedded IPv4 address if present. -maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken] -maybeTokPureIPv6Addr t = do - ltks <- maybeIPv6AddrTokens t - if isIPv6Addr ltks - then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks - else Nothing - where - ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') - --- | Tokenize a 'T.Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'. -maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] -maybeIPv6AddrTokens s = - case readText s of - Done r l -> if r==T.empty then Just l else Nothing - Fail {} -> Nothing - where - readText s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) s) T.empty - --- | An embedded IPv4 address have to be rewritten to output a pure IPv6 Address --- text representation in hexadecimal digits. But some well-known prefixed IPv6 --- addresses have to keep visible in their text representation the fact that --- they deals with IPv4 to IPv6 transition process (RFC 5952 Section 5): --- --- IPv4-compatible IPv6 address like "::1.2.3.4" --- --- IPv4-mapped IPv6 address like "::ffff:1.2.3.4" --- --- IPv4-translated address like "::ffff:0:1.2.3.4" --- --- IPv4-translatable address like "64:ff9b::1.2.3.4" --- --- ISATAP address like "fe80::5efe:1.2.3.4" --- -ipv4AddrRewrite :: [IPv6AddrToken] -> Bool -ipv4AddrRewrite tks = - case last tks of - IPv4Addr _ -> do - let itks = init tks - not (itks == [DoubleColon] - || itks == [DoubleColon,SixteenBit tokffff,Colon] - || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon] - || itks == [SixteenBit "64",Colon,SixteenBit "ff9b",DoubleColon] - || [SixteenBit "200",Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks - || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks - || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks) - _ -> False - where - tokffff = "ffff" - tok5efe = "5efe" - --- | Rewrites an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens. --- --- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"] --- -ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken] -ipv4AddrToIPv6AddrTokens t = - case t of - IPv4Addr a -> do - let m = toHex a - [ SixteenBit ((!!) m 0 <> addZero ((!!) m 1)) - , Colon - , SixteenBit ((!!) m 2 <> addZero ((!!) m 3)) ] - _ -> [t] - where - toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a - addZero d = if T.length d == 1 then tok0 <> d else d - -expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken] -expandTokens = map expandToken - where expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s - expandToken AllZeros = SixteenBit "0000" - expandToken t = t - -fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken] -fromDoubleColon tks = - if DoubleColon `notElem` tks - then tks - else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks - let fsts = fst s - let snds = if not (null (snd s)) then tail(snd s) else [] - let fste = if null fsts then [] else fsts ++ [Colon] - let snde = if null snds then [] else Colon : snds - fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde - where - allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros) - quantityOfAllZerosTokenToReplace x = - ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x - where - ntks tks = if countIPv4Addr tks == 1 then 7 else 8 - -toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken] -toDoubleColon tks = - zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks) - where - zerosToDoubleColon :: [IPv6AddrToken] -> (Int,Int) -> [IPv6AddrToken] - -- No all zeros token, so no double colon replacement... - zerosToDoubleColon ls (_,0) = ls - -- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 5952 4.2.2) - zerosToDoubleColon ls (_,1) = ls - zerosToDoubleColon ls (i,l) = - let ls' = filter (/= Colon) ls - in intersperse Colon (Prelude.take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls') - zerosRunToReplace t = - let l = longestLengthZerosRun t - in (firstLongestZerosRunIndex t l,l) - where - firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x - longestLengthZerosRun x = - maximum $ map longest x - where longest t = case t of - (True,i) -> i - _ -> 0 - zerosRunsList x = map helper $ groupZerosRuns x - where - helper h = (head h == AllZeros, lh) where lh = length h - groupZerosRuns = group . filter (/= Colon) - -ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr -ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l - -networkInterfacesIPv6AddrList :: IO [(String,IPv6)] -networkInterfacesIPv6AddrList = - getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n - where - networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a) - -fullSixteenBit :: T.Text -> Maybe IPv6AddrToken -fullSixteenBit t = - case parse ipv6AddrFullChunk t of - Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing - _ -> Nothing - -macAddr :: Parser (Maybe [IPv6AddrToken]) -macAddr = do - n1 <- count 2 hexaChar <* ":" - n2 <- count 2 hexaChar <* ":" - n3 <- count 2 hexaChar <* ":" - n4 <- count 2 hexaChar <* ":" - n5 <- count 2 hexaChar <* ":" - n6 <- count 2 hexaChar - return $ maybeIPv6AddrTokens $ T.pack $ concat [n1,n2,n3,n4,n5,n6] - -sixteenBit :: Parser IPv6AddrToken -sixteenBit = do - r <- ipv6AddrFullChunk <|> count 3 hexaChar <|> count 2 hexaChar <|> count 1 hexaChar - -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1) - let r' = T.dropWhile (=='0') $ T.pack r - return $ if T.null r' - then AllZeros - -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3) - else SixteenBit $ T.toLower r' - -ipv4Addr :: Parser IPv6AddrToken -ipv4Addr = do - n1 <- manyDigits <* "." - if n1 /= T.empty - then do n2 <- manyDigits <* "." - if n2 /= T.empty - then do n3 <- manyDigits <* "." - if n3 /= T.empty - then do n4 <- manyDigits - if n4 /= T.empty - then return $ IPv4Addr $ T.intercalate "." [n1,n2,n3,n4] - else parserFailure - else parserFailure - else parserFailure - else parserFailure - where - parserFailure = fail "ipv4Addr parsing failure" - manyDigits = do - ds <- takeWhile1 isDigit - case R.decimal ds of - Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty) - Left _ -> return T.empty - -doubleColon :: Parser IPv6AddrToken -doubleColon = do - string "::" - return DoubleColon - -colon :: Parser IPv6AddrToken -colon = do - string ":" - return Colon - -ipv6AddrFullChunk :: Parser String -ipv6AddrFullChunk = count 4 hexaChar - -hexaChar :: Parser Char -hexaChar = satisfy (inClass "0-9a-fA-F") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Simple.hs new/attoparsec-0.13.0.2/tests/QC/Simple.hs --- old/attoparsec-0.13.0.1/tests/QC/Simple.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC/Simple.hs 2016-04-22 02:38:31.000000000 +0200 @@ -10,8 +10,8 @@ import Data.List (foldl') import Data.Maybe (fromMaybe) import QC.Rechunked (rechunkBS) -import Test.Framework (Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck (Property, counterexample, forAll) import qualified Data.Attoparsec.ByteString.Char8 as A @@ -31,7 +31,7 @@ parse p (x:xs) = foldl' A.feed (A.parse p x) xs parse p [] = A.parse p "" -tests :: [Test] +tests :: [TestTree] tests = [ testProperty "issue75" t_issue75 ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Text/FastSet.hs new/attoparsec-0.13.0.2/tests/QC/Text/FastSet.hs --- old/attoparsec-0.13.0.1/tests/QC/Text/FastSet.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/attoparsec-0.13.0.2/tests/QC/Text/FastSet.hs 2016-04-22 02:38:31.000000000 +0200 @@ -0,0 +1,15 @@ +module QC.Text.FastSet where + +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (testProperty) +import Test.QuickCheck +import qualified Data.Attoparsec.Text.FastSet as FastSet + +membershipCorrect :: String -> String -> Property +membershipCorrect members others = + let fs = FastSet.fromList members + correct c = (c `FastSet.member` fs) == (c `elem` members) + in property $ all correct (members ++ others) + +tests :: [TestTree] +tests = [ testProperty "membership is correct" membershipCorrect ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Text.hs new/attoparsec-0.13.0.2/tests/QC/Text.hs --- old/attoparsec-0.13.0.1/tests/QC/Text.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC/Text.hs 2016-04-22 02:38:31.000000000 +0200 @@ -8,8 +8,9 @@ import Data.Int (Int64) import Prelude hiding (take, takeWhile) import QC.Common (liftOp, parseT) -import Test.Framework (Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import qualified QC.Text.FastSet as FastSet +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck import qualified Data.Attoparsec.Text as P import qualified Data.Attoparsec.Text.Lazy as PL @@ -160,7 +161,7 @@ nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s' where set = S.fromList s -tests :: [Test] +tests :: [TestTree] tests = [ testProperty "anyChar" anyChar , testProperty "asciiCI" asciiCI @@ -188,4 +189,5 @@ , testProperty "takeWhile1_empty" takeWhile1_empty , testProperty "members" members , testProperty "nonmembers" nonmembers + , testGroup "FastSet" FastSet.tests ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC.hs new/attoparsec-0.13.0.2/tests/QC.hs --- old/attoparsec-0.13.0.1/tests/QC.hs 2015-07-09 02:08:52.000000000 +0200 +++ new/attoparsec-0.13.0.2/tests/QC.hs 2016-04-22 02:38:31.000000000 +0200 @@ -6,11 +6,11 @@ import qualified QC.Combinator as Combinator import qualified QC.Simple as Simple import qualified QC.Text as Text -import Test.Framework (defaultMain, testGroup) +import Test.Tasty (defaultMain, testGroup) main = defaultMain tests -tests = [ +tests = testGroup "tests" [ testGroup "bs" ByteString.tests , testGroup "buf" Buffer.tests , testGroup "combinator" Combinator.tests
