diff --git a/FSharp.slnx b/FSharp.slnx index 50819fbfb6b..bedbd53bf36 100644 --- a/FSharp.slnx +++ b/FSharp.slnx @@ -27,6 +27,9 @@ + + + diff --git a/VisualFSharp.slnx b/VisualFSharp.slnx index 9f6eed02f50..caa059a34ee 100644 --- a/VisualFSharp.slnx +++ b/VisualFSharp.slnx @@ -40,6 +40,9 @@ + + + diff --git a/buildtools/AssemblyCheck/SkipVerifyEmbeddedPdb.txt b/buildtools/AssemblyCheck/SkipVerifyEmbeddedPdb.txt index f7d25f2ca25..378d1be728d 100644 --- a/buildtools/AssemblyCheck/SkipVerifyEmbeddedPdb.txt +++ b/buildtools/AssemblyCheck/SkipVerifyEmbeddedPdb.txt @@ -1,6 +1,7 @@ FSharp.Build.UnitTests.dll FSharp.Benchmarks.Common.dll FSharp.Compiler.Benchmarks.dll +FSharp.Compiler.Interactive.Server.Tests.dll FSharp.Compiler.ComponentTests.dll FSharp.Test.Utilities.dll FSharp.Compiler.LanguageServer.Tests.dll diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index b1a0fbd89bb..b088e1f5f85 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -1,8 +1,13 @@ +### Added + +* F# Interactive gains a JSON-RPC server mode, `--fsi-server-jsonrpc:`, in which a host submits interactions over a named pipe and receives structured results — diagnostics with positions, escaping exceptions, the values each interaction bound, and the session's own process id — instead of recovering them by looking for a `SERVER-PROMPT>` marker in the output text. Program output continues to flow through the redirected console streams. The pipe admits only the user running the session; `--fsi-server-client-pid:` names the host process whose exit ends the session. `FsiEvaluationSession` exposes both options as `JsonRpcServerPipeName` and `JsonRpcClientProcessId`. The mode is part of the .NET fsi only. ([PR #20396](https://github.com/dotnet/fsharp/pull/20396)) + ### Fixed * Fix internal error "no 'value__' field found for enumeration type" when an `enum` constraint is checked against an enum declared in the same recursive group (`module rec` or an `and` group). The constraint is now solved once the representations of the group are established. ([Issue #14580](https://github.com/dotnet/fsharp/issues/14580), [PR #20454](https://github.com/dotnet/fsharp/pull/20454)) * Better diagnostic for a bare `enum` constraint: `'T : enum` now reports FS0699 "An 'enum' constraint must be of the form 'enum'" instead of "Unexpected identifier: 'enum (4)'", and parser messages for invalid constraints no longer leak internal ` (2)`/` (3)`/` (4)` markers. ([Issue #14580](https://github.com/dotnet/fsharp/issues/14580), [PR #20454](https://github.com/dotnet/fsharp/pull/20454)) * Fix FSI `--multiemit+ --debug-` unnecessarily generating and loading portable PDB data for every submission. ([Issue #17306](https://github.com/dotnet/fsharp/issues/17306), [PR #20394](https://github.com/dotnet/fsharp/pull/20394), [downstream report](https://github.com/bryanedds/Nu/issues/1090)) +* `FsiEvaluationSession.EvalInteraction` and `EvalInteractionNonThrowing` evaluate every `;;`-separated interaction in the text they are given, as their documentation has always said, instead of silently discarding everything after the first. ([PR #20396](https://github.com/dotnet/fsharp/pull/20396)) * Fix reference-assembly MVID collisions when a public member is renamed in an early file of a large (>~32 file) project under `--optimize-`. The per-file signature hashes were folded with a left-shift-by-one combiner over a 32-bit `Hash`, which truncated the contribution of any file more than ~32 positions from the end of the compile order, so MSBuild's `CopyRefAssembly` saw an unchanged MVID and kept a stale reference assembly (surfacing as `FS0039` downstream). The combiner is now an FNV-1a multiply mix over a 64-bit `Hash`. ([Issue #20389](https://github.com/dotnet/fsharp/issues/20389)) * Fix internal error FS0192 "Iterate2D" when a `[]` parameter auto-quotes an argument that captures a not-yet-generalized use of an inferred generically-recursive function. The auto-quoted (`Expr.WithValue`) copy now keeps a fresh link to the recursive-value use so it receives the same inferred type arguments as the executable expression at the letrec point. ([Issue #20379](https://github.com/dotnet/fsharp/issues/20379)) * Fix `StackOverflowException` when checking a long `seq { ... }` body. ([PR #20480](https://github.com/dotnet/fsharp/pull/20480)) diff --git a/eng/Packages.props b/eng/Packages.props index c6b2eabb7a2..eac871c2d58 100644 --- a/eng/Packages.props +++ b/eng/Packages.props @@ -116,6 +116,10 @@ + + diff --git a/eng/Signing.props b/eng/Signing.props index 222ad3dc47a..a5b0fdc9a7c 100644 --- a/eng/Signing.props +++ b/eng/Signing.props @@ -3,6 +3,11 @@ + + + + + diff --git a/eng/tests/TestSplit.fsx b/eng/tests/TestSplit.fsx index dfb7724142c..488fa771e28 100644 --- a/eng/tests/TestSplit.fsx +++ b/eng/tests/TestSplit.fsx @@ -48,6 +48,7 @@ let otherProjects = "tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj", 2, "all" "tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj", 2, "all" "tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj", 2, "all" + "tests/FSharp.Compiler.Interactive.Server.Tests/FSharp.Compiler.Interactive.Server.Tests.fsproj", 2, "coreclr" "tests/fsharp/FSharpSuite.Tests.fsproj", 3, "desktop" ] diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index ce2ec781e91..67a4560c5de 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -988,11 +988,19 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s let mutable fsiServerOutputCodePage = None let mutable fsiLCID = None + let mutable fsiServerJsonRpcPipe = "" + let mutable fsiServerClientProcessId = None + // internal options let mutable probeToSeeIfConsoleWorks = true let mutable peekAheadOnConsoleToPermitTyping = true - let isInteractiveServer () = fsiServerName <> "" + let isJsonRpcServer () = fsiServerJsonRpcPipe <> "" + + // Neither server mode has a user at a console, so neither uses the console reader. + let isInteractiveServer () = + fsiServerName <> "" || isJsonRpcServer () + let recordExplicitArg arg = explicitArgs <- explicitArgs @ [ arg ] let executableFileNameWithoutExtension = @@ -1074,6 +1082,8 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s [ // Make internal fsi-server* options. Do not print in the help. They are used by VFSI. CompilerOption("fsi-server-report-references", "", OptionString(fun s -> writeReferencesAndExit <- Some s), None, None) CompilerOption("fsi-server", "", OptionString(fun s -> fsiServerName <- s), None, None) // "FSI server mode on given named channel"); + CompilerOption("fsi-server-jsonrpc", "", OptionString(fun s -> fsiServerJsonRpcPipe <- s), None, None) // "FSI server mode speaking JSON-RPC over the given named pipe" + CompilerOption("fsi-server-client-pid", "", OptionInt(fun n -> fsiServerClientProcessId <- Some n), None, None) // "Process id of the host; the JSON-RPC server exits when it does" CompilerOption("fsi-server-input-codepage", "", OptionInt(fun n -> fsiServerInputCodePage <- Some(n)), None, None) // " Set the input codepage for the console"); CompilerOption("fsi-server-output-codepage", "", OptionInt(fun n -> fsiServerOutputCodePage <- Some(n)), None, None) // " Set the output codepage for the console"); CompilerOption( @@ -1385,6 +1395,16 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s member _.IsInteractiveServer = isInteractiveServer () + member _.IsJsonRpcServer = isJsonRpcServer () + + member _.JsonRpcServerPipeName = + if isJsonRpcServer () then + Some fsiServerJsonRpcPipe + else + None + + member _.JsonRpcClientProcessId = fsiServerClientProcessId + member _.ProbeToSeeIfConsoleWorks = probeToSeeIfConsoleWorks member _.EnableConsoleKeyProcessing = enableConsoleKeyProcessing @@ -1477,7 +1497,9 @@ type internal FsiConsolePrompt(fsiOptions: FsiCommandLineOptions, fsiConsoleOutp // A prompt gets "printed ahead" at start up. Tells users to start type while initialisation completes. // A prompt can be skipped by "silent directives", e.g. ones sent to FSI by VS. let mutable dropPrompt = 0 - let mutable showPrompt = true + + // A JSON-RPC host learns an interaction finished from the response to its request. + let mutable showPrompt = not fsiOptions.IsJsonRpcServer // NOTE: SERVER-PROMPT is not user displayed, rather it's a prefix that code elsewhere // uses to identify the prompt, see service\FsPkgs\FSharp.VS.FSI\fsiSessionToolWindow.fs @@ -1520,17 +1542,13 @@ type internal FsiConsoleInput let consoleOpt = // The "console.fs" code does a limited form of "TAB-completion". - // Currently, it turns on if it looks like we have a console. - if fsiOptions.EnableConsoleKeyProcessing then + // Currently, it turns on if it looks like we have a console. A session driven by a host has + // no user at a console, whatever the probe would say. + if fsiOptions.EnableConsoleKeyProcessing && not fsiOptions.IsInteractiveServer then fsi.GetOptionalConsoleReadLine(fsiOptions.ProbeToSeeIfConsoleWorks) else None - // When VFSI is running, there should be no "console", and in particular the console.fs readline code should not to run. - do - if fsiOptions.IsInteractiveServer then - assert consoleOpt.IsNone - /// This threading event gets set after the first-line-reader has finished its work let consoleReaderStartupDone = new ManualResetEvent(false) @@ -4413,11 +4431,37 @@ type FsiInteractionProcessor let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, diagnosticsLogger) - currState - |> InteractiveCatch diagnosticsLogger (fun istate -> - let expr = ParseInteraction tcConfigB.diagnosticsOptions tokenizer - ExecuteParsedInteractionOnMainThread(ctok, diagnosticsLogger, expr, istate, cancellationToken)) - |> commitResult + // The text may hold several interactions, as standard input would. Each one that completes + // is committed before the next is parsed, so that a failure later in the text keeps what ran + // before it; the value reported is that of the last interaction that produced one. + let rec run istate lastValue = + let errorsBefore = diagnosticsLogger.ErrorCount + + let istate, status = + istate + |> InteractiveCatch diagnosticsLogger (fun istate -> + match ParseInteraction tcConfigB.diagnosticsOptions tokenizer with + | Some(ParsedScriptInteraction.Definitions([], _)) -> istate, Completed lastValue + | expr -> ExecuteParsedInteractionOnMainThread(ctok, diagnosticsLogger, expr, istate, cancellationToken)) + + let status = + match status with + | Completed value -> Completed(Option.orElse lastValue value) + | status -> status + + match status with + | Completed value when + diagnosticsLogger.ErrorCount = errorsBefore + && not tokenizer.LexBuffer.IsPastEndOfStream + -> + if cancellationToken.IsCancellationRequested then + istate, CtrlC + else + setCurrState istate + run istate value + | _ -> istate, status + + run currState None |> commitResult member this.EvalScript(ctok, scriptPath, diagnosticsLogger) = // Todo: this runs the script as expected but errors are displayed one line to far in debugger @@ -4959,6 +5003,10 @@ type FsiEvaluationSession /// A host calls this to get the active language ID if provided by fsi-server-lcid member _.LCID = fsiOptions.FsiLCID + member _.JsonRpcServerPipeName = fsiOptions.JsonRpcServerPipeName + + member _.JsonRpcClientProcessId = fsiOptions.JsonRpcClientProcessId + /// A host calls this to report an unhandled exception in a standard way, e.g. an exception on the GUI thread gets printed to stderr member x.ReportUnhandledException exn = x.ReportUnhandledExceptionSafe true exn @@ -5108,7 +5156,9 @@ type FsiEvaluationSession // We later switch to doing interaction-by-interaction processing on the "event loop" thread let ctokRun = AssumeCompilationThreadWithoutEvidence() - if fsiOptions.IsInteractiveServer then + // The JSON-RPC server carries interrupts on its own connection and is started by the + // process entry point. + if fsiOptions.IsInteractiveServer && not fsiOptions.IsJsonRpcServer then SpawnInteractiveServer(fsi, fsiOptions, fsiConsoleOutput) use _ = UseBuildPhase BuildPhase.Interactive @@ -5127,7 +5177,10 @@ type FsiEvaluationSession | _ -> ()) fsiInteractionProcessor.LoadInitialFiles(ctokRun, diagnosticsLogger) - fsiInteractionProcessor.StartStdinReadAndProcessThread(tcConfigB.diagnosticsOptions, diagnosticsLogger) + + // Interactions arrive on the control channel, leaving stdin to the script. + if not fsiOptions.IsJsonRpcServer then + fsiInteractionProcessor.StartStdinReadAndProcessThread(tcConfigB.diagnosticsOptions, diagnosticsLogger) DriveFsiEventLoop(fsi, fsiInterruptController, fsiConsoleOutput) diff --git a/src/Compiler/Interactive/fsi.fsi b/src/Compiler/Interactive/fsi.fsi index 14bda032a76..d04d191cdb9 100644 --- a/src/Compiler/Interactive/fsi.fsi +++ b/src/Compiler/Interactive/fsi.fsi @@ -310,6 +310,13 @@ type FsiEvaluationSession = /// A host calls this to get the active language ID if provided by fsi-server-lcid member LCID: int option + /// The named pipe requested with `--fsi-server-jsonrpc`, when a host is to drive the session over + /// JSON-RPC instead of standard input. + member JsonRpcServerPipeName: string option + + /// The host process named with `--fsi-server-client-pid`, whose exit ends the session. + member JsonRpcClientProcessId: int option + /// A host calls this to report an unhandled exception in a standard way, e.g. an exception on the GUI thread gets printed to stderr member ReportUnhandledException: exn: exn -> unit diff --git a/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.fsproj b/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.fsproj index 76a3201346d..6d22630f336 100644 --- a/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.fsproj +++ b/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.fsproj @@ -26,6 +26,18 @@ + + + MessagePack.dll;MessagePack.Annotations.dll;Microsoft.VisualStudio.Threading.dll;Microsoft.VisualStudio.Validation.dll;Nerdbank.MessagePack.dll;Nerdbank.Streams.dll;Newtonsoft.Json.dll;PolyType.dll;StreamJsonRpc.dll + $([System.Text.RegularExpressions.Regex]::Replace('$(FsiJsonRpcServerAssemblies)', '([^;]+);?', '<file src="fsi\$(Configuration)\$(FSharpNetCoreProductTargetFramework)\$1" target="lib\$(FSharpNetCoreProductTargetFramework)" /> ')) + + + + + diff --git a/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.nuspec b/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.nuspec index c8b40cf588d..f2a141f6d7d 100644 --- a/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.nuspec +++ b/src/Microsoft.FSharp.Compiler/Microsoft.FSharp.Compiler.nuspec @@ -28,6 +28,10 @@ + + $fsiJsonRpcServerFiles$ diff --git a/src/fsi/fsi.targets b/src/fsi/fsi.targets index b38960f7f0e..a82cef02782 100644 --- a/src/fsi/fsi.targets +++ b/src/fsi/fsi.targets @@ -22,6 +22,13 @@ $(DefineConstants);FSI_SHADOW_COPY_REFERENCES;FSI_SERVER + + + true + $(DefineConstants);FSI_JSONRPC_SERVER + + true @@ -29,6 +36,12 @@ true + + + + + + LegacyResolver.txt diff --git a/src/fsi/fsimain.fs b/src/fsi/fsimain.fs index 314b01b5c31..75ee1d13d04 100644 --- a/src/fsi/fsimain.fs +++ b/src/fsi/fsimain.fs @@ -251,6 +251,12 @@ let evaluateSession (argv: string[]) = let legacyReferenceResolver = LegacyMSBuildReferenceResolver.getResolver () +#if FSI_JSONRPC_SERVER + // Set when startup scripts are done and the loop interactions run on is the final one: a + // startup script may replace fsi.EventLoop, and a request posted to the old one is lost. + let eventLoopStarted = new System.Threading.ManualResetEvent(false) +#endif + // Update the configuration to include 'StartServer', WinFormsEventLoop and 'GetOptionalConsoleReadLine()' let rec fsiConfig = { new FsiEvaluationSessionHostConfig() with @@ -269,6 +275,9 @@ let evaluateSession (argv: string[]) = fsiConfig0.ReportUserCommandLineArgs args member _.EventLoopRun() = +#if FSI_JSONRPC_SERVER + eventLoopStarted.Set() |> ignore +#endif #if !FX_NO_WINFORMS match (if fsiSession.IsGui then fsiWinFormsLoop.Value else None) with | Some l -> (l :> IEventLoop).Run() @@ -341,6 +350,28 @@ let evaluateSession (argv: string[]) = | None -> s2 )) + match fsiSession.JsonRpcServerPipeName with +#if FSI_JSONRPC_SERVER + // Serve the host on a background thread, leaving this thread to Run() and the event loop + // that interactions are evaluated on. + | Some pipeName -> + FSharp.Compiler.Interactive.Server.startOnBackgroundThread + fsiSession + fsiConfig + pipeName + fsiSession.JsonRpcClientProcessId + eventLoopStarted + Console.Out + Console.Error +#else + // Without the server the session would sit in Run() with nothing feeding it: no prompt, no + // standard input reader. An exit code gives the host something to report instead. + | Some _ -> + eprintfn "The JSON-RPC server mode is not available in this build of F# Interactive." + exit 1 +#endif + | None -> () + // Start the session fsiSession.Run() 0 diff --git a/src/fsi/fsiserver.fs b/src/fsi/fsiserver.fs new file mode 100644 index 00000000000..a228eeb001f --- /dev/null +++ b/src/fsi/fsiserver.fs @@ -0,0 +1,573 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// +/// The JSON-RPC server mode of F# Interactive, activated by --fsi-server-jsonrpc:<pipe name>. +/// +/// +/// +/// An editor hosting F# Interactive needs two things from the process: a control channel to submit +/// interactions and receive structured results, and the program's own console output. This server +/// keeps those apart. Control traffic is JSON-RPC over a named pipe; everything the script itself +/// prints continues to flow through the redirected standard output and error streams, exactly as it +/// does for a console session. That separation is what removes the need for a host to recognise +/// prompts in the output text in order to tell one interaction's results from the next. +/// +/// +/// The transport is StreamJsonRpc over a header-delimited stream, the same combination Roslyn's +/// interactive host uses, so a client built on that library talks to this one with its stock +/// message handler. +/// +/// +/// Threading mirrors the standard input path of a console session. Interactions are evaluated on +/// the event loop thread by way of EventLoopInvoke, so scripts that create user interface +/// objects behave as they do at the console. Interactions are queued onto a single worker so that +/// they run in the order they arrived, while requests that must not wait behind them — an interrupt +/// above all — are served as they arrive. +/// +/// +module FSharp.Compiler.Interactive.Server + +open System +open System.Collections.Concurrent +open System.Diagnostics +open System.IO +open System.IO.Pipes +open System.Reflection +open System.Runtime.InteropServices +open System.Threading +open System.Threading.Tasks + +open Newtonsoft.Json +open StreamJsonRpc + +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Interactive.Protocol +open FSharp.Compiler.Interactive.Shell +open FSharp.Compiler.Symbols + +/// File name reported for interactions that the host did not attribute to a source file. +[] +let private DefaultInteractionName = "stdin.fsx" + +//------------------------------------------------------------------------- +// Shaping results for the wire +//------------------------------------------------------------------------- + +let private severityText (severity: FSharpDiagnosticSeverity) = + match severity with + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Info -> "info" + | FSharpDiagnosticSeverity.Hidden -> "hidden" + +let private toDiagnosticInfo (diagnostic: FSharpDiagnostic) = + { + severity = severityText diagnostic.Severity + message = diagnostic.Message + errorNumber = diagnostic.ErrorNumber + subcategory = diagnostic.Subcategory + fileName = diagnostic.FileName + startLine = diagnostic.StartLine + startColumn = diagnostic.StartColumn + endLine = diagnostic.EndLine + endColumn = diagnostic.EndColumn + } + +/// A path spliced into a directive as a verbatim string literal, in which only a quote needs escaping. +let private verbatimString (text: string) = + "@\"" + text.Replace("\"", "\"\"") + "\"" + +/// Watch the process that owns this session, so that an F# Interactive left behind by a crashed +/// host does not survive as an orphan. +let private watchClientProcess (clientProcessId: int) = + let client = Process.GetProcessById clientProcessId + client.EnableRaisingEvents <- true + client.Exited.Add(fun _ -> exit 0) + + // The host may already have gone by the time the handler was attached. + if client.HasExited then + exit 0 + +let private invalidParams message = + LocalRpcException(message, ErrorCode = -32602) + +[] +type private StrictRequestJsonConverter() = + inherit JsonConverter() + + override _.CanConvert(objectType) = + objectType = typeof + || objectType = typeof + || objectType = typeof> + + override _.CanWrite = false + + override _.WriteJson(_, _, _) = raise (NotSupportedException()) + + override this.ReadJson(reader, objectType, _, _) = + match reader.TokenType with + | JsonToken.Null -> null + | JsonToken.String when objectType = typeof -> reader.Value + | JsonToken.Integer when objectType = typeof> -> + match reader.Value with + | :? int64 as value when value >= int64 Int32.MinValue && value <= int64 Int32.MaxValue -> box (Nullable(int value)) + | _ -> raise (invalidParams "The integer is outside the supported range.") + | JsonToken.StartArray when objectType = typeof -> + let items = ResizeArray() + + while reader.Read() && reader.TokenType <> JsonToken.EndArray do + items.Add(this.ReadJson(reader, typeof, null, null) :?> string) + + box (items.ToArray()) + | token -> raise (invalidParams $"A JSON {token} cannot be read as {objectType.Name}.") + +let inline private require condition message = + if not condition then + raise (invalidParams message) + +let private isDirectivePath (value: string) = + not (isNull value) && value.IndexOfAny [| '"'; '\r'; '\n' |] < 0 + +let private toExecutionResult + (outcome: Choice) + (diagnostics: FSharpDiagnostic[]) + (values: ValueInfo[]) + (cancelled: bool) + = + let hasErrors = + diagnostics + |> Array.exists (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) + + let failure = + match outcome with + | Choice1Of2 _ -> None + // When the interaction failed to compile, the diagnostics already say everything there is + // to say. The exception raised to stop processing carries no more information, and a host + // that reported it alongside them would be saying the same thing twice. + | Choice2Of2 _ when hasErrors -> None + | Choice2Of2 e -> Some e + + { + success = not hasErrors && failure.IsNone && not cancelled + cancelled = cancelled + diagnostics = diagnostics |> Array.map toDiagnosticInfo + ``exception`` = + match failure with + | Some e -> + { + ``type`` = e.GetType().FullName + message = e.Message + stackTrace = + match e.StackTrace with + | null -> "" + | trace -> trace + } + | None -> Unchecked.defaultof + values = values + workingDirectory = Directory.GetCurrentDirectory() + } + +//------------------------------------------------------------------------- +// The server +//------------------------------------------------------------------------- + +/// +/// Serialises the interactions submitted by the host onto a single worker, so that they are +/// evaluated strictly in the order they were received. +/// +/// +/// Owned by the server loop rather than by the target the host calls into: closing the queue ends +/// the session's willingness to run anything, and must not be reachable from the wire. +/// +[] +type internal ExecutionQueue(ready: WaitHandle) = + let queue = new BlockingCollection unit>() + + let worker = + Thread( + (fun () -> + // Requests are accepted from the moment the host connects but run only once the session + // has finished its startup scripts: their bindings would otherwise be reported as the + // first request's, and one posted to an event loop a script then replaces is never run. + ready.WaitOne() |> ignore + + for job in queue.GetConsumingEnumerable() do + // A job reports its own failures to the host; nothing here may escape and kill + // the worker, or the session would stop responding to every later request. + try + job () + with _ -> + ()), + Name = "FSI-JsonRpc-Execute", + IsBackground = true + ) + + do worker.Start() + + /// + /// False once the queue is closed, when the job will never run. Checking + /// IsAddingCompleted first would still race with the close, and a job silently dropped + /// leaves the host waiting on a task nothing completes. + /// + member _.TryEnqueue(job: unit -> unit) = + try + queue.Add job + true + with :? InvalidOperationException -> + false + + member _.Complete() = queue.CompleteAdding() + +/// The object the host calls into. +/// +/// +/// Everything that evaluates code goes onto the execution queue and completes its task when the +/// interaction finishes, which leaves StreamJsonRpc free to dispatch an interrupt in the meantime. +/// +/// +/// The server loop registers the six handlers one by one, so this type stays internal and nothing +/// beyond the protocol is callable from the wire. +/// +/// +[] +type internal FsiRpcTarget + internal + ( + fsiSession: FsiEvaluationSession, + fsiConfig: FsiEvaluationSessionHostConfig, + outWriter: TextWriter, + errorWriter: TextWriter, + shutdownRequested: TaskCompletionSource, + executionQueue: ExecutionQueue + ) = + + let interruptLock = obj () + let mutable currentCancellation: CancellationTokenSource = null + let mutable initialized = false + let values = ResizeArray() + + /// Formatted by the session's own printer, so that the text matches the console's and obeys the + /// session's print settings. Formatting runs user code — a ToString override, a lazy + /// value — so a failure there becomes the value's text rather than a failed interaction. + let toValueInfo (name: string) (value: FsiValue) = + { + name = name + typeName = + match value.ReflectionType with + | null -> "" + | reflectionType -> reflectionType.FullName + value = + try + fsiSession.FormatValue(value.ReflectionValue, value.ReflectionType) + with e -> + $"<{e.GetType().Name}: {e.Message}>" + } + + /// The console prints what the user bound, not the helper bindings the compiler introduces + /// around it, such as the `patternInput` of `let a, b = …`. + let isUserBinding (evaluation: EvaluationEventArgs) = + match evaluation.Symbol with + | :? FSharpMemberOrFunctionOrValue as value -> not value.IsCompilerGenerated + | _ -> true + + do + fsiConfig.OnEvaluation.Add(fun evaluation -> + match evaluation.FsiValue with + | Some value when isUserBinding evaluation -> values.Add(toValueInfo evaluation.Name value) + | _ -> ()) + + /// + /// Evaluate on the event loop thread, the same thread a console session evaluates on. + /// + /// + /// EvalInteractionNonThrowing reports diagnostics and execution failures through its + /// result, but a failure inside the event loop machinery itself would still escape, so it is + /// caught here and reported as an ordinary failed interaction. + /// + let evaluateOnEventLoop (evaluate: unit -> Choice * FSharpDiagnostic[]) = + try + fsiConfig.EventLoopInvoke evaluate + with e -> + Choice2Of2 e, [||] + + /// Flush buffered console writers before answering. The output and RPC streams are independent, + /// so their reader-visible ordering is deliberately unspecified. + let flushConsole () = + try + outWriter.Flush() + errorWriter.Flush() + with _ -> + () + + let runInteraction (code: string) (scriptPath: string) = + let cancellation = new CancellationTokenSource() + + lock interruptLock (fun () -> currentCancellation <- cancellation) + + try + values.Clear() + + let outcome, diagnostics = + evaluateOnEventLoop (fun () -> fsiSession.EvalInteractionNonThrowing(code, scriptPath, cancellation.Token)) + + flushConsole () + toExecutionResult outcome diagnostics (values.ToArray()) cancellation.IsCancellationRequested + finally + lock interruptLock (fun () -> currentCancellation <- null) + cancellation.Dispose() + + /// + /// Queue an interaction and hand back the task the host is waiting on. A request that arrives + /// once the session has stopped accepting work fails, rather than waiting for a turn that will + /// never come. + /// + let queueInteraction (run: unit -> ExecutionResult) = + let completion = + TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) + + let queued = + executionQueue.TryEnqueue(fun () -> + try + completion.TrySetResult(run ()) |> ignore + with e -> + completion.TrySetException e |> ignore) + + if not queued then + completion.TrySetException(LocalRpcException("The F# Interactive session is shutting down", ErrorCode = -32001)) + |> ignore + + completion.Task + + /// Prefix the submitted text with a line directive so that diagnostics point back at the + /// editor's own file and line rather than at the position within the submission. + let positionInteraction (code: string) (sourcePath: string) (startLine: Nullable) = + if String.IsNullOrEmpty sourcePath || not startLine.HasValue then + code + else + $"# {startLine.Value} {verbatimString sourcePath}\n{code}" + + /// Refuse anything that arrives before the handshake, so that a mis-sequenced host gets a clear + /// answer rather than an obscure failure later on. + let requireInitialized () = + if not initialized then + raise (LocalRpcException("'fsi/initialize' must be called first", ErrorCode = -32000)) + + member _.Initialize() : InitializeResult = + initialized <- true + + { + processId = Process.GetCurrentProcess().Id + frameworkDescription = RuntimeInformation.FrameworkDescription + processArchitecture = string RuntimeInformation.ProcessArchitecture + fsiVersion = + match typeof.Assembly.GetName().Version with + | null -> "" + | version -> string version + workingDirectory = Directory.GetCurrentDirectory() + supportsInterrupt = true + } + + member _.Execute(request: ExecuteRequest) : Task = + requireInitialized () + require (not (isNull request.code)) "'code' is required." + require (not request.startLine.HasValue || request.startLine.Value >= 1) "'startLine' must be at least one." + + let text = positionInteraction request.code request.sourcePath request.startLine + + let scriptPath = + if String.IsNullOrEmpty request.sourcePath then + DefaultInteractionName + else + request.sourcePath + + queueInteraction (fun () -> runInteraction text scriptPath) + + member _.ExecuteFile(request: ExecuteFileRequest) : Task = + requireInitialized () + require (not (String.IsNullOrWhiteSpace request.path)) "'path' must not be empty." + + // Routed through #load so that the file joins the session the same way it would from a + // script, rather than being replayed as anonymous text. + queueInteraction (fun () -> runInteraction $"#load {verbatimString request.path}" request.path) + + /// Apply the host's notion of where to look for sources and references, expressed as the + /// directives a script would use. + member _.SetPaths(request: SetPathsRequest) : Task = + requireInitialized () + require (isDirectivePath request.workingDirectory) "'workingDirectory' must be a path without quotes or newlines." + require (not (isNull request.includePaths)) "'includePaths' is required." + + request.includePaths + |> Array.iteri (fun index path -> + require (isDirectivePath path) $"'includePaths[{index}]' must be a path without quotes or newlines.") + + if + not (String.IsNullOrWhiteSpace request.workingDirectory) + && not (Directory.Exists request.workingDirectory) + then + raise (LocalRpcException($"The working directory '{request.workingDirectory}' does not exist.", ErrorCode = -32002)) + + queueInteraction (fun () -> + let directives = ResizeArray() + + if not (String.IsNullOrWhiteSpace request.workingDirectory) then + directives.Add $"#silentCd {verbatimString request.workingDirectory}" + + for path in request.includePaths do + if not (String.IsNullOrWhiteSpace path) then + directives.Add $"#I {verbatimString path}" + + if directives.Count = 0 then + toExecutionResult (Choice1Of2 None) [||] [||] false + else + let previousDirectory = Directory.GetCurrentDirectory() + let result = runInteraction (String.Join("\n", directives)) DefaultInteractionName + + if result.success && not (String.IsNullOrWhiteSpace request.workingDirectory) then + try + Directory.SetCurrentDirectory request.workingDirectory + + { result with + workingDirectory = Directory.GetCurrentDirectory() + } + with e -> + runInteraction $"#silentCd {verbatimString previousDirectory}" DefaultInteractionName + |> ignore + + toExecutionResult (Choice2Of2 e) [||] [||] false + else + result) + + /// Interrupt the interaction in flight. + /// + /// Served straight away rather than queued, which is the point: an interrupt that waited its + /// turn behind the interaction it is meant to stop would never arrive. + /// + member _.Interrupt() : InterruptResult = + requireInitialized () + + lock interruptLock (fun () -> + match currentCancellation with + | null -> { interrupted = false } + | cancellation -> + currentCancellation <- null + + try + cancellation.Cancel() + with _ -> + () + + try + fsiSession.Interrupt() + with _ -> + () + + { interrupted = true }) + + member _.Shutdown() : unit = + requireInitialized () + shutdownRequested.TrySetResult() |> ignore + +/// Wait for the host to connect, then serve requests until it disconnects or asks to shut down. +let private runServer + (fsiSession: FsiEvaluationSession) + (fsiConfig: FsiEvaluationSessionHostConfig) + (pipeName: string) + (clientProcessId: int option) + (eventLoopStarted: WaitHandle) + (outWriter: TextWriter) + (errorWriter: TextWriter) + = + // Watched before the host has connected: a host that dies while starting up must not leave a + // session waiting on the pipe forever. + clientProcessId |> Option.iter watchClientProcess + + // Any local process could otherwise open the pipe, and whoever connects first runs code as this + // user. CurrentUserOnly limits the pipe's access list to the current user and rejects a client + // running as anyone else. + use pipe = + new NamedPipeServerStream( + pipeName, + PipeDirection.InOut, + maxNumberOfServerInstances = 1, + transmissionMode = PipeTransmissionMode.Byte, + options = (PipeOptions.Asynchronous ||| PipeOptions.CurrentUserOnly) + ) + + pipe.WaitForConnection() + + let shutdownRequested = + TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) + + let executionQueue = ExecutionQueue eventLoopStarted + + let target = + FsiRpcTarget(fsiSession, fsiConfig, outWriter, errorWriter, shutdownRequested, executionQueue) + + let formatter = new JsonMessageFormatter() + formatter.JsonSerializer.Converters.Add(new StrictRequestJsonConverter()) + + use rpc = new JsonRpc(new HeaderDelimitedMessageHandler(pipe, formatter)) + + // Registered one by one rather than by reflecting over the target, so that exactly the + // protocol's methods are callable. A request carrying its parameters as one object — the shape + // the protocol documents — lands in the handler's single parameter. + let register (rpcMethod: string) (takesRequestObject: bool) (handlerName: string) = + let handler = + typeof.GetMethod(handlerName, BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic) + + rpc.AddLocalRpcMethod( + handler, + target, + JsonRpcMethodAttribute(rpcMethod, UseSingleObjectParameterDeserialization = takesRequestObject) + ) + + register Methods.Initialize false (nameof target.Initialize) + register Methods.Execute true (nameof target.Execute) + register Methods.ExecuteFile true (nameof target.ExecuteFile) + register Methods.SetPaths true (nameof target.SetPaths) + register Methods.Interrupt false (nameof target.Interrupt) + register Methods.Shutdown false (nameof target.Shutdown) + + rpc.StartListening() + + // Either the host goes away or it asks to stop. A faulted transport is not an orderly + // disconnect: observe it so the process reports failure instead of a successful shutdown. + let completed = Task.WaitAny(rpc.Completion, shutdownRequested.Task) + + if completed = 0 then + rpc.Completion.GetAwaiter().GetResult() + + if shutdownRequested.Task.IsCompleted then + // Give the reply to the shutdown request its moment to reach the host before the process + // disappears from under it. + Task.Delay(250).Wait() + + executionQueue.Complete() + +/// Start the server on a background thread and return, leaving the caller's thread free to drive +/// the event loop. Mirrors how a console session spawns its standard input reader. +let internal startOnBackgroundThread + (fsiSession: FsiEvaluationSession) + (fsiConfig: FsiEvaluationSessionHostConfig) + (pipeName: string) + (clientProcessId: int option) + (eventLoopStarted: WaitHandle) + (outWriter: TextWriter) + (errorWriter: TextWriter) + = + let thread = + Thread( + (fun () -> + try + runServer fsiSession fsiConfig pipeName clientProcessId eventLoopStarted outWriter errorWriter + exit 0 + with e -> + errorWriter.WriteLine $"F# Interactive server terminated: {e}" + errorWriter.Flush() + exit 1), + Name = "FSI-JsonRpc-Dispatch", + IsBackground = true + ) + + thread.Start() diff --git a/src/fsi/interactiveProtocol.fs b/src/fsi/interactiveProtocol.fs new file mode 100644 index 00000000000..ebc4aa050c9 --- /dev/null +++ b/src/fsi/interactiveProtocol.fs @@ -0,0 +1,136 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// The types exchanged between F# Interactive and the editor hosting it. +/// +/// +/// This file is compiled into fsi and linked into the host, so that the two ends of the protocol +/// cannot drift apart. Roslyn achieves the same by having both sides reference one assembly; fsi +/// exposes no public surface to reference, so the source is shared instead. +/// +/// +/// The members are named as they appear on the wire, and the records are CLIMutable so that +/// the JSON-RPC formatter can construct them. +/// +/// +/// Public in the shared source so the host can use the same wire types. The server registers its +/// handlers explicitly; these DTOs are not exposed by reflection as part of the server target. +/// +/// +namespace FSharp.Compiler.Interactive.Protocol + +/// Method names. Both ends use these rather than repeating string literals. +module Methods = + [] + let Initialize = "fsi/initialize" + + [] + let Execute = "fsi/execute" + + [] + let ExecuteFile = "fsi/executeFile" + + [] + let SetPaths = "fsi/setPaths" + + [] + let Interrupt = "fsi/interrupt" + + [] + let Shutdown = "fsi/shutdown" + +[] +type InitializeResult = + { + /// + /// The process actually evaluating code, which is what a debugger attaches to. + /// + /// + /// On .NET this is not the process the host launched: dotnet fsi starts a second + /// process, and it is the inner one that matters. + /// + processId: int + + frameworkDescription: string + processArchitecture: string + fsiVersion: string + workingDirectory: string + supportsInterrupt: bool + } + +[] +type ExecuteRequest = + { + code: string + + /// + /// Where the text came from, when the host is executing a selection from a file. Together + /// with startLine this makes diagnostics point at the user's own source rather than + /// at a position within the submission. + /// + sourcePath: string + + startLine: System.Nullable + } + +[] +type ExecuteFileRequest = { path: string } + +[] +type SetPathsRequest = + { + includePaths: string[] + workingDirectory: string + } + +/// One diagnostic. Lines are one-based and columns zero-based, as they are throughout the compiler. +[] +type DiagnosticInfo = + { + severity: string + message: string + errorNumber: int + subcategory: string + fileName: string + startLine: int + startColumn: int + endLine: int + endColumn: int + } + +/// An exception that escaped an interaction. Null when the interaction merely failed to compile, +/// because the diagnostics already describe that. +[] +type ExceptionInfo = + { + ``type``: string + message: string + stackTrace: string + } + +[] +type ValueInfo = + { + name: string + typeName: string + value: string + } + +[] +type ExecutionResult = + { + /// The interaction was accepted and ran to completion: no error diagnostic, no escaping + /// exception, not interrupted. Warnings do not affect it. + success: bool + + cancelled: bool + diagnostics: DiagnosticInfo[] + ``exception``: ExceptionInfo + values: ValueInfo[] + + /// Reported after every interaction so that the host can keep its own view of the session + /// in step with one that changed directory. + workingDirectory: string + } + +[] +type InterruptResult = { interrupted: bool } diff --git a/tests/FSharp.Compiler.ComponentTests/InteractiveSession/Misc.fs b/tests/FSharp.Compiler.ComponentTests/InteractiveSession/Misc.fs index 1ace807a8fd..7ee54b8656c 100644 --- a/tests/FSharp.Compiler.ComponentTests/InteractiveSession/Misc.fs +++ b/tests/FSharp.Compiler.ComponentTests/InteractiveSession/Misc.fs @@ -1212,13 +1212,13 @@ System.Threading.Thread.Sleep(50);; |> ignore // Span type in FSI - [] + [] let ``SpanType - System.Span usage``() = Fsx """ open System;; let arr = [|1;2;3;4;5|];; -let span = arr.AsSpan();; -if span.Length <> 5 then failwith "test assertion failed";; +let spanLength () = arr.AsSpan().Length;; +if spanLength () <> 5 then failwith "test assertion failed";; () """ |> withOptions ["--nologo"] @@ -1552,13 +1552,13 @@ type IOps<'T> = abstract Zero : 'T;; /// Create an instance of an F77Array and capture its operation set -type Matrix<'T> internal (ops: IOps<'T>, arr: 'T[,]) = - member internal x.Ops = ops - member internal x.Data = arr;; +type Matrix<'T> (ops: IOps<'T>, arr: 'T[,]) = + member x.Ops = ops + member x.Data = arr;; type Matrix = - /// A function to capture operations - static member inline private captureOps() = + /// A function to capture operations + static member inline captureOps() = { new IOps<_> with member x.Add(a,b) = a + b member x.Zero = LanguagePrimitives.GenericZero<_> } diff --git a/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs b/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs index da5ef2a3e2b..fe797fe78ce 100644 --- a/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs +++ b/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs @@ -37,6 +37,15 @@ module ``Interactive tests`` = (Warning 2304, Line 1, Col 3, Line 1, Col 13, "Functions with [] are not invoked in FSI. 'myFunc' was not invoked. Execute 'myFunc ' in order to invoke 'myFunc' with the appropriate string array of command line arguments.") ] + [] + let ``RunScript preserves quit directives inside multiline strings`` () = + let _, output, _ = + global.FSharp.Test.CompilerAssert.RunScriptWithOptionsAndReturnResult + [||] + "let text = \"\"\"\n#quit\n\"\"\"\nprintf \"%s\" text" + + Assert.Contains("#quit", output) + [] [] [] diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/Array2D01.fs b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/Array2D01.fs index 9a64aed8a0a..d37877161ad 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/Array2D01.fs +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/Array2D01.fs @@ -29,6 +29,4 @@ type Array2D1<'T> = { };; -Array2D1 (array2D [[1];[2]]) |> ignore;; - -#q;; \ No newline at end of file +Array2D1 (array2D [[1];[2]]) |> ignore;; \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/NativeIntSuffix01.fs b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/NativeIntSuffix01.fs index a20926bacfe..d002a1675cc 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/NativeIntSuffix01.fs +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/NativeIntSuffix01.fs @@ -4,5 +4,3 @@ //val it: nativeint = 2n nativeint 2;; -#q;; - diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/PipingWithDirectives.fs b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/PipingWithDirectives.fs index 0f55da3f2a6..7eec2170a09 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/PipingWithDirectives.fs +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/PipingWithDirectives.fs @@ -22,5 +22,3 @@ let test3 x = match x with | x -> Some(x) | _ -> None - -#quit diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/UNativeIntSuffix01.fs b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/UNativeIntSuffix01.fs index d5e9e10a97d..a417903b8ba 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/UNativeIntSuffix01.fs +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/InteractiveSession/Misc/UNativeIntSuffix01.fs @@ -4,5 +4,3 @@ //val it: unativeint = 2un unativeint 2;; -#q;; - diff --git a/tests/FSharp.Compiler.Interactive.Server.Tests/FSharp.Compiler.Interactive.Server.Tests.fsproj b/tests/FSharp.Compiler.Interactive.Server.Tests/FSharp.Compiler.Interactive.Server.Tests.fsproj new file mode 100644 index 00000000000..6c96a8f7e7d --- /dev/null +++ b/tests/FSharp.Compiler.Interactive.Server.Tests/FSharp.Compiler.Interactive.Server.Tests.fsproj @@ -0,0 +1,52 @@ + + + + + $(FSharpNetCoreProductTargetFramework) + + Exe + false + + false + true + true + false + false + $(NoWarn);FS0988 + + + + + + + + + + interactiveProtocol.fs + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/FSharp.Compiler.Interactive.Server.Tests/FsiJsonRpcServerTests.fs b/tests/FSharp.Compiler.Interactive.Server.Tests/FsiJsonRpcServerTests.fs new file mode 100644 index 00000000000..47476113f6f --- /dev/null +++ b/tests/FSharp.Compiler.Interactive.Server.Tests/FsiJsonRpcServerTests.fs @@ -0,0 +1,784 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module FSharp.Compiler.Interactive.Server.Tests.FsiJsonRpcServerTests + +open System +open System.IO +open System.Runtime.InteropServices +open System.Threading +open System.Xml.Linq +open Xunit + +open FSharp.Compiler.Interactive.Protocol +open FSharp.Compiler.Interactive.Server.Tests.FsiServerHarness + +/// Start a session, hand it to the test, and shut it down afterwards. +let private withSession (test: FsiServerHarness -> unit) = + use session = new FsiServerHarness() + test session + +/// macOS resolves `/tmp`, `/var` and `/etc` through their `/private` targets when a path is +/// canonicalised by the kernel — which is what happens to the session's own working directory +/// after it changes there — but not when `Path.GetTempPath()`/`GetFullPath` builds one in this +/// process. The two would otherwise disagree on the very directory both sides just agreed on. +let private stripMacPrivatePrefix (path: string) = + if RuntimeInformation.IsOSPlatform OSPlatform.OSX && path.StartsWith("/private/", StringComparison.Ordinal) then + path.Substring "/private".Length + else + path + +/// Start a session that has already completed the handshake. +let private withInitializedSession (test: FsiServerHarness -> unit) = + withSession (fun session -> + session.Initialize() |> ignore + test session) + +/// Include the result and the session's output in a failure, since a protocol result alone rarely +/// explains what the session actually did. +let private describe (session: FsiServerHarness) (result: ExecutionResult) = + $"""result: {describeResult result} +standard output: +{session.StandardOutput} +standard error: +{session.StandardError}""" + +let private temporaryPath (suffix: string) = + Path.Combine(Path.GetTempPath(), $"fsiServerTest_{Guid.NewGuid():N}{suffix}") + +//------------------------------------------------------------------------- +// Handshake +//------------------------------------------------------------------------- + +[] +let ``initialize reports the session process`` () = + withSession (fun session -> + let result = session.Initialize() + + // The reported identifier is what a host attaches a debugger to, so it must be the process + // actually evaluating code rather than any launcher in front of it. + Assert.Equal(session.ProcessId, result.processId) + + Assert.StartsWith(".NET", result.frameworkDescription, StringComparison.Ordinal) + Assert.True result.supportsInterrupt + + Assert.True( + Directory.Exists result.workingDirectory, + $"'{result.workingDirectory}' is not a directory" + )) + +[] +let ``requests before initialize are refused`` () = + withSession (fun session -> + match session.RequestExpectingError(Methods.Execute, FsiServerHarness.ExecuteParams "1 + 1") with + | None -> failwith "the session accepted an interaction before the handshake" + | Some code -> Assert.Equal(-32000, code)) + +[] +let ``unknown methods are refused`` () = + withInitializedSession (fun session -> + match session.RequestExpectingError("fsi/doesNotExist", obj ()) with + | None -> failwith "the session accepted an unknown method" + | Some code -> Assert.Equal(-32601, code)) + +[] +let ``only the protocol's own methods are reachable`` () = + withInitializedSession (fun session -> + // The handlers are registered one by one, so an implementation member — here the one that + // would close the execution queue and stop the session from ever running another + // interaction — is not a method a host can call. + match session.RequestExpectingError("Complete", obj ()) with + | None -> failwith "the session accepted a method that is not part of the protocol" + | Some code -> Assert.Equal(-32601, code) + + let result = session.Execute "1 + 1" + Assert.True(succeeded result, describe session result)) + +[] +let ``request DTOs reject missing required fields as invalid params`` () = + withInitializedSession (fun session -> + let malformedRequests = + [ Methods.Execute, box {| sourcePath = null; startLine = Nullable() |} + Methods.ExecuteFile, obj () + Methods.SetPaths, box {| workingDirectory = "" |} + Methods.Execute, box {| code = 42; sourcePath = null; startLine = Nullable() |} + Methods.ExecuteFile, box {| path = 42 |} + Methods.Execute, box {| code = "1"; sourcePath = null; startLine = "1" |} + Methods.SetPaths, box {| includePaths = 42; workingDirectory = "" |} + Methods.SetPaths, box {| includePaths = Array.empty; workingDirectory = 42 |} + Methods.Execute, box {| code = "1"; sourcePath = null; startLine = 3000000000L |} + Methods.SetPaths, box {| includePaths = [| box 42 |]; workingDirectory = "wd" |} ] + + for methodName, parameters in malformedRequests do + Assert.Equal(Some -32602, session.RequestExpectingError(methodName, parameters))) + +[] +let ``fails when the command-line owner process cannot be watched`` () = + let error = + Assert.ThrowsAny(fun () -> + new FsiServerHarness(clientProcessId = Int32.MaxValue) |> ignore) + + Assert.Contains("exited with code 1", error.Message) + +//------------------------------------------------------------------------- +// The command line +//------------------------------------------------------------------------- + +[] +let ``accepts the switch in its slash spelling`` () = + // fsi's own option parser recognises the switch, so the other spelling it takes for a long option + // turns the server on too. + use session = + new FsiServerHarness(serverSwitches = fun pipeName -> [ $"/fsi-server-jsonrpc:{pipeName}" ]) + + Assert.Equal(session.ProcessId, session.Initialize().processId) + +[] +let ``accepts the switch from a response file`` () = + let responseFile = temporaryPath ".rsp" + + try + use session = + new FsiServerHarness( + serverSwitches = + fun pipeName -> + File.WriteAllText(responseFile, $"--fsi-server-jsonrpc:{pipeName}{Environment.NewLine}") + [ $"@{responseFile}" ] + ) + + Assert.Equal(session.ProcessId, session.Initialize().processId) + finally + try + File.Delete responseFile + with _ -> + () + +//------------------------------------------------------------------------- +// Evaluating interactions +//------------------------------------------------------------------------- + +[] +let ``evaluates an interaction and prints its result`` () = + withInitializedSession (fun session -> + let result = session.Execute "1 + 1" + + Assert.True(succeeded result, describe session result) + Assert.Empty(diagnostics result) + + // The value is reported the way a console session reports it: printed to standard output. + Assert.True(session.WaitForOutput "val it: int = 2", describe session result)) + +[] +[] +[] +let ``returns evaluated values`` code name = + withInitializedSession (fun session -> + let result = session.Execute code + Assert.True(succeeded result, describe session result) + Assert.Contains(result.values, fun value -> value.name = name && value.value = "42")) + +[] +let ``does not report the helper bindings the compiler introduces`` () = + withInitializedSession (fun session -> + // `let a, b = …` compiles through a `patternInput` binding of its own, which must not be + // taken for the user's. + let result = session.Execute """let patternInput = "user";; let a, b = (1, 2)""" + Assert.True(succeeded result, describe session result) + + let names = result.values |> Array.map _.name |> Array.sort + Assert.Equal([| "a"; "b"; "patternInput" |], names)) + +[] +let ``runs requests only after the startup scripts are done`` () = + let startup = temporaryPath ".fsx" + + // Long enough for the request to arrive while the script is still running, and it replaces the + // event loop the way a script that drives its own UI toolkit does. + File.WriteAllText( + startup, + """ +System.Threading.Thread.Sleep 3000 +fsi.EventLoop <- System.Activator.CreateInstance(fsi.EventLoop.GetType(), true) :?> FSharp.Compiler.Interactive.IEventLoop +let startupOnly = 123 +""" + ) + + try + use session = new FsiServerHarness(extraArguments = [ $"--use:{startup}" ]) + session.Initialize() |> ignore + + let result = session.Execute("let requested = 42", timeout = TimeSpan.FromSeconds 60.0) + Assert.True(succeeded result, describe session result) + + // The script's own binding is not this request's. + Assert.Equal([| "requested" |], result.values |> Array.map _.name) + finally + try + File.Delete startup + with _ -> + () + +[] +let ``formats values with the session's own printer`` () = + withInitializedSession (fun session -> + let result = session.Execute "let many = [ 1 .. 200 ]" + Assert.True(succeeded result, describe session result) + + // The session's print length applies, so the text is bounded the way the console's is. + let many = result.values |> Array.find (fun value -> value.name = "many") + Assert.Contains("...", many.value)) + +[] +let ``a value whose ToString throws does not fail the interaction`` () = + withInitializedSession (fun session -> + let result = + session.Execute "type Loud() = override _.ToString() = failwith \"boom\";; let loud = Loud()" + + Assert.True(succeeded result, describe session result) + Assert.Contains(result.values, fun value -> value.name = "loud")) + +[] +let ``keeps bindings across interactions`` () = + withInitializedSession (fun session -> + let bound = session.Execute "let x = 40" + Assert.True(succeeded bound, describe session bound) + + let result = session.Execute "x + 2" + Assert.True(succeeded result, describe session result) + Assert.True(session.WaitForOutput "val it: int = 42", describe session result)) + +[] +let ``evaluates every interaction in a request`` () = + withInitializedSession (fun session -> + let result = session.Execute "let first = 11;; let second = 22;;" + Assert.True(succeeded result, describe session result) + + let next = session.Execute "second" + Assert.True(succeeded next, describe session next) + Assert.True(session.WaitForOutput "val it: int = 22", describe session next)) + +[] +let ``keeps apostrophe-terminated identifiers intact`` () = + withInitializedSession (fun session -> + let result = session.Execute "let value' = 42;; value' + 1" + Assert.True(succeeded result, describe session result) + Assert.True(session.WaitForOutput "val it: int = 43", describe session result)) + +[] +let ``splits interactions the way the lexer does`` () = + withInitializedSession (fun session -> + // A verbatim string ending in a backslash, and `(*)` — the operator, not a comment. Each would + // fool a splitter that only looks for `;;` outside strings and comments. + let result = + session.Execute """let path = @"C:\";; let times = (*);; let after = path.Length + times 2 3""" + + Assert.True(succeeded result, describe session result) + + let next = session.Execute "after" + Assert.True(succeeded next, describe session next) + Assert.True(session.WaitForOutput "val it: int = 9", describe session next)) + +[] +let ``keeps the bindings that ran before a failing interaction`` () = + withInitializedSession (fun session -> + let result = session.Execute "let kept = 1;; let broken: int = \"text\";; let never = 2" + Assert.False(succeeded result, describe session result) + Assert.NotEmpty(errors result) + + let kept = session.Execute "kept" + Assert.True(succeeded kept, describe session kept) + Assert.True(session.WaitForOutput "val it: int = 1", describe session kept) + + // Nothing after the failure ran. + Assert.False(succeeded (session.Execute "never"))) + +[] +let ``reports what the interaction printed`` () = + withInitializedSession (fun session -> + let result = session.Execute "printfn \"hello from the session\"" + Assert.True(succeeded result, describe session result) + Assert.True(session.WaitForOutput "hello from the session", describe session result)) + +[] +let ``evaluates multi-line interactions`` () = + withInitializedSession (fun session -> + let code = String.Join("\n", [ "let add a b ="; " a + b"; ""; "add 20 22" ]) + + let result = session.Execute code + Assert.True(succeeded result, describe session result) + Assert.True(session.WaitForOutput "val it: int = 42", describe session result)) + +[] +let ``carries text that has to survive JSON escaping`` () = + withInitializedSession (fun session -> + // Quotes, backslashes and non-ASCII all have to make the round trip intact, in both the + // request and the output that comes back. + let result = session.Execute "printfn \"%s\" \"quote \\\" backslash \\\\ Ф# ✓\"" + + Assert.True(succeeded result, describe session result) + Assert.True(session.WaitForOutput "quote \" backslash \\ Ф# ✓", describe session result)) + +//------------------------------------------------------------------------- +// Diagnostics +//------------------------------------------------------------------------- + +[] +let ``reports type errors as structured diagnostics`` () = + withInitializedSession (fun session -> + let result = session.Execute "1 + \"text\"" + + Assert.False(succeeded result, describe session result) + + let reported = errors result + Assert.NotEmpty reported + + // FS0001 is the type mismatch error, and it must carry a usable position. + let error = reported[0] + Assert.Equal(1, error.errorNumber) + Assert.True(error.startLine >= 1, $"unexpected start line {error.startLine}") + Assert.False(String.IsNullOrWhiteSpace error.message)) + +[] +let ``reports undefined identifiers`` () = + withInitializedSession (fun session -> + let result = session.Execute "thisNameIsNotDefined" + + Assert.False(succeeded result, describe session result) + + // FS0039: the value or constructor is not defined. + Assert.True(errors result |> Array.exists (fun d -> d.errorNumber = 39), describe session result)) + +[] +let ``warnings do not fail an interaction`` () = + withInitializedSession (fun session -> + // An incomplete pattern match warns, but the interaction still runs. + let result = session.Execute "let f (x: int option) = match x with Some v -> v" + + Assert.True(succeeded result, describe session result) + Assert.NotEmpty(warnings result) + Assert.Empty(errors result)) + +[] +let ``attributes diagnostics to the host's file and line`` () = + withInitializedSession (fun session -> + // A host executing a selection tells the session where that selection came from, so that + // the reported position lands on the user's own source rather than within the submission. + let path = Path.Combine(Path.GetTempPath(), "Library.fs") + let result = session.Execute("1 + \"text\"", sourcePath = path, startLine = 120) + + let reported = errors result + Assert.NotEmpty reported + Assert.Equal(120, reported[0].startLine) + Assert.EndsWith("Library.fs", reported[0].fileName, StringComparison.Ordinal)) + +[] +let ``positions every interaction of a selection against the host's lines`` () = + withInitializedSession (fun session -> + // The line directive covers the whole selection, not just the text before its first `;;`. + let path = Path.Combine(Path.GetTempPath(), "Library.fs") + + let result = + session.Execute("let ok = 1;;\nlet bad: int = \"text\"", sourcePath = path, startLine = 120) + + let reported = errors result + Assert.NotEmpty reported + Assert.Equal(121, reported[0].startLine)) + +[] +let ``reports an escaping exception`` () = + withInitializedSession (fun session -> + // Annotated so that the interaction compiles: a bare `failwith` is generic and would fail + // the value restriction instead of ever running. + let result = session.Execute "(failwith \"boom\": unit)" + + Assert.False(succeeded result, describe session result) + Assert.Empty(errors result) + Assert.Equal(Some "boom", exceptionMessage result)) + +[] +let ``does not report an exception for a compilation failure`` () = + withInitializedSession (fun session -> + // The diagnostics already describe the failure. Reporting the exception fsi raises to stop + // processing would make a host show the same problem twice. + let result = session.Execute "1 + \"text\"" + + Assert.NotEmpty(errors result) + Assert.Equal(None, exceptionMessage result)) + +[] +let ``keeps serving after a failed interaction`` () = + withInitializedSession (fun session -> + Assert.False(succeeded (session.Execute "1 + \"text\"")) + Assert.False(succeeded (session.Execute "(failwith \"boom\": unit)")) + + // A session that stopped responding after an error would make the window useless. + let result = session.Execute "2 * 21" + Assert.True(succeeded result, describe session result) + Assert.True(session.WaitForOutput "val it: int = 42", describe session result)) + +//------------------------------------------------------------------------- +// Files and search paths +//------------------------------------------------------------------------- + +[] +let ``loads a script file`` () = + withInitializedSession (fun session -> + let script = temporaryPath ".fsx" + File.WriteAllText(script, "printfn \"the script ran\"\n") + + try + let loaded = + session.Request(Methods.ExecuteFile, { path = script }) + + Assert.True(succeeded loaded, describe session loaded) + + // The file is loaded, not replayed as anonymous text, so its effects are what prove it + // reached the session. Its definitions land in a module named after the file, which is + // ordinary `#load` behaviour and not something to assert on here. + Assert.True(session.WaitForOutput "the script ran", describe session loaded) + finally + try + File.Delete script + with _ -> + ()) + +[] +let ``loads a script file whose path contains quotes`` () = + if RuntimeInformation.IsOSPlatform OSPlatform.Windows then + () + else + withInitializedSession (fun session -> + let directory = temporaryPath "\"quoted" + Directory.CreateDirectory directory |> ignore + let script = Path.Combine(directory, "script.fsx") + File.WriteAllText(script, "printfn \"quoted path loaded\"\n") + + try + let loaded = session.Request(Methods.ExecuteFile, { path = script }) + Assert.True(succeeded loaded, describe session loaded) + Assert.True(session.WaitForOutput "quoted path loaded", describe session loaded) + finally + try + Directory.Delete(directory, true) + with _ -> + ()) + +[] +let ``setPaths changes the working directory`` () = + withInitializedSession (fun session -> + let directory = temporaryPath "" + Directory.CreateDirectory directory |> ignore + + try + let result = + session.Request( + Methods.SetPaths, + { + includePaths = [| directory |] + workingDirectory = directory + } + ) + + Assert.True(succeeded result, describe session result) + + // The host mirrors this value so that its own reference resolution matches the session. + let expected = + Path.GetFullPath(directory).TrimEnd(Path.DirectorySeparatorChar) |> stripMacPrivatePrefix + + let actual = + Path.GetFullPath(result.workingDirectory).TrimEnd(Path.DirectorySeparatorChar) + |> stripMacPrivatePrefix + + Assert.Equal(expected, actual) + finally + try + Directory.Delete(directory, true) + with _ -> + ()) + +[] +let ``setPaths rejects an unrepresentable path without changing the working directory`` () = + withInitializedSession (fun session -> + let before = session.Execute "1" + let path = temporaryPath "\"quoted" + + let error = + session.RequestExpectingError( + Methods.SetPaths, + { + includePaths = [| path |] + workingDirectory = path + } + ) + + Assert.Equal(Some -32602, error) + Assert.Equal(before.workingDirectory, (session.Execute "2").workingDirectory)) + +[] +let ``setPaths rejects a missing working directory`` () = + withInitializedSession (fun session -> + let error = + session.RequestExpectingError( + Methods.SetPaths, + { + includePaths = [||] + workingDirectory = temporaryPath "" + } + ) + + Assert.Equal(Some -32002, error)) + +[] +let ``setPaths waits its turn behind a running interaction`` () = + withInitializedSession (fun session -> + let directory = temporaryPath "" + Directory.CreateDirectory directory |> ignore + + try + // Warm the session up, so that the interaction below is genuinely running by the time + // the request to move the directory arrives. + let warmUp = session.Execute "1" + Assert.True(succeeded warmUp, describe session warmUp) + + let running = + session.BeginRequest( + Methods.Execute, + FsiServerHarness.ExecuteParams + """ +System.Threading.Thread.Sleep 5000 +printfn "interaction saw [%s]" (System.IO.Directory.GetCurrentDirectory()) +""" + ) + + Thread.Sleep 2000 + + let moved = + session.Request( + Methods.SetPaths, + { + includePaths = [||] + workingDirectory = directory + } + ) + + Assert.True(succeeded moved, describe session moved) + + let result = session.EndRequest(running, TimeSpan.FromSeconds 60.0) + Assert.True(succeeded result, describe session result) + + // The process directory moves on the queue like everything else, so an interaction that + // was already running keeps the directory it started in. + Assert.True( + session.WaitForOutput $"interaction saw [{warmUp.workingDirectory}]", + describe session result + ) + finally + try + Directory.Delete(directory, true) + with _ -> + ()) + +[] +let ``reports the working directory after every interaction`` () = + withInitializedSession (fun session -> + let result = session.Execute "1" + Assert.True(Directory.Exists result.workingDirectory, describe session result)) + +//------------------------------------------------------------------------- +// Interrupting +//------------------------------------------------------------------------- + +[] +let ``interrupts a running interaction`` () = + withInitializedSession (fun session -> + let running = + session.BeginRequest( + Methods.Execute, + FsiServerHarness.ExecuteParams + """ +printfn "interrupt target started" +while true do System.Threading.Thread.Sleep 10 +""" + ) + + Assert.True(session.WaitForOutput "interrupt target started") + + let next = + session.BeginRequest(Methods.Execute, FsiServerHarness.ExecuteParams "40 + 2") + + let interrupts = + Array.init 8 (fun _ -> session.BeginRequest Methods.Interrupt) + + let interruptResults = + interrupts + |> Array.map (fun request -> session.EndRequest(request, TimeSpan.FromSeconds 30.0)) + + Assert.Equal(1, interruptResults |> Array.filter _.interrupted |> Array.length) + + let interrupted = session.EndRequest(running, TimeSpan.FromSeconds 60.0) + Assert.True(interrupted.cancelled, describe session interrupted) + Assert.False(interrupted.success, describe session interrupted) + + let subsequent = session.EndRequest(next, TimeSpan.FromSeconds 60.0) + Assert.True(subsequent.success, describe session subsequent) + Assert.True(session.WaitForOutput "val it: int = 42", describe session subsequent)) + +[] +let ``interrupt is harmless when nothing is running`` () = + withInitializedSession (fun session -> + let result = session.Request Methods.Interrupt + Assert.False result.interrupted) + +//------------------------------------------------------------------------- +// Lifetime +//------------------------------------------------------------------------- + +[] +let ``shutdown ends the session`` () = + withInitializedSession (fun session -> + session.Request Methods.Shutdown |> ignore + + Assert.True(session.WaitForExit 30_000, "the session did not exit after shutdown")) + +[] +[] +[] +let ``the session exits when the control channel closes`` corrupt = + use session = new FsiServerHarness() + session.Initialize() |> ignore + + session.CloseControlChannel corrupt + Assert.True(session.WaitForExit 30_000, "the session did not exit after the control channel closed") + Assert.Equal(corrupt, session.ExitCode <> 0) + + if corrupt then + Assert.Contains("F# Interactive server terminated:", session.StandardError) + +[] +let ``the session exits when its host process exits`` () = + // A second session stands in for the editor: it is a real, live process to attach to, and + // killing it must bring down the session that named it as its host. + use host = new FsiServerHarness() + use session = new FsiServerHarness(clientProcessId = host.ProcessId) + + session.Initialize() |> ignore + Assert.False session.HasExited + + (host :> IDisposable).Dispose() + + Assert.True(session.WaitForExit 30_000, "the session outlived its host process") + +//------------------------------------------------------------------------- +// What ships +//------------------------------------------------------------------------- + +/// The `Microsoft.FSharp.Compiler` package is what the .NET SDK lays out as `dotnet fsi`: a file its +/// manifest does not list is a file no installed SDK has. +module private CompilerPackage = + + let private repositoryRoot () = + let rec search (directory: DirectoryInfo) = + match directory with + | null -> failwith "the repository root was not found above the test output" + | directory -> + if File.Exists(Path.Combine(directory.FullName, "src", "Microsoft.FSharp.Compiler", "Microsoft.FSharp.Compiler.nuspec")) then + directory.FullName + else + search directory.Parent + + search (DirectoryInfo AppContext.BaseDirectory) + + let private projectDirectory () = + Path.Combine(repositoryRoot (), "src", "Microsoft.FSharp.Compiler") + + let private localName (name: string) (element: XElement) = element.Name.LocalName = name + + /// The assemblies the project file adds next to fsi.dll for the JSON-RPC server. + let serverAssemblies () = + XDocument.Load(Path.Combine(projectDirectory (), "Microsoft.FSharp.Compiler.fsproj")).Descendants() + |> Seq.filter (localName "FsiJsonRpcServerAssemblies") + |> Seq.collect (fun element -> element.Value.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries)) + |> Seq.toArray + + /// The assemblies the manifest puts into the package's lib folder beside fsi.dll — by name, since + /// fsi's own output holds the same builds of them that the pack step picks up. + let libraryAssemblies () = + XDocument.Load(Path.Combine(projectDirectory (), "Microsoft.FSharp.Compiler.nuspec")).Descendants() + |> Seq.filter (localName "file") + |> Seq.choose (fun element -> + let source = element.Attribute(XName.Get "src").Value + let target = element.Attribute(XName.Get "target").Value + + // Resource satellites are globbed. The compiler driver and the MSBuild tasks share the + // folder but are not fsi's to load, and fsi's own build does not produce them. + // The nuspec spells paths with backslashes, which Path.GetFileName only splits on Windows. + let name = source.Substring(source.LastIndexOf '\\' + 1) + + if + target.StartsWith("lib", StringComparison.Ordinal) + && source.IndexOf("**", StringComparison.Ordinal) < 0 + && name.EndsWith(".dll", StringComparison.Ordinal) + && name <> "fsc.dll" + && name <> "FSharp.Build.dll" + then + Some name + else + None) + |> Seq.toArray + + /// Assemblies the SDK provides beside fsi from its own build, so the package leaves them out. + let providedBySdk (fileName: string) = + fileName.StartsWith("Microsoft.Build.", StringComparison.Ordinal) + || fileName.StartsWith("Microsoft.NET.StringTools", StringComparison.Ordinal) + || fileName.StartsWith("System.", StringComparison.Ordinal) + +[] +let ``the compiler package lists every assembly the server loads`` () = + // Whatever fsi's build restored beyond what this repository builds and what the SDK provides is + // there for the server, and has to be in the package or the shipped fsi cannot start the server. + let restoredForServer = + Directory.EnumerateFiles(fsiOutputDirectory (), "*.dll") + |> Seq.map Path.GetFileName + |> Seq.filter (fun name -> + not (name.StartsWith("FSharp.", StringComparison.Ordinal)) + && name <> "fsi.dll" + && not (CompilerPackage.providedBySdk name)) + |> Seq.sort + |> Seq.toArray + + Assert.Equal(restoredForServer, CompilerPackage.serverAssemblies () |> Array.sort) + +[] +let ``the shipped files are enough to start the server`` () = + // Stage exactly what an SDK has beside fsi.dll — the package's lib folder plus the assemblies the + // SDK adds from its own build — and start a session from there. + let staged = temporaryPath "" + Directory.CreateDirectory staged |> ignore + + let fsiDirectory = fsiOutputDirectory () + + let stage (fileName: string) = + File.Copy(Path.Combine(fsiDirectory, fileName), Path.Combine(staged, fileName), true) + + try + CompilerPackage.libraryAssemblies () |> Array.iter stage + CompilerPackage.serverAssemblies () |> Array.iter stage + + Directory.EnumerateFiles(fsiDirectory, "*.dll") + |> Seq.map Path.GetFileName + |> Seq.filter CompilerPackage.providedBySdk + |> Seq.iter stage + + // No fsi.deps.json: the SDK generates its own, and without one the host probes the directory, + // so the files themselves are what is under test. + stage "fsi.runtimeconfig.json" + + use session = new FsiServerHarness(fsiDirectory = staged) + session.Initialize() |> ignore + + let result = session.Execute "1 + 1" + Assert.True(succeeded result, describe session result) + finally + try + Directory.Delete(staged, true) + with _ -> + () diff --git a/tests/FSharp.Compiler.Interactive.Server.Tests/FsiServerHarness.fs b/tests/FSharp.Compiler.Interactive.Server.Tests/FsiServerHarness.fs new file mode 100644 index 00000000000..5763454c980 --- /dev/null +++ b/tests/FSharp.Compiler.Interactive.Server.Tests/FsiServerHarness.fs @@ -0,0 +1,362 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Drives a real F# Interactive process in its JSON-RPC server mode, the way an editor would. +/// +/// The tests exercise the shipped protocol end to end rather than an in-process stand-in, because +/// the parts most likely to break are the ones that only exist across a process boundary: the +/// handshake, the lifetime of the session, and the interaction between the control channel and the +/// output streams. The client here is StreamJsonRpc, the same library the window uses. +module FSharp.Compiler.Interactive.Server.Tests.FsiServerHarness + +open System +open System.Diagnostics +open System.IO +open System.IO.Pipes +open System.Runtime.InteropServices +open System.Text +open System.Threading +open System.Threading.Tasks + +open StreamJsonRpc + +open FSharp.Compiler.Interactive.Protocol + +/// How long to wait for the session to answer a request. Generous, because the first interaction +/// of a session pays for the type checker warming up. +let private defaultTimeout = TimeSpan.FromSeconds 120.0 + +/// Prefer the .NET host this repository provisions, so that the session runs on the same runtime +/// as the rest of the build. +let private locateDotnetHost () = + let executable = + if RuntimeInformation.IsOSPlatform OSPlatform.Windows then + "dotnet.exe" + else + "dotnet" + + let rec search (directory: DirectoryInfo) = + match directory with + | null -> executable + | directory -> + let candidate = Path.Combine(directory.FullName, ".dotnet", executable) + + if File.Exists candidate then + candidate + else + search directory.Parent + + search (DirectoryInfo(AppContext.BaseDirectory)) + +/// Where this build put its outputs: `/bin`, and the configuration and framework this +/// test assembly was built for, which fsi shares. +let buildOutput () = + let baseDirectory = + DirectoryInfo(AppContext.BaseDirectory.TrimEnd(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar)) + + struct {| + BinDirectory = baseDirectory.Parent.Parent.Parent.FullName + Configuration = baseDirectory.Parent.Name + Framework = baseDirectory.Name + |} + +/// The fsi built by this repository: a sibling of the test output at +/// `/bin/fsi//`. +let fsiOutputDirectory () = + let output = buildOutput () + Path.Combine(output.BinDirectory, "fsi", output.Configuration, output.Framework) + +/// fsi is a managed dll run under the dotnet host — the same way `InteractiveHost.fs` launches it +/// for the window. +let private locateFsi (fsiDirectory: string) = + let fsi = Path.Combine(fsiDirectory, "fsi.dll") + + if not (File.Exists fsi) then + failwith $"Could not find the fsi under test at '{fsi}'. Build src/fsi first." + + locateDotnetHost (), [ fsi ] + +/// A running session, plus everything needed to talk to it and to explain a failure. +/// +/// `serverSwitches` spells the switch that turns the server on, for tests of the forms fsi accepts; +/// `fsiDirectory` points at an fsi other than the build's own, for tests of what ships; +/// `clientProcessId` names the process whose exit ends the session, this one by default. +[] +type FsiServerHarness + ( + ?extraArguments: string list, + ?workingDirectory: string, + ?serverSwitches: string -> string list, + ?fsiDirectory: string, + ?clientProcessId: int + ) = + // On Unix the pipe is a socket under $TMPDIR, and macOS caps socket paths at 104 characters. + let pipeName = $"fsi{Guid.NewGuid():N}".Substring(0, 15) + let standardOutput = StringBuilder() + let standardError = StringBuilder() + let outputLock = obj () + + /// .NET Framework has no `ProcessStartInfo.ArgumentList`, so the command line is built by hand + /// on every target — one fewer thing that differs between fsi's two hosting flavors. + let quoteIfNeeded (argument: string) = + if + argument.IndexOf(" ", StringComparison.Ordinal) >= 0 + && not (argument.StartsWith("\"", StringComparison.Ordinal)) + then + $"\"{argument}\"" + else + argument + + let startInfo = + let fsiHost, leadingArguments = + locateFsi (defaultArg fsiDirectory (fsiOutputDirectory ())) + + let serverSwitches = + defaultArg serverSwitches (fun pipeName -> [ $"--fsi-server-jsonrpc:{pipeName}" ]) + + let arguments = + [ + yield! leadingArguments + "--nologo" + yield! serverSwitches pipeName + $"--fsi-server-client-pid:{defaultArg clientProcessId (Process.GetCurrentProcess().Id)}" + yield! defaultArg extraArguments [] + ] + + ProcessStartInfo( + FileName = fsiHost, + Arguments = String.Join(" ", arguments |> List.map quoteIfNeeded), + UseShellExecute = false, + CreateNoWindow = true, + RedirectStandardInput = true, + RedirectStandardOutput = true, + RedirectStandardError = true, + StandardOutputEncoding = Encoding.UTF8, + StandardErrorEncoding = Encoding.UTF8, + WorkingDirectory = defaultArg workingDirectory (Path.GetTempPath()) + ) + + let session = new Process(StartInfo = startInfo) + + do + session.OutputDataReceived.Add(fun e -> + match e.Data with + | null -> () + | line -> lock outputLock (fun () -> standardOutput.AppendLine line |> ignore)) + + session.ErrorDataReceived.Add(fun e -> + match e.Data with + | null -> () + | line -> lock outputLock (fun () -> standardError.AppendLine line |> ignore)) + + session.Start() |> ignore + session.BeginOutputReadLine() + session.BeginErrorReadLine() + + let pipe = + // The server admits its own user only, and a client that says so too is turned away from + // a pipe somebody else opened under the same name. + let pipe = + new NamedPipeClientStream( + ".", + pipeName, + PipeDirection.InOut, + PipeOptions.Asynchronous ||| PipeOptions.CurrentUserOnly + ) + + try + pipe.Connect 60_000 + with e -> + let detail = + if session.HasExited then + $"The session exited with code {session.ExitCode}." + else + "The session is still running." + + let error = lock outputLock (fun () -> standardError.ToString()) + failwith $"Could not connect to the session on pipe '{pipeName}'. {detail}\n{e.Message}\n-- stderr --\n{error}" + + pipe + + let rpc = + let rpc = new JsonRpc(new HeaderDelimitedMessageHandler(pipe, new JsonMessageFormatter())) + rpc.StartListening() + rpc + + /// On failure, fold in what the session itself printed: a protocol error alone rarely says what + /// the session actually did. + let await (work: Task<'T>) (timeout: TimeSpan) = + try + if not (work.Wait timeout) then + failwith "The session did not answer in time." + + work.Result + with e -> + let output, error = lock outputLock (fun () -> standardOutput.ToString(), standardError.ToString()) + raise (Exception($"{e.Message}\n-- stdout --\n{output}-- stderr --\n{error}", e)) + + member _.StandardOutput = lock outputLock (fun () -> standardOutput.ToString()) + + member _.StandardError = lock outputLock (fun () -> standardError.ToString()) + + member _.HasExited = session.HasExited + + member _.ExitCode = session.ExitCode + + member _.ProcessId = session.Id + + member _.WaitForExit(milliseconds: int) = session.WaitForExit milliseconds + + member _.CloseControlChannel(corrupt: bool) = + if corrupt then + let bytes = Encoding.ASCII.GetBytes "Content-Length: invalid\r\n\r\n" + + // The session hangs up on the malformed header, and the client's own JsonRpc, listening on + // the same pipe, disposes it in turn, possibly before this write or flush is done. + try + pipe.Write(bytes, 0, bytes.Length) + pipe.Flush() + with + | :? ObjectDisposedException + | :? IOException -> () + else + rpc.Dispose() + + pipe.Dispose() + + /// Wait until the session's own output contains the given text, which is how a test observes + /// what a script printed rather than what the protocol returned. + member this.WaitForOutput(text: string, ?timeout: TimeSpan) = + let deadline = DateTime.UtcNow + defaultArg timeout (TimeSpan.FromSeconds 30.0) + + let rec wait () = + if this.StandardOutput.Contains text then true + elif DateTime.UtcNow > deadline then false + else + Thread.Sleep 50 + wait () + + wait () + + /// Send a request whose parameters are a single object, as every method of this protocol but + /// the argument-less ones expects. + member _.BeginRequest<'T>(method: string, parameters: obj) : Task<'T> = + rpc.InvokeWithParameterObjectAsync<'T>(method, parameters) + + member _.BeginRequest<'T>(method: string) : Task<'T> = rpc.InvokeAsync<'T>(method) + + member _.EndRequest(work: Task<'T>, ?timeout: TimeSpan) = + await work (defaultArg timeout defaultTimeout) + + member this.Request<'T>(method: string, parameters: obj, ?timeout: TimeSpan) : 'T = + await (this.BeginRequest<'T>(method, parameters)) (defaultArg timeout defaultTimeout) + + member this.Request<'T>(method: string, ?timeout: TimeSpan) : 'T = + await (this.BeginRequest<'T> method) (defaultArg timeout defaultTimeout) + + /// Issue a request expected to fail, returning the JSON-RPC error code the session reported. + /// + /// An unknown method surfaces as its own exception type rather than as a reported error, so it + /// is mapped back to the code the specification gives it. + member this.RequestExpectingError(method: string, parameters: obj) = + // `await` folds diagnostic text into a wrapping exception on any failure (see above), so + // the type this classifies on is found by descending through causes, not just one level. + let rec classify (e: exn) = + match e with + | :? RemoteInvocationException as remote -> Some remote.ErrorCode + | :? RemoteMethodNotFoundException as remote -> Some(int remote.ErrorCode) + | _ -> + match e.InnerException with + | null -> None + | inner -> classify inner + + try + this.Request(method, parameters) |> ignore + None + with e -> + match classify e with + | Some code -> Some code + | None -> raise e + + /// Perform the handshake every host makes before submitting anything. + member this.Initialize() = + this.Request Methods.Initialize + + static member ExecuteParams(code: string, ?sourcePath: string, ?startLine: int) : ExecuteRequest = + { + code = code + sourcePath = Option.toObj sourcePath + startLine = + match startLine with + | Some line -> Nullable line + | None -> Nullable() + } + + /// Submit one interaction and return the structured result. + member this.Execute(code: string, ?sourcePath: string, ?startLine: int, ?timeout: TimeSpan) = + this.Request( + Methods.Execute, + FsiServerHarness.ExecuteParams(code, ?sourcePath = sourcePath, ?startLine = startLine), + ?timeout = timeout + ) + + interface IDisposable with + member _.Dispose() = + try + rpc.Dispose() + with _ -> + () + + try + pipe.Dispose() + with _ -> + () + + try + if not session.HasExited then + session.Kill() + + session.WaitForExit 10_000 |> ignore + with _ -> + () + + session.Dispose() + +//------------------------------------------------------------------------- +// Reading the pieces of a result +//------------------------------------------------------------------------- + +let diagnostics (result: ExecutionResult) = + match result.diagnostics with + | null -> [||] + | items -> items + +let errors result = + diagnostics result |> Array.filter (fun d -> d.severity = "error") + +let warnings result = + diagnostics result |> Array.filter (fun d -> d.severity = "warning") + +let succeeded (result: ExecutionResult) = result.success + +let exceptionMessage (result: ExecutionResult) = + match box result.``exception`` with + | null -> None + | _ -> Some result.``exception``.message + +/// Render a result for a failure message. +let describeResult (result: ExecutionResult) = + let diagnosticText = + diagnostics result + |> Array.map (fun d -> + $"{d.fileName}({d.startLine},{d.startColumn}): {d.severity} FS{d.errorNumber:D4}: {d.message}") + |> String.concat "\n " + + let exceptionText = + match exceptionMessage result with + | Some message -> message + | None -> "" + + let outcome = + $"success={result.success} cancelled={result.cancelled} workingDirectory={result.workingDirectory}" + + $"{outcome} exception={exceptionText}\n {diagnosticText}" diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index 53cacc1a885..a31be5a83f5 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -5061,8 +5061,12 @@ FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiBoundValue] TryFindBoundValue(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiValue] EvalExpression(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiValue] EvalExpression(System.String, System.String) +FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[System.Int32] JsonRpcClientProcessId FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[System.Int32] LCID +FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[System.Int32] get_JsonRpcClientProcessId() FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[System.Int32] get_LCID() +FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[System.String] JsonRpcServerPipeName +FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_JsonRpcServerPipeName() FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Collections.Generic.IEnumerable`1[System.String] GetCompletions(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Reflection.Assembly[] DynamicAssemblies FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Reflection.Assembly[] get_DynamicAssemblies() diff --git a/tests/FSharp.Compiler.Service.Tests/FsiTests.fs b/tests/FSharp.Compiler.Service.Tests/FsiTests.fs index 152c46867a1..897573f124e 100644 --- a/tests/FSharp.Compiler.Service.Tests/FsiTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/FsiTests.fs @@ -703,3 +703,29 @@ module FsiTests = let byName name = fsiSession.GetBoundValues() |> List.find (fun v -> v.Name = name) Assert.shouldBe (box "haho") ((byName "r1").Value.ReflectionValue) Assert.shouldBe (box "hoha") ((byName "r2").Value.ReflectionValue) + + [] + [] + [] + [] + [] + [] + let ``EvalInteractionNonThrowing keeps the last value a multi-interaction text produced`` (code: string) = + use fsiSession = createFsiSession false + + match fsiSession.EvalInteractionNonThrowing code with + | Choice1Of2(Some value), [||] -> Assert.shouldBe (box 42) value.ReflectionValue + | result, diagnostics -> failwith $"expected the value 42, got %A{result} with %A{diagnostics}" + + [] + let ``EvalInteractionNonThrowing evaluates every interaction in the text`` () = + use fsiSession = createFsiSession false + + match fsiSession.EvalInteractionNonThrowing "let a = 1;; let b = a + 1;; let c = b + 1" with + | Choice1Of2 _, [||] -> () + | result, diagnostics -> failwith $"expected success, got %A{result} with %A{diagnostics}" + + let byName name = + fsiSession.GetBoundValues() |> List.find (fun v -> v.Name = name) + + Assert.shouldBe (box 3) (byName "c").Value.ReflectionValue diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index b226fb2e75f..29dfa609eff 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -1021,6 +1021,10 @@ Updated automatically, please check diffs in your pull request, changes must be use errStream = new StringWriter() use script = new FSharpScript(additionalArgs = Array.append [| "--noninteractive" |] options, quiet = false, outWriter = outStream, errWriter = errStream) script.ApplyExitShadowing() + // Scripts written for piped stdin end with `#q;;`, which exits the process: drop that last + // line instead of letting it end the test host. Only the last one, so that text which merely + // contains it, in a string say, is left as written. + let source = System.Text.RegularExpressions.Regex.Replace(source, @"(? Seq.map _.Message)