[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 23:08:54 UTC 2024



Hassan Al-Awwadi pushed to branch wip/T24040-ghci-timeout-squashed at Glasgow Haskell Compiler / GHC


Commits:
7b0722e0 by Hassan Al-Awwadi at 2024-02-05T23:39:04+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
@@ -1116,8 +1118,8 @@ data GhciTimedOut = GhciTimedOut deriving Show
 instance Exception GhciTimedOut
 
 -- | Wraps a single run input action into a timout action, if the timelimit field has been set.
--- | Otherwise it just runs the action without doing anything.
--- | See Note [Where to Time]
+-- Otherwise it just runs the action without doing anything.
+-- See Note [Where to Time]
 withTimeLimit :: (MonadIO m, MonadCatch m, GhciMonad m) => a -> m a -> m a
 withTimeLimit time_out_value cmd = do
   maybe_limit <- time_limit <$> getGHCiState
@@ -1129,12 +1131,12 @@ withTimeLimit time_out_value cmd = do
       pure r where
 
       -- | 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 😌
+      -- transitively, because really this is a dupe of time-out's Control.Timeout(timeout)
+      -- 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
-        -- | We might want to keep a single thread alive to reuse?
+        -- We might want to keep a single thread alive to reuse?
         tidTemp <- liftIO $ forkIO $ delay time >> throwTo tidMain GhciTimedOut
         result  <- catchTimeout action `MC.onException` liftIO (killThread tidTemp)
         when (isJust result) $ liftIO $ killThread tidTemp
@@ -1166,7 +1168,7 @@ runOneCommand eh gCmd = do
       st <- getGHCiState
       ghciHandle (\e -> lift $ eh e >>= return . Just) $
         handleSourceError printErrorAndFail $
-          withTimeLimit (Just False) $ cmd_wrapper st $ doCommand c -- ^ See Note [Where to Time]
+          withTimeLimit (Just False) $ cmd_wrapper st $ doCommand c -- See Note [Where to Time]
                -- source error's are handled by runStmt
                -- is the handler necessary here?
   where
@@ -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,7 +3790,7 @@ 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"]
 


=====================================
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/7b0722e0d31466c734bfcaaefff5055e98398deb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b0722e0d31466c734bfcaaefff5055e98398deb
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/a027e3eb/attachment-0001.html>


More information about the ghc-commits mailing list