diff --git a/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs b/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs index a7d24b3c9cc6f06ea327efaf70f54dfd35ed2e60..c0ce545e074597981208ffb44b3b11f054391e8e 100644 --- a/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs +++ b/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs @@ -3,6 +3,7 @@ namespace FSharp.Compiler.Scripting open System +open System.Threading open FSharp.Compiler.Interactive.Shell type FSharpScript(?captureInput: bool, ?captureOutput: bool, ?additionalArgs: string[]) as this = @@ -42,8 +43,9 @@ type FSharpScript(?captureInput: bool, ?captureOutput: bool, ?additionalArgs: st member __.ErrorProduced = errorProduced.Publish - member __.Eval(code: string) = - let ch, errors = fsi.EvalInteractionNonThrowing code + member __.Eval(code: string, ?cancellationToken: CancellationToken) = + let cancellationToken = defaultArg cancellationToken CancellationToken.None + let ch, errors = fsi.EvalInteractionNonThrowing(code, cancellationToken) match ch with | Choice1Of2 v -> Ok(v), errors | Choice2Of2 ex -> Error(ex), errors diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 6a90958b6a169090e59b124ea22e866c0af4c0c1..bfecea2a169d912b748c5f93825db3aa9fa061eb 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -1888,7 +1888,8 @@ type internal FsiInteractionProcessor /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option) = + let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = + cancellationToken.ThrowIfCancellationRequested() let action,nextAction,istate = match action with | None -> None,None,istate @@ -1935,7 +1936,7 @@ type internal FsiInteractionProcessor | Some action, _ -> let istate,cont = ExecInteraction (ctok, tcConfig, istate, action, errorLogger) match cont with - | Completed _ -> execParsedInteractions (ctok, tcConfig, istate, nextAction, errorLogger, Some cont) + | Completed _ -> execParsedInteractions (ctok, tcConfig, istate, nextAction, errorLogger, Some cont, cancellationToken) | CompletedWithReportedError e -> istate,CompletedWithReportedError e (* drop nextAction on error *) | EndOfFile -> istate,defaultArg lastResult (Completed None) (* drop nextAction on EOF *) | CtrlC -> istate,CtrlC (* drop nextAction on CtrlC *) @@ -1962,9 +1963,9 @@ type internal FsiInteractionProcessor stopProcessingRecovery e range0; istate, CompletedWithReportedError e - let mainThreadProcessParsedInteractions ctok errorLogger (action, istate) = + let mainThreadProcessParsedInteractions ctok errorLogger (action, istate) cancellationToken = istate |> mainThreadProcessAction ctok (fun ctok tcConfig istate -> - execParsedInteractions (ctok, tcConfig, istate, action, errorLogger, None)) + execParsedInteractions (ctok, tcConfig, istate, action, errorLogger, None, cancellationToken)) let parseExpression (tokenizer:LexFilter.LexFilter) = reusingLexbufForParsing tokenizer.LexBuffer (fun () -> @@ -1997,8 +1998,8 @@ type internal FsiInteractionProcessor /// During processing of startup scripts, this runs on the main thread. /// /// This is blocking: it reads until one chunk of input have been received, unless IsPastEndOfStream is true - member __.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:LexFilter.LexFilter, errorLogger) = - + member __.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:LexFilter.LexFilter, errorLogger, ?cancellationToken: CancellationToken) = + let cancellationToken = defaultArg cancellationToken CancellationToken.None if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = if fsiInterruptController.FsiInterruptStdinState = StdinEOFPermittedBecauseCtrlCRecentlyPressed then @@ -2022,7 +2023,7 @@ type internal FsiInteractionProcessor // After we've unblocked and got something to run we switch // over to the run-thread (e.g. the GUI thread) - let res = istate |> runCodeOnMainThread (fun ctok istate -> mainThreadProcessParsedInteractions ctok errorLogger (action, istate)) + let res = istate |> runCodeOnMainThread (fun ctok istate -> mainThreadProcessParsedInteractions ctok errorLogger (action, istate) cancellationToken) if !progress then fprintfn fsiConsoleOutput.Out "Just called runCodeOnMainThread, res = %O..." res; res) @@ -2093,7 +2094,8 @@ type internal FsiInteractionProcessor member __.LoadDummyInteraction(ctok, errorLogger) = setCurrState (currState |> InteractiveCatch errorLogger (fun istate -> fsiDynamicCompiler.EvalParsedDefinitions (ctok, errorLogger, istate, true, false, []) |> fst, Completed None) |> fst) - member __.EvalInteraction(ctok, sourceText, scriptFileName, errorLogger) = + member __.EvalInteraction(ctok, sourceText, scriptFileName, errorLogger, ?cancellationToken) = + let cancellationToken = defaultArg cancellationToken CancellationToken.None use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive) use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID @@ -2102,7 +2104,7 @@ type internal FsiInteractionProcessor currState |> InteractiveCatch errorLogger (fun istate -> let expr = ParseInteraction tokenizer - mainThreadProcessParsedInteractions ctok errorLogger (expr, istate) ) + mainThreadProcessParsedInteractions ctok errorLogger (expr, istate) cancellationToken) |> commitResult member this.EvalScript (ctok, scriptPath, errorLogger) = @@ -2592,25 +2594,26 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i fsiInteractionProcessor.EvalExpression(ctok, sourceText, dummyScriptFileName, errorLogger) |> commitResultNonThrowing errorOptions dummyScriptFileName errorLogger - member x.EvalInteraction(sourceText) : unit = + member x.EvalInteraction(sourceText, ?cancellationToken) : unit = // Explanation: When the user of the FsiInteractiveSession object calls this method, the // code is parsed, checked and evaluated on the calling thread. This means EvalExpression // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - - fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger) + let cancellationToken = defaultArg cancellationToken CancellationToken.None + fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger, cancellationToken) |> commitResult |> ignore - member x.EvalInteractionNonThrowing(sourceText) = + member x.EvalInteractionNonThrowing(sourceText, ?cancellationToken) = // Explanation: When the user of the FsiInteractiveSession object calls this method, the // code is parsed, checked and evaluated on the calling thread. This means EvalExpression // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() + let cancellationToken = defaultArg cancellationToken CancellationToken.None let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) - fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger) + fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger, cancellationToken) |> commitResultNonThrowing errorOptions "input.fsx" errorLogger member x.EvalScript(scriptPath) : unit = diff --git a/src/fsharp/fsi/fsi.fsi b/src/fsharp/fsi/fsi.fsi index 8809c213a359bbf72681462e178079e470bf85ae..8cc0b23fed06fec6ebde90d495324450868b2e6e 100644 --- a/src/fsharp/fsi/fsi.fsi +++ b/src/fsharp/fsi/fsi.fsi @@ -4,6 +4,7 @@ module public FSharp.Compiler.Interactive.Shell open System.IO +open System.Threading open FSharp.Compiler open FSharp.Compiler.SourceCodeServices @@ -146,7 +147,7 @@ type FsiEvaluationSession = /// /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. - member EvalInteraction : code: string -> unit + member EvalInteraction : code: string * ?cancellationToken: CancellationToken -> unit /// Execute the code as if it had been entered as one or more interactions, with an /// implicit termination at the end of the input. Stop on first error, discarding the rest @@ -155,7 +156,7 @@ type FsiEvaluationSession = /// /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. - member EvalInteractionNonThrowing : code: string -> Choice * FSharpErrorInfo[] + member EvalInteractionNonThrowing : code: string * ?cancellationToken: CancellationToken -> Choice * FSharpErrorInfo[] /// Execute the given script. Stop on first error, discarding the rest /// of the script. Errors are sent to the output writer, a 'true' return value indicates there diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs index 7452ab5bb72994db55d317afa87fe6f1deddd443..1de9c9beaf99d99651a80ce886db4161c8292ce9 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs @@ -3,8 +3,10 @@ namespace FSharp.Compiler.Scripting.UnitTests open System +open System.Diagnostics open System.IO open System.Threading +open System.Threading.Tasks open FSharp.Compiler.Interactive.Shell open FSharp.Compiler.Scripting open FSharp.Compiler.SourceCodeServices @@ -107,3 +109,26 @@ type InteractiveTests() = match result with | Ok(_) -> Assert.Fail("expected a failure") | Error(ex) -> Assert.IsInstanceOf(ex) + + [] + member _.``Evaluation can be cancelled``() = + use script = new FSharpScript() + let sleepTime = 10000 + let mutable result = None + let mutable wasCancelled = false + use tokenSource = new CancellationTokenSource() + let eval () = + try + result <- Some(script.Eval(sprintf "System.Threading.Thread.Sleep(%d)\n2" sleepTime, tokenSource.Token)) + // if execution gets here (which it shouldn't), the value `2` will be returned + with + | :? OperationCanceledException -> wasCancelled <- true + let sw = Stopwatch.StartNew() + let evalTask = Task.Run(eval) + // cancel and wait for finish + tokenSource.Cancel() + evalTask.GetAwaiter().GetResult() + // ensure we cancelled and didn't complete the sleep or evaluation + Assert.True(wasCancelled) + Assert.LessOrEqual(sw.ElapsedMilliseconds, sleepTime) + Assert.AreEqual(None, result)