prettier printing

Author: MaximilianAlgehed

quickcheck-dynamic/src/Test/QuickCheck/ParallelActions.hs

@@ -149,26 +149,29 @@ runParActions pas = do
   joinB <- run $ forkThread $ runTracing env (threadBActions pas)
   (trA, _) <- run joinA
   (trB, _) <- run joinB
-  monitor $ counterexample "-- Monitoring main thread"
-  monitorTrace mempty trC
-  monitor $ counterexample "-- Monitoring thread A"
-  monitorTrace env trA
-  monitor $ counterexample "-- Monitoring thread B"
-  monitorTrace env trB
+  let used = varsUsedInActions $ linearActions pas
+  monitor $ counterexample "-- Main thread:"
+  monitorTrace used mempty trC
+  monitor $ counterexample "\n-- Thread A:"
+  monitorTrace used env trA
+  monitor $ counterexample "\n-- Thread B:"
+  monitorTrace used env trB
   let ilvs = prepend trC $ interleavings trA trB
   monitor $ tabulate "TraceTree size" (map (bucket . length) ilvs)
   assert $ null ilvs || any (checkTrace initialAnnotatedState mempty) ilvs
   -- TODO: stats collection and cleanup
 
 monitorTrace :: forall state m. (StateModel state, RunModelPar state m)
-             => Env -> Trace state m -> PropertyM m ()
-monitorTrace _env [] = pure ()
-monitorTrace env (TraceStep r v act : tr) = do
+             => VarContext -> Env -> Trace state m -> PropertyM m ()
+monitorTrace _used _env [] = pure ()
+monitorTrace used env (TraceStep r v act : tr) = do
   let showR (Right x) = show x
       showR (Left err) = "fail " ++ showsPrec 10 err ""
-  monitor $ counterexample (showR r ++ " <- " ++ show (polarAction act))
+      pre | v `wellTypedIn` used = show v ++ " @ "
+          | otherwise = ""
+  monitor $ counterexample (pre ++ showR r ++ " <- " ++ show (polarAction act))
   monitor $ monitoringPar @state @m (polarAction act) (lookUpVar env) r
-  monitorTrace env' tr
+  monitorTrace used env' tr
   where
     env' | Right val <- r = (v :== val) : env
          | otherwise      = env

quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs

@@ -49,7 +49,7 @@ module Test.QuickCheck.StateModel (
   performResultToEither,
   bucket,
   actionWithPolarity,
-
+  varsUsedInActions,
 ) where
 
 import Control.Monad
@@ -356,11 +356,11 @@ instance StateModel state => Show (Actions state) where
 
 showWithUsed :: StateModel state => VarContext -> Actions state -> String
 showWithUsed ctx (Actions as) =
-    let as' = WithUsedVars (combineContexts ctx $ usedVariables (Actions as)) <$> as
+    let as' = WithUsedVars (combineContexts ctx $ varsUsedInActions (Actions as)) <$> as
      in intercalate "\n" $ zipWith (++) ("do " : repeat "   ") (map show as' ++ ["pure ()" | null as'])
 
-usedVariables :: forall state. StateModel state => Actions state -> VarContext
-usedVariables (Actions as) = go initialAnnotatedState as
+varsUsedInActions :: forall state. StateModel state => Actions state -> VarContext
+varsUsedInActions (Actions as) = go initialAnnotatedState as
   where
     go :: Annotated state -> [Step state] -> VarContext
     go aState [] = allVariables (underlyingState aState)

quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs

@@ -347,5 +347,5 @@ tests =
     , testProperty "moreActions 10 $ prop_Registry" $ moreActions 10 $ prop_Registry
     , testProperty "canRegister" $ propDL canRegister
     , testProperty "canRegisterNoUnregister" $ expectFailure $ propDL canRegisterNoUnregister
-    , testProperty "prop_parRegistryIOSimPor" $ withMaxSuccess 300 $ expectFailure prop_parRegistryIOSimPor
+    , testProperty "prop_parRegistryIOSimPor" $ expectFailure $ withMaxSuccess 1000 $ prop_parRegistryIOSimPor
     ]