[Git][ghc/ghc][wip/T24040-ghci-timeout-squashed] extra test case to verify :reload does not break timeouts. made :set timeout...

[Hassan Al-Awwadi (@hassan.awwadi)]

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


Commits:
ec3204c3 by Hassan Al-Awwadi at 2024-02-06T17:11:43+01:00
extra test case to verify :reload does not break timeouts. made :set timeout silent. added :show timeout

- - - - -


5 changed files:

- ghc/GHCi/UI.hs
- testsuite/tests/ghci/scripts/T24040.script
- testsuite/tests/ghci/scripts/T24040.stderr
- testsuite/tests/ghci/scripts/T24040.stdout
- + ts.hs


Changes:

=====================================
ghc/GHCi/UI.hs
=====================================
@@ -457,6 +457,7 @@ defFullHelpText =
   "   :show paths                 show the currently active search paths\n" ++
   "   :show language              show the currently active language flags\n" ++
   "   :show targets               show the current set of targets\n" ++
+  "   :show timeout               show the current timeout length\n" ++
   "   :show <setting>             show value of <setting>, which is one of\n" ++
   "                                  [args, prog, editor, stop]\n" ++
   "   :showi language             show language flags for interactive evaluation\n" ++
@@ -3190,10 +3191,8 @@ setParsedPromptString fSetPrompt s = do
 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 })
+    | l > 0  = modifyGHCiState (\st -> st{ time_limit = Just l })
+    | l == 0 = modifyGHCiState (\st -> st{ time_limit = Nothing })
   set_time _ = throwGhcException (CmdLineError "syntax: :set timeout <natural number>")
 
 setOptions wds =
@@ -3384,6 +3383,7 @@ showCmd str = do
             , hidden "languages"  $ showLanguages -- backwards compat
             , hidden "lang"       $ showLanguages -- useful abbreviation
             , action "targets"    $ showTargets
+            , action "timeout"    $ showTimeout
             ]
 
     case words str of
@@ -3576,6 +3576,13 @@ showTargets = mapM_ showTarget =<< GHC.getTargets
     showTarget Target { targetId = TargetModule m } =
       liftIO (putStrLn $ moduleNameString m)
 
+showTimeout :: GhciMonad m => m ()
+showTimeout = do 
+  maybe_limit <- time_limit <$> getGHCiState
+  case maybe_limit of
+    Nothing -> printForUser $ text "unrestricted"
+    Just l  -> printForUser $ speakNOf l "second"
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
@@ -3792,7 +3799,7 @@ completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
   return (filter (w `isPrefixOf`) opts)
     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
=====================================
@@ -9,4 +9,8 @@ delayNSeconds 5
 delayNSeconds 2
 :unset timeout 
 delayNSeconds 5
+:set timeout 5
+:reload
+delayNSeconds 10
+delayNSeconds 2
 :unset timeout
\ No newline at end of file


=====================================
testsuite/tests/ghci/scripts/T24040.stderr
=====================================
@@ -1,3 +1,4 @@
 *** Exception: GhciTimedOut
 *** Exception: GhciTimedOut
+*** Exception: GhciTimedOut
 *** Exception: GhciTimedOut
\ No newline at end of file


=====================================
testsuite/tests/ghci/scripts/T24040.stdout
=====================================
@@ -1,8 +1,4 @@
-setting timeout length to: five seconds
 Finished in: 2 seconds
-unsetting timeout
 Finished in: 10 seconds
-setting timeout length to: one second
-unsetting timeout
 Finished in: 5 seconds
-unsetting timeout
\ No newline at end of file
+Finished in: 2 seconds
\ No newline at end of file


=====================================
ts.hs
=====================================
@@ -0,0 +1,5 @@
+module Main where
+import Control.Concurrent 
+
+test = threadDelay 2000000
+main = test
\ No newline at end of file



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec3204c399d60c504e163b153cabf15ccc49a295

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