Add toggle for lazy pruning mutation order

Author: agustinmista

src/Test/Mutagen/Config.hs

@@ -15,6 +15,8 @@ module Test.Mutagen.Config
   , deny
   , deny'
   , example
+  , LazyPruningMode (..)
+  , EvaluationOrder (..)
   , DebugMode (..)
 
     -- * Re-exports
@@ -62,11 +64,11 @@ data Config
   -- certain number of tests. If not set to `Nothing`, this will duplicate the
   -- current limit on every reset. Additionally, it also duplicates the
   -- `randomMutations` parameter.
-  , useLazyPrunning :: Bool
-  -- ^ Use lazy prunning to avoid mutating unevaluated subexpressions. The
+  , lazyPruning :: LazyPruningMode
+  -- ^ Use lazy pruning to avoid mutating unevaluated subexpressions. The
   -- target mutable subexpressions are ordered by last evaluated first.
   , mutationOrder :: MutationOrder
-  -- ^ If `useLazyPrunning` is set to `False`, *every* subexpression of an
+  -- ^ If `lazyPruning` is set to `False`, *every* subexpression of an
   -- interesting test case is mutated regardless whether it was evaluated or
   -- not. These subexpressions are ordered using a generic tree traversal order
   -- (level order by default). The provided options are:
@@ -130,7 +132,7 @@ defaultConfig =
     , randomMutations = 1
     , maxMutationDepth = Nothing
     , autoResetAfter = Just 1000
-    , useLazyPrunning = False
+    , lazyPruning = LazyPruning Forward
     , mutationOrder = levelorder
     , useFragments = False
     , randomFragments = 10
@@ -169,6 +171,28 @@ deny' _ = deny @a
 example :: forall a. (IsArgs a) => a -> Args
 example = Args
 
+-- | Lazy pruning mode.
+--
+-- Used to dictate whether lazy pruning is used or not, and in which order
+-- subexpressions are mutated.
+data LazyPruningMode
+  = -- | Do not use lazy pruning; mutate all subexpressions.
+    NoLazyPruning
+  | -- | Use lazy pruning; mutate only evaluated subexpressions, following the
+    -- order in which they were evaluated.
+    LazyPruning EvaluationOrder
+  deriving (Eq, Show)
+
+-- | Evaluation order for lazy pruning.
+--
+-- Used to dictate how to order the evaluated subexpressions to be mutated.
+data EvaluationOrder
+  = -- | Mutate the least recently evaluated subexpressions first.
+    Forward
+  | -- | Mutate the most recently evaluated subexpressions first.
+    Backward
+  deriving (Eq, Show)
+
 -- | Debugging mode.
 --
 -- Allows stopping the loop between test cases to inspect the internal state.

src/Test/Mutagen/Test/Loop.hs

@@ -16,7 +16,11 @@ import Control.Monad (void, when)
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.Function ((&))
 import System.Random (split)
-import Test.Mutagen.Config (DebugMode (..))
+import Test.Mutagen.Config
+  ( DebugMode (..)
+  , EvaluationOrder (..)
+  , LazyPruningMode (..)
+  )
 import Test.Mutagen.Fragment.Store (storeFragments)
 import Test.Mutagen.Lazy (withLazyIO)
 import Test.Mutagen.Mutation (Pos)
@@ -376,8 +380,6 @@ runTestCase args parent st = do
     message "Running test case..."
   -- Run the test case
   (result, trace, evaluatedPos) <- liftIO $ execPropRunner st args
-  -- Truncate the trace if necessary
-  let trace' = maybe trace (flip truncateTrace trace) (stMaxTraceLength st)
   when (stChatty st) $ do
     case evaluatedPos of
       Just pos -> do
@@ -387,7 +389,7 @@ runTestCase args parent st = do
         return () -- lazy prunning is disabled
         -- Print the trace of the mutated test case
     message "Test case trace:"
-    pretty (unTrace trace')
+    pretty (unTrace trace)
   -- Extract property modifiers
   let addPropertyModifiers =
         setExpect (resultExpect result)
@@ -407,7 +409,7 @@ runTestCase args parent st = do
       when (stChatty st) $ do
         message "Test result: PASSED"
       -- Save the trace in the corresponding trace store
-      (new, prio) <- liftIO (savePassedTraceWithPrio st trace')
+      (new, prio) <- liftIO (savePassedTraceWithPrio st trace)
       -- Evaluate whether the test case was interesting or not depending on
       -- whether it added new trace nodes or not
       let interesting = new > 0
@@ -442,7 +444,7 @@ runTestCase args parent st = do
       when (stChatty st) $ do
         message "Test result: DISCARDED"
       -- Save the trace in the corresponding trace log
-      (new, prio) <- liftIO (saveDiscardedTraceWithPrio st trace')
+      (new, prio) <- liftIO (saveDiscardedTraceWithPrio st trace)
       -- Evaluate whether the test case was interesting or not
       --
       -- NOTE: in this case, we only consider discarded test cases interesting
@@ -519,19 +521,33 @@ runTestCase args parent st = do
 
 -- | Execute a test and capture:
 --   * The test result (passed, discarded, failed)
---   * The trace in the program it traversed
---   * The positions of the evaluated expressions of the input
---     (if lazy pruning is currently enabled).
+--   * The (possibly truncated) execution trace in the program it traversed
+--   * The positions of the evaluated subexpressions of the input, in the order
+--     that they need to be mutated (only when lazy pruning is enabled).
 execPropRunner :: MutagenState -> Args -> IO (Result, Trace, Maybe [Pos])
 execPropRunner st args
-  | stUseLazyPrunning st = do
-      (evaluated, (test, trace)) <- withLazyIO (withTrace . runProp) args
-      return (test, trace, Just evaluated)
+  | LazyPruning order <- stLazyPruning st = do
+      (evaluated, (result, trace)) <- withLazyIO (withTrace . runProp) args
+      return
+        ( result
+        , truncateTraceIfNeeded trace
+        , Just (withMutationOrder order evaluated)
+        )
   | otherwise = do
-      (test, trace) <- withTrace (runProp args)
-      return (test, trace, Nothing)
+      (result, trace) <- withTrace (runProp args)
+      return
+        ( result
+        , truncateTraceIfNeeded trace
+        , Nothing
+        )
   where
     runProp = unProp . protectProp . stPropRunner st
+    withMutationOrder order =
+      case order of
+        Forward -> id
+        Backward -> reverse
+    truncateTraceIfNeeded trace =
+      maybe trace (flip truncateTrace trace) (stMaxTraceLength st)
 
 -- | Save a discarded trace and return the number of new nodes added and its
 -- the priority associated to its corresponding test case.

src/Test/Mutagen/Test/Queue.hs

@@ -171,7 +171,7 @@ newMutationBatchFromParent
   -> MutationBatch a
 newMutationBatchFromParent
   batch
-  evaluatedPositions
+  evaluatedPos
   testPassed
   args =
     batch
@@ -186,7 +186,7 @@ newMutationBatchFromParent
       -- Determine next positions to mutate based on whether we receive the
       -- concrete execution trace of the original
       nextPositions =
-        fromMaybe (mbMutationOrder batch (positions args)) evaluatedPositions
+        fromMaybe (mbMutationOrder batch (positions args)) evaluatedPos
 
 -- | Create or inherit mutation batch for a test case.
 --
@@ -221,14 +221,14 @@ createOrInheritMutationBatch
   maxMutationDepth
   args
   parentBatch
-  pos
+  evaluatedPos
   isPassed =
     case parentBatch of
       -- The test case was mutated from an existing one
       Just mb ->
         newMutationBatchFromParent
           mb
-          pos
+          evaluatedPos
           isPassed
           args
       -- The test case was freshly generated
@@ -239,7 +239,7 @@ createOrInheritMutationBatch
           maxGenSize
           randomFragments
           maxMutationDepth
-          pos
+          evaluatedPos
           isPassed
           args
 

src/Test/Mutagen/Test/State.hs

@@ -44,7 +44,11 @@ where
 import Data.List (elemIndex)
 import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
 import System.FilePath ((<.>))
-import Test.Mutagen.Config (Config (..), DebugMode (..))
+import Test.Mutagen.Config
+  ( Config (..)
+  , DebugMode (..)
+  , LazyPruningMode (..)
+  )
 import Test.Mutagen.Fragment.Store
   ( FragmentStore
   , FragmentTypeFilter
@@ -89,8 +93,8 @@ data MutagenState
   -- ^ Mirrored from 'Config.maxMutationDepth'
   , stAutoResetAfter :: !(Maybe Int)
   -- ^ Mirrored from 'Config.autoResetAfter'
-  , stUseLazyPrunning :: !Bool
-  -- ^ Mirrored from 'Config.useLazyPrunning'
+  , stLazyPruning :: !(LazyPruningMode)
+  -- ^ Mirrored from 'Config.lazyPruning'
   , stMutationOrder :: !MutationOrder
   -- ^ Mirrored from 'Config.mutationOrder'
   , stRandomFragments :: !Int
@@ -194,7 +198,7 @@ initMutagenState cfg (Property gen runner) = do
         , stRandomFragments = randomFragments cfg
         , stMaxMutationDepth = maybe (maxGenSize cfg) id (maxMutationDepth cfg)
         , stAutoResetAfter = autoResetAfter cfg
-        , stUseLazyPrunning = useLazyPrunning cfg
+        , stLazyPruning = lazyPruning cfg
         , stMutationOrder = mutationOrder cfg
         , stUseFragments = useFragments cfg
         , stFilterFragments = filterFragments cfg

test/re/Main.hs

@@ -18,6 +18,8 @@ import System.Exit
 import Test.Mutagen
   ( Config (..)
   , DebugMode (..)
+  , EvaluationOrder (..)
+  , LazyPruningMode (..)
   , Prop
   , allow
   , defaultConfig
@@ -53,9 +55,10 @@ config =
     , maxGenSize =
         -- Max generation size
         5
-    , useLazyPrunning =
-        -- Prune mutations affecting unevaluated subexpressions
-        True
+    , lazyPruning =
+        -- Prune mutations affecting unevaluated subexpressions, following the
+        -- same evaluation order of the property over the original test case
+        LazyPruning Forward
     , useFragments =
         -- Keep a store of test case fragments to be reused
         True