[Git][ghc/ghc][wip/T24040-ghci-timeout-squashed] moving from :timeout to :set timeout, and other review feedback.
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Mon Feb 5 22:36:27 UTC 2024
Hassan Al-Awwadi pushed to branch wip/T24040-ghci-timeout-squashed at Glasgow Haskell Compiler / GHC
Commits:
736a9abc by Hassan Al-Awwadi at 2024-02-05T23:04:16+01:00
moving from :timeout to :set timeout, and other review feedback.
- - - - -
5 changed files:
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- testsuite/tests/ghci/scripts/T24040.script
- testsuite/tests/ghci/scripts/T24040.stdout
Changes:
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -144,6 +144,11 @@ Compiler
GHCi
~~~~
+- Added the :set timeout <number> command. When called it will timeout ghci commands and expressions that
+ take too long <number> is interpreted in seconds and needs to be a natural number.
+ Can be unset by calling :unset timeout or :set timeout 0. See :ghc-ticket:`24040`.
+
+
Runtime system
~~~~~~~~~~~~~~
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -2896,6 +2896,13 @@ commonly used commands.
the :ghci-cmd:`:ignore` or the ``⟨ignoreCount⟩`` parameter of the
:ghci-cmd:`:continue` command.
+.. ghci-cmd:: :set timeout; ⟨timelimit⟩
+
+ Makes all expressions and commands that take longer than ⟨timelimit⟩
+ to evaluate throw a GhciTimedOut exception. The timelimit is interpreted
+ in seconds.
+
+
.. ghci-cmd:: :seti; [⟨option⟩ ...]
Like :ghci-cmd:`:set`, but options set with :ghci-cmd:`:seti` affect only
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -246,7 +246,6 @@ ghciCommands = map mkCmd [
("steplocal", keepGoing stepLocalCmd, completeIdentifier),
("stepmodule",keepGoing stepModuleCmd, completeIdentifier),
("type", keepGoingMulti' typeOfExpr, completeExpression),
- ("timeout", keepGoing timeoutCmd, noCompletion),
("trace", keepGoing traceCmd, completeExpression),
("unadd", keepGoingPaths unAddModule, completeFilename),
("undef", keepGoing undefineMacro, completeMacro),
@@ -378,7 +377,6 @@ defFullHelpText =
" (!: defer type errors)\n" ++
" :run function [<arguments> ...] run the function with the given arguments\n" ++
" :script <file> run the script <file>\n" ++
- " :timeout <int> set a maximum allowed time input lines are allowed to take before failing\n" ++
" :type <expr> show the type of <expr>\n" ++
" :type +d <expr> show the type of <expr>, defaulting type variables\n" ++
" :unadd <module> ... remove module(s) from the current target set\n" ++
@@ -432,6 +430,7 @@ defFullHelpText =
" set the function to handle the continuation prompt\n" ++
" :set editor <cmd> set the command used for :edit\n" ++
" :set stop [<n>] <cmd> set the command to run when a breakpoint is hit\n" ++
+ " :set timeout <number> set the maximum allowed amount of seconds for evaluation to take\n" ++
" :unset <option> ... unset options\n" ++
"\n" ++
" Options for ':set' and ':unset':\n" ++
@@ -490,6 +489,9 @@ default_prompt_cont = generatePromptFunctionFromString "ghci| "
default_args :: [String]
default_args = []
+default_timeout :: String
+default_timeout = "0"
+
interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
-> Ghc ()
interactiveUI config srcs maybe_exprs = do
@@ -1130,7 +1132,7 @@ withTimeLimit time_out_value cmd = do
-- | transitively duping System.Timeout(timeout), because we need a lifted version
-- | transitively, because really this is a dupe of time-out's Control.Timeout(timeout)
- -- | Luckily time-out is in Public Domain 😌
+ -- | Luckily time-out is in Public Domain
timeout :: (MonadIO m, MonadCatch m) => Int -> m a -> m (Maybe a)
timeout time action = do
tidMain <- liftIO myThreadId
@@ -2382,18 +2384,6 @@ runExceptGhciMonad act = handleSourceError printGhciException $
exceptT :: Applicative m => Either e a -> ExceptT e m a
exceptT = ExceptT . pure
------------------------------------------------------------------------------
--- | @:timeout@ command.
-timeoutCmd :: GhciMonad m => String -> m ()
-timeoutCmd str = handleSourceError printErrAndMaybeExit $ set_time (readMaybe str) where
- set_time (Just l)
- | l == 1 = printForUser (text "setting timeout length to" <+> text (show l) <+> text "second")
- *> modifyGHCiState (\st -> st{ time_limit = Just l })
- | l > 0 = printForUser (text "setting timeout length to" <+> text (show l) <+> text "seconds")
- *> modifyGHCiState (\st -> st{ time_limit = Just l })
- set_time _ = printForUser (text "setting timeout to unbounded execution time")
- *> modifyGHCiState (\st -> st{ time_limit = Nothing })
-
-----------------------------------------------------------------------------
-- | @:type@ command. See also Note [TcRnExprMode] in GHC.Tc.Module.
typeOfExpr :: GhciMonad m => String -> m ()
@@ -3051,6 +3041,7 @@ setCmd str
Right ("stop", rest) -> setStop $ dropWhile isSpace rest
Right ("local-config", rest) ->
setLocalConfigBehaviour $ dropWhile isSpace rest
+ Right ("timeout", rest) -> setTimeout $ dropWhile isSpace rest
_ -> case toArgsNoLoc str of
Left err -> liftIO (hPutStrLn stderr err)
Right wds -> () <$ keepGoing' setOptions wds
@@ -3196,6 +3187,15 @@ setParsedPromptString fSetPrompt s = do
Nothing ->
fSetPrompt $ generatePromptFunctionFromString s
+setTimeout :: GhciMonad m => String -> m ()
+setTimeout str = handleSourceError printErrAndMaybeExit $ set_time (readMaybe str) where
+ set_time (Just l)
+ | l > 0 = printForUser (text "setting timeout length to:" <+> speakNOf l (text "second"))
+ *> modifyGHCiState (\st -> st{ time_limit = Just l })
+ | l == 0 = printForUser (text "unsetting timeout")
+ *> modifyGHCiState (\st -> st{ time_limit = Nothing })
+ set_time _ = throwGhcException (CmdLineError "syntax: :set timeout <natural number>")
+
setOptions wds =
do -- first, deal with the GHCi opts (+s, +t, etc.)
let (plus_opts, minus_opts) = partitionWith isPlus wds
@@ -3291,6 +3291,7 @@ unsetOptions str
, ("prompt-cont", setPromptCont default_prompt_cont)
, ("editor" , liftIO findEditor >>= setEditor)
, ("stop" , setStop default_stop)
+ , ("timeout", setTimeout default_timeout)
]
no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
@@ -3327,7 +3328,7 @@ unsetOpt str
Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
Just o -> unsetOption o
-strToGHCiOpt :: String -> (Maybe GHCiOption)
+strToGHCiOpt :: String -> Maybe GHCiOption
strToGHCiOpt "m" = Just Multiline
strToGHCiOpt "s" = Just ShowTiming
strToGHCiOpt "t" = Just ShowType
@@ -3342,7 +3343,6 @@ optToStr ShowType = "t"
optToStr RevertCAFs = "r"
optToStr CollectInfo = "c"
-
-- ---------------------------------------------------------------------------
-- :show
@@ -3790,9 +3790,9 @@ completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
return (filter (w `isPrefixOf`) opts)
- where opts = ["args", "prog", "editor", "stop",
+ where opts = [ "args", "prog", "editor", "stop",
"modules", "bindings", "linker", "breaks",
- "context", "packages", "paths", "language", "imports"]
+ "context", "packages", "paths", "language", "imports", "timeout"]
completeShowiOptions = wrapCompleter flagWordBreakChars $ \w -> do
return (filter (w `isPrefixOf`) ["language"])
=====================================
testsuite/tests/ghci/scripts/T24040.script
=====================================
@@ -1,11 +1,12 @@
:load T24040
-:timeout 5
+:set timeout 5
delayNSeconds 10
delayNSeconds 2
-:timeout
+:unset timeout
delayNSeconds 10
-:timeout 1
+:set timeout 1
delayNSeconds 5
delayNSeconds 2
-:timeout
-delayNSeconds 5
\ No newline at end of file
+:unset timeout
+delayNSeconds 5
+:unset timeout
\ No newline at end of file
=====================================
testsuite/tests/ghci/scripts/T24040.stdout
=====================================
@@ -1,7 +1,8 @@
-setting timeout length to 5 seconds
+setting timeout length to: five seconds
Finished in: 2 seconds
-setting timeout to unbounded execution time
+unsetting timeout
Finished in: 10 seconds
-setting timeout length to 1 second
-setting timeout to unbounded execution time
-Finished in: 5 seconds
\ No newline at end of file
+setting timeout length to: one second
+unsetting timeout
+Finished in: 5 seconds
+unsetting timeout
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/736a9abc58aa919b9bfc70870fb5cdddcfb4b8c1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/736a9abc58aa919b9bfc70870fb5cdddcfb4b8c1
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240205/6dec7a80/attachment-0001.html>
More information about the ghc-commits
mailing list