more shrinking + another interesting test

Author: MaximilianAlgehed

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

@@ -706,7 +706,9 @@ instance StateModel state => Arbitrary (ParallelActions state) where
   arbitrary = genParActions
 
   shrink (ParallelActions actions as bs) =
-    filter checkParallelActions [ ParallelActions actions as bs | actions <- QC.shrink actions ]
+    filter checkParallelActions $ [ ParallelActions actions as bs | actions <- QC.shrink actions ] ++
+                                  [ ParallelActions actions (tail as) bs | not $ null as ] ++
+                                  [ ParallelActions actions as (tail bs) | not $ null bs ]
 
 checkParallelActions :: StateModel state => ParallelActions state -> Bool
 checkParallelActions pas = checkWellTypedness commonCtx threadA && checkWellTypedness commonCtx threadB

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

@@ -105,6 +105,17 @@ instance RunModel Counter (ReaderT (IORef Int) IO) where
 
 
 instance RunModelPar Counter (ReaderT (IORef Int) IO) where
+  performPar Inc _ = do
+    ref <- ask
+    lift $ atomicModifyIORef ref (\ c -> (c+1, ()))
+    -- lift $ do
+    --   n <- readIORef ref
+    --   threadDelay 50000
+    --   writeIORef ref (n + 1)
+  performPar Reset _ = do
+    ref <- ask
+    lift $ atomicModifyIORef ref (\ c -> (0, c))
+
   postconditionPar (Counter n, _) Reset _ res = pure $ n == res
   postconditionPar _ _ _ _ = pure True