packages feed

testing-feat 1.1.0.0 → 1.1.1.0

raw patch · 7 files changed

+122/−119 lines, 7 filesdep −semigroupsdep ~basenew-uploader

Dependencies removed: semigroups

Dependency ranges changed: base

Files

+ CHANGELOG.md view
@@ -0,0 +1,4 @@+* 1.1.1.0 (17 May 2022)++    - Test with GHC 8.6 through 9.2+    - Update maintainer and source repository information
Test/Feat/Access.hs view
@@ -27,7 +27,6 @@ --import Data.Modifiers  -- base-import Data.List import Data.Ratio((%))  @@ -90,11 +89,11 @@   uni :: [Finite a] -> Int -> Gen a   uni  []  _     =  error "uniform: empty enumeration"   uni  ps  maxp  =  let  (incl, rest)  = splitAt maxp ps-                         fin           = mconcat incl-    in  case fCard fin of+                         f             = mconcat incl+    in  case fCard f of           0  -> uni rest 1-          _  -> do  i <- choose (0,fCard fin-1)-                    return (fIndex fin i)+          _  -> do  i <- choose (0,fCard f - 1)+                    return (fIndex f i)                       -- | Enumerates every nth value of the enumeration from a given starting index.@@ -105,14 +104,14 @@ skipping :: Enumerate a -> Index -> Integer -> Enumerate a skipping _ o0 step | step <= 0 || o0 < 0 = error "skippingWith: invalid argument" skipping e o0 step = fromParts $ go o0 (parts e) where-   go o []      = []+   go _ []      = []    go o _       | o < 0 = error "negative"    go o (p:ps)  = p' : go o' ps where -- error (show (space,take,o')) :       space = fCard p - o-     (take,o')  | space <= 0   = (0,o-fCard p)+     (nTake,o') | space <= 0   = (0,o-fCard p)                 | space < step = (1,step-space)                 | otherwise    = (space `quotRem` step)-     p' = Finite{fCard = take +     p' = Finite{fCard = nTake            , fIndex = \i -> fIndex p (i*step + o)}  -- | A version of values with a limited number of values in each inner list.@@ -124,7 +123,7 @@     -- This is "fair" if we consider using samplePart on the next part as well.     -- An alternative would be to make the last index used |crd-1|.     samplePart :: Index -> Finite a -> Finite a-    samplePart m f@(Finite crd ix) =+    samplePart m f@(Finite crd _) =       let  step  =  crd % m       in if crd <= m            then f
Test/Feat/Class.hs view
@@ -13,11 +13,11 @@ 
 -- compatability
 {-# DEPRECATED nullary "use c0 instead" #-}
--- nullary :: x -> Memoizable f x
+nullary :: Sized f => a -> Shareable f a
 nullary x = c0 x
 
 {-# DEPRECATED unary "use c1 instead" #-}
--- unary :: (Enumerable a, MemoSized f) => (a -> x) -> f x
+unary :: (Sized f, Enumerable a, Typeable f) => (a -> x) -> Shareable f x
 unary x = c1 x
 
 {-# DEPRECATED shared "use access instead" #-}
@@ -25,8 +25,9 @@ shared = access
 
 
+funcurry :: (a -> b -> c) -> (a,b) -> c
 funcurry = uncurry
 
 {-# DEPRECATED consts "use datatype instead" #-}
---consts :: (Typeable a, MemoSized f) => [f a] -> Closed (f a)
+consts :: (Sized f, Typeable f, Typeable a) => [Shareable f a] -> Shared f a
 consts xs = datatype xs
Test/Feat/Driver.hs view
@@ -1,7 +1,7 @@ -- | A simple testing driver for testing properties using FEAT.--- Contains three drivers with different levels of flexibility of configuration. +-- Contains three drivers with different levels of flexibility of configuration. ----- Ironically, this code is mostly untested at the moment. +-- Ironically, this code is mostly untested at the moment. module Test.Feat.Driver(    -- * Simple test driver    test@@ -12,7 +12,7 @@    -- * Extremely flexible test driver    , testFlex    , Result(..)-   , FlexibleOptions(..)+   , FlexibleOptions    , FlexOptions(..)    , defFlex    , toFlex@@ -38,11 +38,11 @@    } deriving (Show,Read)  -- | Much more flexible options for configuring every part of the test execution.--- @a@ is the parameter type of the property. +-- @a@ is the parameter type of the property. type FlexibleOptions a = IO (FlexOptions a)  -- | FlexOptions-data FlexOptions a = FlexOptions +data FlexOptions a = FlexOptions    { fIO      :: IO Bool     -> IO (Result,[a]) -- ^ The whole execution of the test is sent through this function.    , fReport  :: a           -> IO Bool -- ^ Applied to each found counterexample, return False to stop testing    , fOutput  :: String      -> IO () -- ^ Print text@@ -53,7 +53,7 @@ data Result = Exhausted -- ^ Reached max size             | Quota     -- ^ Reached max number of counterexamples             | TimedOut-            | Other     +            | Other             deriving Show  -- | 60 seconds timeout, maximum size of 100, bound of 100000 tests per size@@ -90,11 +90,11 @@         return (n < mx)       doIO io = do         mb <- maybe (fmap Just io) (\t -> timeout (t*1000000) io) (oTimeoutSec o)-        res <- readIORef res -        return $ maybe (TimedOut,res) (\b -> if b then (Exhausted,res) else (Quota,res)) mb-      skip  = maybe id (\(i,n) e -> skipping e i n) (oSkipping o)-      bound = maybe id (\n e -> bounded e n) (oBounded o)-      sizes = maybe id (\bs e -> sizeRange e bs) (oSizeFromTo o)+        res' <- readIORef res+        return $ maybe (TimedOut,res') (\b -> if b then (Exhausted,res') else (Quota,res')) mb+      skip  = maybe id (flip (uncurry . skipping)) (oSkipping o)+      bound = maybe id (flip bounded) (oBounded o)+      sizes = maybe id (flip sizeRange) (oSizeFromTo o)   return $ FlexOptions       { fIO = doIO       , fOutput = if oSilent o then const (return ()) else putStr@@ -110,7 +110,7 @@ -- | Test with basic options. Returns a list of counterexamples. testOptions :: Enumerable a => Options -> (a -> Bool) -> IO [a] testOptions o p = fmap snd $ testFlex fo p-  where +  where     fo = toFlex o  -- | The most flexible test driver, can be configured to behave in almost any way.@@ -119,11 +119,11 @@   op <- ioOp   let e = fProcess op (fEnum op)       lazyResult = [(n,filter (not . p) xs) | (n,xs) <- valuesWith e]-      runSize k (n,cs) = do +      runSize k (n,cs) = do         fOutput op $ "*** Searching in " ++ show n ++ " values of size " ++ show k ++ "\n"-        doWhile (map (\x -> fOutput op "Counterexample found!\n" >> fReport op x) cs) -  rxs@(r,_) <- fIO op ((doWhile $ zipWith runSize [0..] lazyResult))-  case r of +        doWhile (map (\x -> fOutput op "Counterexample found!\n" >> fReport op x) cs)+  rxs@(r,_) <- fIO op ((doWhile $ zipWith runSize [0 :: Integer ..] lazyResult))+  case r of      Exhausted -> fOutput op "Search space exhausted\n"      TimedOut  -> fOutput op "Timed out\n"      _         -> return ()@@ -133,4 +133,3 @@ doWhile :: [IO Bool] -> IO Bool doWhile [] = return True doWhile (iob:iobs) = iob >>= \b -> if b then doWhile iobs else return False-
Test/Feat/Enumerate.hs view
@@ -42,10 +42,8 @@ import Data.List(transpose) import Test.Feat.Finite -type Part = Int- -- | A functional enumeration of type @t@ is a partition of--- @t@ into finite numbered sets called Parts. Each parts contains values+-- @t@ into finite numbered sets. Each part contains values -- of a certain cost (typically the size of the value). data Enumerate a = Enumerate    { revParts   ::  RevList (Finite a)@@ -82,7 +80,6 @@ -- | The @'mappend'@ is (disjoint) @'union'@ instance Monoid (Enumerate a) where   mempty      = empty-  mappend     = union   mconcat     = econcat  -- | Optimal 'mconcat' on enumerations.@@ -95,6 +92,7 @@   -- Product of two enumerations+cartesian :: Enumerate a -> Enumerate b -> Enumerate (a,b) cartesian (Enumerate xs1) (Enumerate xs2) = Enumerate (xs1 `prod` xs2)  prod :: RevList (Finite a) -> RevList (Finite b) -> RevList (Finite (a,b))@@ -103,7 +101,7 @@    -- We need to thread carefully here, making sure that guarded recursion is safe   prod' []        = []-  prod' (ry:rys)  = go ry rys where+  prod' (h:t)  = go h t where     go ry rys = conv xs0 ry : case rys of       (ry':rys')   -> go ry' rys'       []           -> prod'' ry xst@@ -126,7 +124,7 @@         then  let (q, r) = (i `quotRem` fCard f2)               in (fIndex f1 q, fIndex f2 r)         else prodSel f1s f2s (i-mul)-  prodSel _ _ = \i -> error "index out of bounds"+  prodSel _ _ = \_ -> error "index out of bounds"   union :: Enumerate a -> Enumerate a -> Enumerate a@@ -155,14 +153,14 @@   fmap f = toRev . fmap f . fromRev  instance Semigroup a => Semigroup (RevList a) where-  (<>) xs ys  = toRev $ zipMon (fromRev xs) (fromRev ys) where+  (<>) as bs  = toRev $ zipMon (fromRev as) (fromRev bs) where     zipMon :: Semigroup a => [a] -> [a] -> [a]     zipMon (x:xs) (y:ys) = x <> y : zipMon xs ys     zipMon xs ys         = xs ++ ys  -- Maybe this should be append instead? -- | Padded zip-instance (Monoid a, Semigroup a) => Monoid (RevList a) where+instance Semigroup a => Monoid (RevList a) where   mempty   = toRev[]   mappend  = (<>) @@ -170,13 +168,15 @@ -- Haskell implementation evaluating any inital segment of -- @'reversals' (toRev xs)@ uses linear memory in the size of the segment. toRev:: [a] -> RevList a-toRev xs = RevList xs $ go [] xs where+toRev as = RevList as $ go [] as where   go _ []       = []   go rev (x:xs) = let rev' = x:rev in rev' : go rev' xs  -- | Adds an  element to the head of a @RevList@. Constant memory iff the -- the reversals of the resulting list are not evaluated (which is frequently -- the case in @Feat@).+revCons :: a -> RevList a -> RevList a revCons a = toRev. (a:) . fromRev +revPure :: a -> RevList a revPure a = RevList [a] [[a]]
Test/Feat/Finite.hs view
@@ -1,72 +1,70 @@--- | A datatype of finite sequences
-module Test.Feat.Finite (Finite (..), Index, fromFinite, finFin) where
-
-import Control.Applicative
-import Data.Semigroup
-import Data.Monoid
-
-type Index = Integer
-data Finite a = Finite {fCard :: Index, fIndex :: Index -> a}
-
-finEmpty = Finite 0 (\i -> error "index: Empty")
-
-finUnion :: Finite a -> Finite a -> Finite a
-finUnion f1 f2
-  | fCard f1 == 0  = f2
-  | fCard f2 == 0  = f1
-  | otherwise      = Finite car sel where
-  car = fCard f1 + fCard f2
-  sel i = if i < fCard f1
-    then fIndex f1 i
-    else fIndex f2 (i-fCard f1)
-
-instance Functor Finite where
-  fmap f fin = fin{fIndex = f . fIndex fin}
-
-instance Applicative Finite where
-  pure = finPure
-  a <*> b = fmap (uncurry ($)) (finCart a b)
-
-instance Alternative Finite where
-  empty = finEmpty
-  (<|>) = finUnion
-
-instance Semigroup (Finite a) where
-  (<>) = finUnion
-
-instance Monoid (Finite a) where
-  mempty = finEmpty
-  mappend = finUnion
-  mconcat xs = Finite
-    (sum $ map fCard xs)
-    (sumSel $ filter ((>0) . fCard) xs)
-
-sumSel :: [Finite a] -> (Index -> a)
-sumSel (f:rest) = \i -> if i < fCard f
-  then fIndex f i
-  else sumSel rest (i-fCard f)
-sumSel _        = error "Index out of bounds"
-
-finCart :: Finite a -> Finite b -> Finite (a,b)
-finCart f1 f2 = Finite car sel where
-  car = fCard f1 * fCard f2
-  sel i = let (q, r) = (i `quotRem` fCard f2)
-    in (fIndex f1 q, fIndex f2 r)
-
-finPure :: a -> Finite a
-finPure a = Finite 1 one where
-  one 0 = a
-  one _ = error "Index out of bounds"
-
-
-fromFinite :: Finite a -> (Index,[a])
-fromFinite (Finite c ix) = (c,map ix [0..c-1])
-
-
-instance Show a => Show (Finite a) where
-  show = show . fromFinite
-
-finFin :: Integer -> Finite Integer
-finFin k | k <= 0 = finEmpty
-finFin k = Finite k (\i -> i)
+-- | A datatype of finite sequences+module Test.Feat.Finite (Finite (..), Index, fromFinite, finFin) where +import Control.Applicative++type Index = Integer+data Finite a = Finite {fCard :: Index, fIndex :: Index -> a}++finEmpty :: Finite a+finEmpty = Finite 0 (\_ -> error "index: Empty")++finUnion :: Finite a -> Finite a -> Finite a+finUnion f1 f2+  | fCard f1 == 0  = f2+  | fCard f2 == 0  = f1+  | otherwise      = Finite car sel where+  car = fCard f1 + fCard f2+  sel i = if i < fCard f1+    then fIndex f1 i+    else fIndex f2 (i-fCard f1)++instance Functor Finite where+  fmap f fin = fin{fIndex = f . fIndex fin}++instance Applicative Finite where+  pure = finPure+  a <*> b = fmap (uncurry ($)) (finCart a b)++instance Alternative Finite where+  empty = finEmpty+  (<|>) = finUnion++instance Semigroup (Finite a) where+  (<>) = finUnion++instance Monoid (Finite a) where+  mempty = finEmpty+  mappend = finUnion+  mconcat xs = Finite+    (sum $ map fCard xs)+    (sumSel $ filter ((>0) . fCard) xs)++sumSel :: [Finite a] -> (Index -> a)+sumSel (f:rest) = \i -> if i < fCard f+  then fIndex f i+  else sumSel rest (i-fCard f)+sumSel _        = error "Index out of bounds"++finCart :: Finite a -> Finite b -> Finite (a,b)+finCart f1 f2 = Finite car sel where+  car = fCard f1 * fCard f2+  sel i = let (q, r) = (i `quotRem` fCard f2)+    in (fIndex f1 q, fIndex f2 r)++finPure :: a -> Finite a+finPure a = Finite 1 one where+  one 0 = a+  one _ = error "Index out of bounds"+++fromFinite :: Finite a -> (Index,[a])+fromFinite (Finite c ix) = (c,map ix [0..c-1])+++instance Show a => Show (Finite a) where+  show = show . fromFinite++finFin :: Integer -> Finite Integer+finFin k | k <= 0 = finEmpty+finFin k = Finite k (\i -> i)
testing-feat.cabal view
@@ -1,5 +1,5 @@ Name:                testing-feat-Version:             1.1.0.0+Version:             1.1.1.0 Synopsis:            Functional Enumeration of Algebraic Types Description:         Feat (Functional Enumeration of Algebraic Types) provides                      enumerations as functions from natural numbers to values@@ -16,13 +16,13 @@                      ball.                      .                      The generators are provided by the size-based package. This means other libraries that implement the Sized class can use the same generator definitions. One such is the-                     <https://hackage.haskell.org/package/lazy-search lazy-search package>, that uses laziness to search for values and test properties. This is typically a lot faster than Feat for properties that have preconditions (logical implication), but can not be used for random selection of values. +                     <https://hackage.haskell.org/package/lazy-search lazy-search package>, that uses laziness to search for values and test properties. This is typically a lot faster than Feat for properties that have preconditions (logical implication), but can not be used for random selection of values.  License:             BSD3 License-file:        LICENSE Author:              Jonas Duregård-Maintainer:          jonas.duregard@gmail.com-Homepage:            https://github.com/JonasDuregard/testing-feat+Maintainer:          byorgey@gmail.com+Homepage:            https://github.com/size-based/testing-feat Copyright:           Jonas Duregård Category:            Testing Build-type:          Simple@@ -30,12 +30,16 @@     examples/template-haskell/th.hs     examples/haskell-src-exts/hse.hs     examples/lambda-terms/lambdas.hs-Cabal-version:       >=1.6+    CHANGELOG.md+Cabal-version:       >=1.10+tested-with:         GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2+ source-repository head   type:     git-  location: https://github.com/JonasDuregard/testing-feat-Library+  location: https://github.com/size-based/testing-feat +Library+  default-language:     Haskell2010   Hs-source-dirs:       .   Exposed-modules:     Test.Feat,@@ -48,10 +52,8 @@     Test.Feat.Modifiers     Test.Feat.Class -  Build-depends: +  Build-depends:     base >= 4.5 && < 5,     QuickCheck > 2 && < 3,     size-based < 0.2,     testing-type-modifiers < 0.2-  if impl(ghc < 8.0)-    Build-depends: semigroups < 0.19