mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Prevent scripts from restarting when users trigger other IDE actions, like hover (#16984)
* Stop the semaphore thread cleanly when a result was received * Use ContextId to disamiguate similar script runs * Test opposite side (cancellation does *not* happen after hover) * Longer timeout, drop todo for `scenario service does not interrupt` test * Add better comments, refactor 4-tuple into RunInfo
This commit is contained in:
parent
2216cd70aa
commit
ab5a9d56bb
@ -663,9 +663,8 @@ scriptTests runScripts = testGroup "scripts"
|
|||||||
|
|
||||||
closeDoc script
|
closeDoc script
|
||||||
closeDoc main'
|
closeDoc main'
|
||||||
-- TODO https://github.com/digital-asset/daml/issues/16772
|
, localOption (mkTimeout 60000000) $ -- 60s timeout
|
||||||
, localOption (mkTimeout 30000000) $ -- 30s timeout
|
testCaseSteps "scenario service does not interrupt on non-script messages" $ \step -> runScripts $ \_stderr -> do
|
||||||
testCaseSteps "scenario service interrupts on non-script messages" $ \step -> runScripts $ \_stderr -> do
|
|
||||||
-- open document with long-running script
|
-- open document with long-running script
|
||||||
main' <- openDoc' "Main.daml" damlId $
|
main' <- openDoc' "Main.daml" damlId $
|
||||||
T.unlines
|
T.unlines
|
||||||
@ -705,14 +704,10 @@ scriptTests runScripts = testGroup "scripts"
|
|||||||
_ <- sendRequest STextDocumentHover (HoverParams main' (Position 4 3) Nothing)
|
_ <- sendRequest STextDocumentHover (HoverParams main' (Position 4 3) Nothing)
|
||||||
liftIO $ step "Hover sent..."
|
liftIO $ step "Hover sent..."
|
||||||
|
|
||||||
-- check that new script is started
|
-- Check that script did return and that log does not show any cancellations
|
||||||
_ <- liftIO $ hTakeUntil _stderr "SCENARIO SERVICE STDOUT: Script started."
|
_changeResult <- waitForScriptDidChange
|
||||||
liftIO $ step "New script started."
|
_scriptFinishedMessage <- liftIO $ assertUntilWithout _stderr "SCENARIO SERVICE STDOUT: Script finished." "SCENARIO SERVICE STDOUT: Script cancelled."
|
||||||
|
liftIO $ step "Script returned without cancellation."
|
||||||
-- check that previous script is cancelled
|
|
||||||
_ <- liftIO $ hTakeUntil _stderr "SCENARIO SERVICE STDOUT: Script cancelling."
|
|
||||||
_ <- liftIO $ hTakeUntil _stderr "SCENARIO SERVICE STDOUT: Script cancelled."
|
|
||||||
liftIO $ step "Previous script cancelled."
|
|
||||||
|
|
||||||
closeDoc script
|
closeDoc script
|
||||||
closeDoc main'
|
closeDoc main'
|
||||||
@ -730,9 +725,32 @@ hTakeUntil handle regex = go
|
|||||||
line <- hGetLine handle
|
line <- hGetLine handle
|
||||||
if pred line then pure (Just line) else go
|
if pred line then pure (Just line) else go
|
||||||
|
|
||||||
|
-- Takes lines from the handle until matching the first pattern `until`. If any
|
||||||
|
-- of the lines before the matching line match the second pattern `without`
|
||||||
|
-- then fail the test
|
||||||
|
-- Useful for cases where we want to assert that some message has been emitted
|
||||||
|
-- without a different message being emitted in the interim, e.g. a script
|
||||||
|
-- finished without restarts in between.
|
||||||
|
assertUntilWithout :: Handle -> T.Text -> T.Text -> IO (Maybe String)
|
||||||
|
assertUntilWithout handle until without = go
|
||||||
|
where
|
||||||
|
untilP = matchTest (makeRegex until :: Regex)
|
||||||
|
withoutP = matchTest (makeRegex without :: Regex)
|
||||||
|
go = do
|
||||||
|
closed <- hIsClosed handle
|
||||||
|
if closed
|
||||||
|
then pure Nothing
|
||||||
|
else do
|
||||||
|
line <- hGetLine handle
|
||||||
|
if withoutP line then
|
||||||
|
assertFailure $ "Source line: `" <> line <> "` shouldn't match regular expression `" <> T.unpack without <> "`, but it does."
|
||||||
|
else if untilP line then
|
||||||
|
pure (Just line)
|
||||||
|
else go
|
||||||
|
|
||||||
assertRegex :: T.Text -> T.Text -> Assertion
|
assertRegex :: T.Text -> T.Text -> Assertion
|
||||||
assertRegex source regex =
|
assertRegex source regex =
|
||||||
let errMsg = "Source text: `" <> T.unpack source <> "` does not match regular expression `" <> T.unpack regex <> "`."
|
let errMsg = "Source text: `" <> T.unpack source <> "` should match regular expression `" <> T.unpack regex <> "`, but it doesn't."
|
||||||
in
|
in
|
||||||
assertBool
|
assertBool
|
||||||
errMsg
|
errMsg
|
||||||
|
@ -88,7 +88,26 @@ data Handle = Handle
|
|||||||
, hContextId :: IORef LowLevel.ContextId
|
, hContextId :: IORef LowLevel.ContextId
|
||||||
-- ^ The root context id, this is mutable so that rather than mutating the context
|
-- ^ The root context id, this is mutable so that rather than mutating the context
|
||||||
-- we can clone it and update the clone which allows us to safely interrupt a context update.
|
-- we can clone it and update the clone which allows us to safely interrupt a context update.
|
||||||
, hRunningHandlers :: MVar (MS.Map RunOptions (ThreadId, MVar Bool))
|
, hRunningHandlers :: MVar (MS.Map RunOptions RunInfo)
|
||||||
|
-- ^ Track running scripts as a map between the RunOptions that triggered
|
||||||
|
-- them and all information required to cancel them or to resume from them
|
||||||
|
-- ContextId for determining ThreadId for cancelling via asynchronous exception
|
||||||
|
}
|
||||||
|
|
||||||
|
-- RunInfo stores information required for cancelling and resuming from script runs
|
||||||
|
data RunInfo = RunInfo
|
||||||
|
{ threadId :: ThreadId
|
||||||
|
, context :: LowLevel.ContextId
|
||||||
|
-- ^ If a new prospective script run has a newer context id, then threads
|
||||||
|
-- with older contexts should be cancelled
|
||||||
|
, stop :: MVar Bool
|
||||||
|
-- ^ To cancel a thread, put True into this semaphore, which triggers
|
||||||
|
-- cancellation in the corresponding lowlevel script run
|
||||||
|
, result :: Barrier (Either LowLevel.Error LowLevel.ScenarioResult)
|
||||||
|
-- ^ To obtain the result of a script run, listen to this barrier, which will
|
||||||
|
-- be filled by the lowlevel script run when the script run terminates
|
||||||
|
-- Must be a barrier so that both this run and future runs can subscribe to
|
||||||
|
-- the same value.
|
||||||
}
|
}
|
||||||
|
|
||||||
withSem :: QSemN -> IO a -> IO a
|
withSem :: QSemN -> IO a -> IO a
|
||||||
@ -262,36 +281,52 @@ runLiveScript h ctxId logger name statusUpdateHandler = runWithOptions (RunOptio
|
|||||||
|
|
||||||
runWithOptions :: RunOptions -> Handle -> LowLevel.ContextId -> IDELogger.Logger -> IO (Either LowLevel.Error LowLevel.ScenarioResult)
|
runWithOptions :: RunOptions -> Handle -> LowLevel.ContextId -> IDELogger.Logger -> IO (Either LowLevel.Error LowLevel.ScenarioResult)
|
||||||
runWithOptions options Handle{..} ctxId logger = do
|
runWithOptions options Handle{..} ctxId logger = do
|
||||||
resVar <- newEmptyMVar
|
resBarrier <- newBarrier
|
||||||
stopSemaphore <- newEmptyMVar
|
stopSemaphore <- newEmptyMVar
|
||||||
|
|
||||||
-- If the internal or external thread receives a cancellation exception, signal to stop
|
-- If the internal or external thread receives a cancellation exception, signal to stop
|
||||||
modifyMVar_ hRunningHandlers $ \runningHandlers -> do
|
modifyMVar_ hRunningHandlers $ \runningHandlers -> do
|
||||||
handlerThread <- forkIO $ withSem hConcurrencySem $ do
|
-- If there was an old thread handling the same scenario in the same
|
||||||
r <- try $ optionsToLowLevel options hLowLevelHandle ctxId logger stopSemaphore
|
-- way, under a different context, send a cancellation to its semaphore
|
||||||
putMVar resVar $
|
let mbOldRunInfo = MS.lookup options runningHandlers
|
||||||
case r of
|
case mbOldRunInfo of
|
||||||
Left ex -> Left $ LowLevel.ExceptionError ex
|
Just oldRunInfo
|
||||||
Right r -> r
|
| context oldRunInfo == ctxId -> pure ()
|
||||||
pure ()
|
| otherwise -> do
|
||||||
|
_ <- tryPutMVar (stop oldRunInfo) True
|
||||||
|
pure ()
|
||||||
|
Nothing -> pure ()
|
||||||
|
|
||||||
-- Store the new thread into runningHandlers
|
-- If there was an old thread handling the same scenario in the same
|
||||||
let insertLookup kx x t = MS.insertLookupWithKey (\_ a _ -> a) kx x t
|
-- way, under a different context, or if there was no old thread, start a
|
||||||
let (mbOldThread, newRunningHandlers) = insertLookup options (handlerThread, stopSemaphore) runningHandlers
|
-- new thread to replace it.
|
||||||
|
-- Otherwise (when there is an old thread with the same context id) listen
|
||||||
|
-- to that thread's result via its result barrier
|
||||||
|
case mbOldRunInfo of
|
||||||
|
Just oldRunInfo
|
||||||
|
| context oldRunInfo == ctxId -> do
|
||||||
|
_ <- forkIO $ do
|
||||||
|
oldResult <- waitBarrier (result oldRunInfo)
|
||||||
|
signalBarrier resBarrier oldResult
|
||||||
|
pure runningHandlers
|
||||||
|
_ -> do
|
||||||
|
handlerThread <- forkIO $ withSem hConcurrencySem $ do
|
||||||
|
r <- try $ optionsToLowLevel options hLowLevelHandle ctxId logger stopSemaphore
|
||||||
|
signalBarrier resBarrier $
|
||||||
|
case r of
|
||||||
|
Left ex -> Left $ LowLevel.ExceptionError ex
|
||||||
|
Right r -> r
|
||||||
|
|
||||||
-- If there was an old thread handling the same scenario in the same way,
|
let selfInfo =
|
||||||
-- send a cancellation to its semaphore
|
RunInfo
|
||||||
case mbOldThread of
|
{ threadId = handlerThread
|
||||||
Just (_, oldThreadSemaphore) -> do
|
, context = ctxId
|
||||||
_ <- tryPutMVar oldThreadSemaphore True
|
, stop = stopSemaphore
|
||||||
pure ()
|
, result = resBarrier
|
||||||
_ -> pure ()
|
}
|
||||||
|
let newRunningHandlers = MS.insert options selfInfo runningHandlers
|
||||||
-- Return updated runningHandlers
|
pure newRunningHandlers
|
||||||
pure newRunningHandlers
|
waitBarrier resBarrier
|
||||||
res <- takeMVar resVar
|
|
||||||
_ <- tryPutMVar stopSemaphore False
|
|
||||||
pure res
|
|
||||||
|
|
||||||
optionsToLowLevel :: RunOptions -> LowLevel.Handle -> LowLevel.ContextId -> IDELogger.Logger -> MVar Bool -> IO (Either LowLevel.Error LowLevel.ScenarioResult)
|
optionsToLowLevel :: RunOptions -> LowLevel.Handle -> LowLevel.ContextId -> IDELogger.Logger -> MVar Bool -> IO (Either LowLevel.Error LowLevel.ScenarioResult)
|
||||||
optionsToLowLevel RunOptions{..} h ctxId logger mask =
|
optionsToLowLevel RunOptions{..} h ctxId logger mask =
|
||||||
|
@ -483,6 +483,7 @@ runBiDiLive runner Handle{..} (ContextId ctxId) name logger stopSemaphore status
|
|||||||
NoResultUpdate -> loop
|
NoResultUpdate -> loop
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
pure ()
|
pure ()
|
||||||
|
_ <- tryPutMVar stopSemaphore False -- once we exit, stop the semaphore checking thread
|
||||||
case response of
|
case response of
|
||||||
ClientBiDiResponse _ StatusOk _ -> getFinalResponse
|
ClientBiDiResponse _ StatusOk _ -> getFinalResponse
|
||||||
ClientBiDiResponse _ status _ -> pure (Left (BackendError (BErrorFail status)))
|
ClientBiDiResponse _ status _ -> pure (Left (BackendError (BErrorFail status)))
|
||||||
|
@ -143,6 +143,7 @@ object ScriptStream {
|
|||||||
}
|
}
|
||||||
internal.onNext(message)
|
internal.onNext(message)
|
||||||
internal.onCompleted()
|
internal.onCompleted()
|
||||||
|
println(f"Script finished.")
|
||||||
}
|
}
|
||||||
|
|
||||||
override def sendStatus(status: ScenarioStatus): Unit = {}
|
override def sendStatus(status: ScenarioStatus): Unit = {}
|
||||||
@ -166,6 +167,7 @@ object ScriptStream {
|
|||||||
}
|
}
|
||||||
internal.onNext(message)
|
internal.onNext(message)
|
||||||
internal.onCompleted()
|
internal.onCompleted()
|
||||||
|
println(f"Script finished.")
|
||||||
}
|
}
|
||||||
|
|
||||||
override def sendStatus(status: ScenarioStatus): Unit = internal.synchronized {
|
override def sendStatus(status: ScenarioStatus): Unit = internal.synchronized {
|
||||||
@ -268,9 +270,7 @@ class ScenarioService(
|
|||||||
println(f"Received error $t")
|
println(f"Received error $t")
|
||||||
}
|
}
|
||||||
|
|
||||||
override def onCompleted(): Unit = {
|
override def onCompleted(): Unit = {}
|
||||||
println("Completed.")
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user