io-sim-por: return internal errors

This makes it much easier to debug ones.  In the future we might turn
more assertion failures into `FailureInternal`.

Author: coot

io-sim/src/Control/Monad/IOSim.hs

@@ -132,6 +132,7 @@ selectTraceEvents fn =
                     Deadlock      _   threads -> throw (FailureDeadlock threads)
                     MainReturn    _ _ _       -> []
                     Loop                      -> error "Impossible: selectTraceEvents _ TraceLoop{}"
+                    InternalError msg         -> throw (FailureInternal msg)
               )
               ( \ b acc -> b : acc )
               []
@@ -336,6 +337,12 @@ data Failure =
        -- This could be an internal assertion failure of `io-sim` or an
        -- unhandled exception in the simulation.
      | FailureEvaluation SomeException
+
+       -- | An internal failure of the simulator.
+       --
+       -- Please open an issue at
+       -- <https://github.com/input-output-hk/io-sim/issues>.
+     | FailureInternal String
   deriving Show
 
 instance Exception Failure where
@@ -350,7 +357,18 @@ instance Exception Failure where
              , intercalate ", " (show `map` threads)
              , ">>"
              ]
-    displayException (FailureEvaluation err) = "evaluation error:" ++ displayException  err
+    displayException (FailureEvaluation err) =
+      concat [ "<<evaluation error: "
+             , displayException  err
+             , ">>"
+             ]
+    displayException (FailureInternal msg) =
+      concat [ "<<internal failure: "
+             , msg
+             , ">>\n"
+             , "please report the issue at\n"
+             , "https://github.com/input-output-hk/io-sim/issues"
+             ]
 
 
 -- | 'IOSim' is a pure monad.
@@ -402,6 +420,7 @@ traceResult strict = unsafePerformIO . eval
     go (TraceMainException _ e _)       = pure $ Left (FailureException e)
     go (TraceDeadlock   _   threads)    = pure $ Left (FailureDeadlock threads)
     go TraceLoop{}                      = error "Impossible: traceResult TraceLoop{}"
+    go (TraceInternalError msg)         = pure $ Left (FailureInternal msg)
 
 -- | Turn 'SimTrace' into a list of timestamped events.
 --

io-sim/src/Control/Monad/IOSim/Types.hs

@@ -50,7 +50,7 @@ module Control.Monad.IOSim.Types
   , SimEvent (..)
   , SimResult (..)
   , SimTrace
-  , Trace.Trace (SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceRacesFound, TraceLoop)
+  , Trace.Trace (SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceRacesFound, TraceLoop, TraceInternalError)
   , ppTrace
   , ppTrace_
   , ppSimEvent
@@ -917,7 +917,10 @@ pattern TraceDeadlock time threads = Trace.Nil (Deadlock time threads)
 pattern TraceLoop :: SimTrace a
 pattern TraceLoop = Trace.Nil Loop
 
-{-# COMPLETE SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceLoop #-}
+pattern TraceInternalError :: String -> SimTrace a
+pattern TraceInternalError msg = Trace.Nil (InternalError msg)
+
+{-# COMPLETE SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceLoop, TraceInternalError #-}
 
 
 -- | Events recorded by the simulation.

io-sim/src/Control/Monad/IOSimPOR/Internal.hs

@@ -966,12 +966,18 @@ deschedule Sleep thread@Thread { threadId = tid , threadEffect = effect' }
 reschedule :: SimState s a -> ST s (SimTrace a)
 
 -- If we are following a controlled schedule, just do that.
+reschedule simstate@SimState { runqueue, control = control@(ControlFollow ((tid,_):_) _) }
+                             | not (Down tid `PSQ.member` runqueue) =
+    return (Trace.Nil (InternalError ("assertion failure: " ++ ppIOSimThreadId tid ++ " not runnable")))
+
+reschedule simstate@SimState { threads, control = control@(ControlFollow ((tid,_):_) _) }
+                             | not (tid `Map.member` threads) =
+    return (Trace.Nil (InternalError ("assertion failure: " ++ ppIOSimThreadId tid ++ " not in threads")))
+
 reschedule simstate@SimState { runqueue, threads,
                                control = control@(ControlFollow ((tid,tstep):_) _),
                                curTime = time } =
     fmap (SimPORTrace time tid tstep Nothing (EventReschedule control)) $
-    assert (Down tid `PSQ.member` runqueue) $
-    assert (tid `Map.member` threads) $
     invariant Nothing simstate $
     let thread = threads Map.! tid in
     assert (threadId thread == tid) $

io-sim/test/Test/Control/Monad/IOSimPOR.hs

@@ -356,6 +356,8 @@ propExploration cmp (Shrink2 ts@(Tasks tasks)) =
     counterexample (noExceptions $ Trace.ppTrace show (ppSimEvent 0 0 0) trace) $
     case traceResult False trace of
       Right (m,a) -> property (m >= a)
+      Left (FailureInternal msg)
+                  -> counterexample msg False
       Left _      -> property True