More tracking of action sequences + work on profiling to figure out

what's slow

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

@@ -413,23 +413,23 @@ generateActionsWithOptions QCDOptions{..} = do
   return $ Actions_ rejected (Smart 0 as)
   where
     arbActions :: [Step state] -> [String] -> Annotated state -> Int -> Gen ([Step state], [String])
-    arbActions steps rej s step = sized $ \n -> do
+    arbActions steps rejected s step = sized $ \n -> do
       let w = round (genOptLengthMult * fromIntegral n) `div` 2 + 1
       continue <- frequency [(1, pure False), (w, pure True)]
       if continue
         then do
-          (mact, rej') <- satisfyPrecondition
+          (mact, rej) <- satisfyPrecondition
           case mact of
             Just (Some act@ActionWithPolarity{}) -> do
               let var = mkVar step
               arbActions
                 ((var := act) : steps)
-                (rej' ++ rej)
+                (rej ++ rejected)
                 (computeNextState s act var)
                 (step + 1)
             Nothing ->
-              return (reverse steps, rej)
-        else return (reverse steps, rej)
+              return (reverse steps, rejected)
+        else return (reverse steps, rejected)
       where
         satisfyPrecondition = sized $ \n -> go n (2 * n) [] -- idea copied from suchThatMaybe
         go m n rej
@@ -549,6 +549,14 @@ runActions
   => Actions state
   -> PropertyM m (Annotated state, Env)
 runActions (Actions_ rejected (Smart _ actions)) = do
+  -- TODO: consider bucketing one level lower here - 0-10, 10-20, ... 100-200, 200-300, ... 1000-2000, ...
+  -- insted
+  let bucket n
+        | b <= 0 = "0 - 9"
+        | otherwise = show ((10 :: Integer) ^ b) ++ " - " ++ show ((10 :: Integer) ^ (b + 1) - 1)
+        where
+          b = round (logBase 10 (fromIntegral n :: Double)) :: Integer
+  monitor $ tabulate "# of actions" [show $ bucket $ length actions]
   (finalState, env) <- runSteps initialAnnotatedState [] actions
   unless (null rejected) $
     monitor $

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

@@ -55,30 +55,31 @@ instance StateModel RegState where
   validFailingAction _ _ = True
 
   arbitraryAction ctx s =
-    frequency $
-      [
-        ( max 1 $ 10 - length (ctxAtType @ThreadId ctx)
-        , return $ Some Spawn
-        )
-      ,
-        ( 2 * Map.size (regs s)
-        , Some <$> (Unregister <$> probablyRegistered s)
-        )
-      ,
-        ( 10
-        , Some <$> (WhereIs <$> probablyRegistered s)
-        )
-      ]
-        ++ [ ( max 1 $ 3 - length (dead s)
-             , Some <$> (KillThread <$> arbitraryVar ctx)
-             )
-           | not . null $ ctxAtType @ThreadId ctx
-           ]
-        ++ [ ( max 1 $ 10 - Map.size (regs s)
-             , Some <$> (Register <$> probablyUnregistered s <*> arbitraryVar ctx)
-             )
-           | not . null $ ctxAtType @ThreadId ctx
-           ]
+    let threadIdCtx = ctxAtType @ThreadId ctx
+     in frequency $
+          [
+            ( max 1 $ 10 - length threadIdCtx
+            , return $ Some Spawn
+            )
+          ,
+            ( 2 * Map.size (regs s)
+            , Some <$> (Unregister <$> probablyRegistered s)
+            )
+          ,
+            ( 10
+            , Some <$> (WhereIs <$> probablyRegistered s)
+            )
+          ]
+            ++ [ ( max 1 $ 3 - length (dead s)
+                 , Some <$> (KillThread <$> arbitraryVar ctx)
+                 )
+               | not . null $ threadIdCtx
+               ]
+            ++ [ ( max 1 $ 10 - Map.size (regs s)
+                 , Some <$> (Register <$> probablyUnregistered s <*> arbitraryVar ctx)
+                 )
+               | not . null $ threadIdCtx
+               ]
 
   shrinkAction ctx _ (Register name tid) =
     [Some (Unregister name)]

quickcheck-dynamic/test/Test/QuickCheck/StateModelSpec.hs

@@ -30,6 +30,7 @@ tests =
   testGroup
     "Running actions"
     [ testProperty "simple counter" $ prop_counter
+    , testProperty "simple_counter_moreActions" $ moreActions 30 prop_counter
     , testProperty "returns final state updated from actions" prop_returnsFinalState
     , testProperty "environment variables indices are 1-based " prop_variablesIndicesAre1Based
     , testCase "prints distribution of actions and polarity" $ do