diff --git a/docs/content/interactive.fsx b/docs/content/interactive.fsx index 14e66ba5b2..a26489d3a0 100644 --- a/docs/content/interactive.fsx +++ b/docs/content/interactive.fsx @@ -31,6 +31,7 @@ First, we need to reference the libraries that contain F# interactive service: *) #r "FSharp.Compiler.Service.dll" +open Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.FSharp.Compiler.Interactive.Shell (** @@ -81,7 +82,7 @@ and other top-level statements. let evalInteraction text = fsiSession.EvalInteraction(text) (** -The two functions take string as an argument and evaluate (or execute) it as F# code. The code +The two functions each take a string as an argument and evaluate (or execute) it as F# code. The code passed to them does not require `;;` at the end. Just enter the code that you want to execute: *) evalExpression "42+1" @@ -97,6 +98,49 @@ let evalScript scriptPath = File.WriteAllText("sample.fsx", "let twenty = 10 + 10") evalScript "sample.fsx" +(** +Catching errors +------------------ + +``EvalExpression``, ``EvalInteraction`` and ``EvalScript`` are awkward if the +code has type checking warnings or errors, or if evaluation fails with an exception. +In these cases you can use ``EvalExpressionNonThrowing``, ``EvalInteractionNonThrowing`` +and ``EvalScriptNonThrowing``. These return a tuple of a result and an array of ``FSharpErrorInfo`` values. +These represent the errors and warnings. The result part is a ``Choice<_,_>`` between an actual +result and an exception. + +The result part of ``EvalExpression`` and ``EvalExpressionNonThrowing`` is an optional ``FSharpValue``. +If that value is not present then it just indicates that the expression didn't have a tangible +result that could be represented as a .NET object. This siutation shouldn't actually +occur for any normal input expressions, and only for primitives used in libraries. +*) + +File.WriteAllText("sample.fsx", "let twenty = 'a' + 10.0") +let result, warnings = fsiSession.EvalScriptNonThrowing "sample.fsx" + +// show the result +match result with +| Choice1Of2 () -> printfn "checked and executed ok" +| Choice2Of2 exn -> printfn "execution exception: %s" exn.Message + +(** +Gives: + + execution exception: Operation could not be completed due to earlier error +*) + +// show the errors and warnings +for w in warnings do + printfn "Warning %s at %d,%d" w.Message w.StartLineAlternate w.StartColumn + +(** +Gives: + + Warning The type 'float' does not match the type 'char' at 1,19 + Warning The type 'float' does not match the type 'char' at 1,17 +*) + + (** Type checking in the evaluation context ------------------ @@ -129,8 +173,8 @@ You can also request declaration list information, tooltip text and symbol resol *) open Microsoft.FSharp.Compiler -let identToken = Parser.tagOfToken(Parser.token.IDENT("")) -checkResults.GetToolTipTextAlternate(1, 2, "xxx + xx", ["xxx"], identToken) // a tooltip +// get a tooltip +checkResults.GetToolTipTextAlternate(1, 2, "xxx + xx", ["xxx"], FSharpTokenTag.IDENT) checkResults.GetSymbolUseAtLocation(1, 2, "xxx + xx", ["xxx"]) // symbol xxx diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index ae942ecdf3..7d386c0b7a 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -38,7 +38,7 @@ let rec findOriginalException err = /// Thrown when we stop processing the F# Interactive entry or #load. -exception StopProcessing of string +exception StopProcessing of exn option (* common error kinds *) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 38ae0bbe1b..cd83898489 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -2099,7 +2099,7 @@ type InProcCompiler() = let exitCode = ref 0 let exiter = { new Exiter with - member this.Exit n = exitCode := n; raise (StopProcessing "") } + member this.Exit n = exitCode := n; raise (StopProcessing None) } try typecheckAndCompile(argv, false, true, exiter, loggerProvider, None, None) with diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 4087623c8f..e37bce2eb5 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -443,9 +443,8 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd errors <- errors + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) - raise (StopProcessing (sprintf "%A" err)) + raise (StopProcessing None) - member x.CheckForErrors() = (errors > 0) member x.ResetErrorCount() = (errors <- 0) override x.WarnSinkImpl(err) = @@ -461,12 +460,14 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd override x.ErrorSinkImpl err = x.ErrorSinkHelper err override x.ErrorCount = errors +type ErrorLogger with + member x.CheckForErrors() = (x.ErrorCount > 0) /// A helper function to check if its time to abort - member x.AbortOnError() = - if errors > 0 then + member x.AbortOnError(fsiConsoleOutput:FsiConsoleOutput) = + if x.ErrorCount > 0 then fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.stoppedDueToError()) fsiConsoleOutput.Error.Flush() - raise (StopProcessing "") + raise (StopProcessing None) /// Get the directory name from a string, with some defaults if it doesn't have one let internal directoryName (s:string) = @@ -820,7 +821,7 @@ type internal FsiInteractionStepStatus = | CtrlC | EndOfFile | Completed of option - | CompletedWithReportedError of exn + | CompletedWithReportedError of exn [] [] @@ -852,7 +853,6 @@ type internal FsiDynamicCompiler timeReporter : FsiTimeReporter, tcConfigB, tcLockObject : obj, - errorLogger: ErrorLoggerThatStopsOnFirstError, outWriter: TextWriter, tcImports: TcImports, tcGlobals: TcGlobals, @@ -890,7 +890,7 @@ type internal FsiDynamicCompiler (let man = mainModule.ManifestOfAssembly Some { man with CustomAttrs = mkILCustomAttrs codegenResults.ilAssemAttrs }); } - let ProcessInputs(istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent) = + let ProcessInputs(errorLogger: ErrorLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent) = let optEnv = istate.optEnv let emEnv = istate.emEnv let tcState = istate.tcState @@ -911,17 +911,17 @@ type internal FsiDynamicCompiler fprintfn fsiConsoleOutput.Out "%+A" input #endif - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); let importMap = tcImports.GetImportMap() // optimize: note we collect the incremental optimization environment let optimizedImpls, _optData, optEnv = ApplyAllOptimizations (tcConfig, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), outfile, importMap, isIncrementalFragment, optEnv, tcState.Ccu, declaredImpls) - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); let fragName = textOfLid prefixPath let codegenResults = GenerateIlxCode (IlReflectBackend, isInteractiveItExpr, runningOnMono, tcConfig, topCustomAttrs, optimizedImpls, fragName, true, ilxGenerator) - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); // Each input is like a small separately compiled extension to a single source file. // The incremental extension to the environment is dictated by the "signature" of the values as they come out @@ -930,23 +930,23 @@ type internal FsiDynamicCompiler ilxGenerator.AddIncrementalLocalAssemblyFragment (isIncrementalFragment, fragName, declaredImpls) ReportTime tcConfig "TAST -> ILX"; - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); ReportTime tcConfig "Linking"; let ilxMainModule = CreateModuleFragment (tcConfigB, assemblyName, codegenResults) - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); ReportTime tcConfig "ILX -> IL (Unions)"; let ilxMainModule = EraseUnions.ConvModule ilGlobals ilxMainModule ReportTime tcConfig "ILX -> IL (Funcs)"; let ilxMainModule = EraseClosures.ConvModule ilGlobals ilxMainModule - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); ReportTime tcConfig "Assembly refs Normalised"; let mainmod3 = Morphs.morphILScopeRefsInILModuleMemoized ilGlobals (NormalizeAssemblyRefs tcImports) ilxMainModule - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); #if DEBUG if fsiOptions.ShowILCode then @@ -960,7 +960,7 @@ type internal FsiDynamicCompiler ReportTime tcConfig "Reflection.Emit"; let emEnv,execs = ILRuntimeWriter.emitModuleFragment(ilGlobals, emEnv, assemblyBuilder, moduleBuilder, mainmod3, generateDebugInfo, resolvePath) - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); // Explicitly register the resources with the QuotationPickler module // We would save them as resources into the dynamic assembly but there is missing @@ -983,13 +983,17 @@ type internal FsiDynamicCompiler execs |> List.iter (fun exec -> match exec() with | Some err -> - fprintfn fsiConsoleOutput.Error "%s" (err.ToString()) - errorLogger.SetError() - errorLogger.AbortOnError() + match errorLogger with + | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> + fprintfn fsiConsoleOutput.Error "%s" (err.ToString()) + errorLogger.SetError() + errorLogger.AbortOnError(fsiConsoleOutput) + | _ -> + raise (StopProcessing (Some err)) | None -> ())) ; - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); // Echo the decls (reach inside wrapping) // This code occurs AFTER the execution of the declarations. @@ -1035,23 +1039,23 @@ type internal FsiDynamicCompiler member __.DynamicAssemblyName = assemblyName member __.DynamicAssembly = (assemblyBuilder :> Assembly) - member __.EvalParsedSourceFiles (istate, inputs) = + member __.EvalParsedSourceFiles (errorLogger, istate, inputs) = let i = nextFragmentId() let prefix = mkFragmentPath i // Ensure the path includes the qualifying name let inputs = inputs |> List.map (PrependPathToInput prefix) - let istate,_,_ = ProcessInputs (istate, inputs, true, false, false, prefix) + let istate,_,_ = ProcessInputs (errorLogger, istate, inputs, true, false, false, prefix) istate /// Evaluate the given definitions and produce a new interactive state. - member __.EvalParsedDefinitions (istate, showTypes, isInteractiveItExpr, defs: SynModuleDecls) = + member __.EvalParsedDefinitions (errorLogger: ErrorLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecls) = let filename = Lexhelp.stdinMockFilename let i = nextFragmentId() let prefix = mkFragmentPath i let prefixPath = pathOfLid prefix let impl = SynModuleOrNamespace(prefix,(* isModule: *) true,defs,PreXmlDoc.Empty,[],None,rangeStdin) let input = ParsedInput.ImplFile(ParsedImplFileInput(filename,true, ComputeQualifiedNameOfFileFromUniquePath (rangeStdin,prefixPath),[],[],[impl],true (* isLastCompiland *) )) - let istate,tcEnvAtEndOfLastInput,declaredImpls = ProcessInputs (istate, [input], showTypes, true, isInteractiveItExpr, prefix) + let istate,tcEnvAtEndOfLastInput,declaredImpls = ProcessInputs (errorLogger, istate, [input], showTypes, true, isInteractiveItExpr, prefix) let tcState = istate.tcState let newState = { istate with tcState = tcState.NextStateAfterIncrementalFragment(tcEnvAtEndOfLastInput) } @@ -1095,7 +1099,7 @@ type internal FsiDynamicCompiler /// Evaluate the given expression and produce a new interactive state. - member fsiDynamicCompiler.EvalParsedExpression (istate, expr: SynExpr) = + member fsiDynamicCompiler.EvalParsedExpression (errorLogger: ErrorLogger, istate, expr: SynExpr) = let tcConfig = TcConfig.Create (tcConfigB, validate=false) let itName = "it" @@ -1103,7 +1107,7 @@ type internal FsiDynamicCompiler let defs = fsiDynamicCompiler.BuildItBinding expr // Evaluate the overall definitions. - let istate = fsiDynamicCompiler.EvalParsedDefinitions (istate, false, true, defs) + let istate = fsiDynamicCompiler.EvalParsedDefinitions (errorLogger, istate, false, true, defs) // Snarf the type for 'it' via the binding match istate.tcState.TcEnvFromImpls.NameEnv.FindUnqualifiedItem itName with | NameResolution.Item.Value vref -> @@ -1183,7 +1187,7 @@ type internal FsiDynamicCompiler (Path.GetDirectoryName sourceFile) istate) - member fsiDynamicCompiler.EvalSourceFiles(istate, m, sourceFiles, lexResourceManager) = + member fsiDynamicCompiler.EvalSourceFiles(istate, m, sourceFiles, lexResourceManager, errorLogger: ErrorLogger) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) match sourceFiles with | [] -> istate @@ -1216,11 +1220,11 @@ type internal FsiDynamicCompiler filename, parsedInput) |> List.unzip - errorLogger.AbortOnError(); + errorLogger.AbortOnError(fsiConsoleOutput); if inputs |> List.exists isNone then failwith "parse error"; let inputs = List.map Option.get inputs let istate = List.fold2 fsiDynamicCompiler.ProcessMetaCommandsFromInputAsInteractiveCommands istate sourceFiles inputs - fsiDynamicCompiler.EvalParsedSourceFiles (istate, inputs) + fsiDynamicCompiler.EvalParsedSourceFiles (errorLogger, istate, inputs) member __.GetInitialInteractiveState () = @@ -1575,8 +1579,7 @@ type internal FsiStdinLexerProvider fsiConsoleInput : FsiConsoleInput, fsiConsoleOutput : FsiConsoleOutput, fsiOptions : FsiCommandLineOptions, - lexResourceManager : LexResourceManager, - errorLogger) = + lexResourceManager : LexResourceManager) = // #light is the default for FSI let interactiveInputLightSyntaxStatus = @@ -1613,7 +1616,7 @@ type internal FsiStdinLexerProvider else str - let CreateLexerForLexBuffer (sourceFileName, lexbuf) = + let CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) = Lexhelp.resetLexbufPos sourceFileName lexbuf let skip = true // don't report whitespace from lexer @@ -1624,7 +1627,7 @@ type internal FsiStdinLexerProvider // Create a new lexer to read stdin - member __.CreateStdinLexer () = + member __.CreateStdinLexer (errorLogger) = let lexbuf = match fsiConsoleInput.TryGetConsole() with | Some console when fsiOptions.EnableConsoleKeyProcessing && not fsiOptions.IsInteractiveServer -> @@ -1636,21 +1639,21 @@ type internal FsiStdinLexerProvider LexbufFromLineReader fsiStdinSyphon (fun () -> fsiConsoleInput.In.ReadLine() |> removeZeroCharsFromString) fsiStdinSyphon.Reset() - CreateLexerForLexBuffer (Lexhelp.stdinMockFilename, lexbuf) + CreateLexerForLexBuffer (Lexhelp.stdinMockFilename, lexbuf, errorLogger) // Create a new lexer to read an "included" script file - member __.CreateIncludedScriptLexer sourceFileName = + member __.CreateIncludedScriptLexer (sourceFileName, errorLogger) = let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(sourceFileName,tcConfigB.inputCodePage,(*retryLocked*)false) - CreateLexerForLexBuffer (sourceFileName, lexbuf) + CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) // Create a new lexer to read a string - member this.CreateStringLexer (sourceFileName, source) = + member this.CreateStringLexer (sourceFileName, source, errorLogger) = let lexbuf = UnicodeLexing.StringAsLexbuf(source) - CreateLexerForLexBuffer (sourceFileName, lexbuf) + CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) member __.ConsoleInput = fsiConsoleInput - member __.CreateBufferLexer (sourceFileName, lexbuf) = CreateLexerForLexBuffer (sourceFileName, lexbuf) + member __.CreateBufferLexer (sourceFileName, lexbuf, errorLogger) = CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) //---------------------------------------------------------------------------- @@ -1661,7 +1664,6 @@ type internal FsiStdinLexerProvider type internal FsiInteractionProcessor (fsi: FsiEvaluationSessionHostConfig, tcConfigB, - errorLogger : ErrorLoggerThatStopsOnFirstError, fsiOptions: FsiCommandLineOptions, fsiDynamicCompiler: FsiDynamicCompiler, fsiConsolePrompt : FsiConsolePrompt, @@ -1678,7 +1680,7 @@ type internal FsiInteractionProcessor let setCurrState s = currState <- s; event.Trigger() //let mutable queueAgent = None - let runCodeOnEventLoop f istate = + let runCodeOnEventLoop errorLogger f istate = try fsi.EventLoopInvoke (fun () -> // FSI error logging on switched to thread @@ -1688,14 +1690,17 @@ type internal FsiInteractionProcessor with _ -> (istate,Completed None) - let InteractiveCatch (f:_ -> _ * FsiInteractionStepStatus) istate = + let InteractiveCatch (errorLogger: ErrorLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = try // reset error count - errorLogger.ResetErrorCount() + match errorLogger with + | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() + | _ -> () + f istate with e -> stopProcessingRecovery e range0 - istate,CompletedWithReportedError(e) + istate,CompletedWithReportedError e let rangeStdin = rangeN Lexhelp.stdinMockFilename 0 @@ -1737,18 +1742,18 @@ type internal FsiInteractionProcessor None /// Execute a single parsed interaction. Called on the GUI/execute/main thread. - let ExecInteraction (tcConfig:TcConfig, istate, action:ParsedFsiInteraction) = - istate |> InteractiveCatch (fun istate -> + let ExecInteraction (tcConfig:TcConfig, istate, action:ParsedFsiInteraction, errorLogger: ErrorLogger) = + istate |> InteractiveCatch errorLogger (fun istate -> match action with | IDefns ([ ],_) -> istate,Completed None | IDefns ([ SynModuleDecl.DoExpr(_,expr,_)],_) -> - fsiDynamicCompiler.EvalParsedExpression(istate, expr) + fsiDynamicCompiler.EvalParsedExpression(errorLogger, istate, expr) | IDefns (defs,_) -> - fsiDynamicCompiler.EvalParsedDefinitions (istate, true, false, defs),Completed None + fsiDynamicCompiler.EvalParsedDefinitions (errorLogger, istate, true, false, defs),Completed None | IHash (ParsedHashDirective("load",sourceFiles,m),_) -> - fsiDynamicCompiler.EvalSourceFiles (istate, m, sourceFiles, lexResourceManager),Completed None + fsiDynamicCompiler.EvalSourceFiles (istate, m, sourceFiles, lexResourceManager, errorLogger),Completed None | IHash (ParsedHashDirective(("reference" | "r"),[path],m),_) -> let resolutions,istate = fsiDynamicCompiler.EvalRequireReference istate m path @@ -1840,7 +1845,7 @@ type internal FsiInteractionProcessor /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (tcConfig, istate, action) (lastResult:option) = + let rec execParsedInteractions (tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option) = let action,nextAction,istate = match action with | None -> None ,None,istate @@ -1885,9 +1890,9 @@ type internal FsiInteractionProcessor | None, Some prev -> assert(nextAction.IsNone); istate, prev | None,_ -> assert(nextAction.IsNone); istate, Completed None | Some action, _ -> - let istate,cont = ExecInteraction (tcConfig, istate, action) + let istate,cont = ExecInteraction (tcConfig, istate, action, errorLogger) match cont with - | Completed _ -> execParsedInteractions (tcConfig, istate, nextAction) (Some cont) + | Completed _ -> execParsedInteractions (tcConfig, istate, nextAction, errorLogger, Some cont) | 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 *) @@ -1904,7 +1909,7 @@ type internal FsiInteractionProcessor (istate,CtrlC) | e -> stopProcessingRecovery e range0; - istate,CompletedWithReportedError e + istate,CompletedWithReportedError e #else if !progress then fprintfn fsiConsoleOutput.Out "In mainThreadProcessAction..."; fsiInterruptController.InterruptAllowed <- InterruptCanRaiseException; @@ -1925,9 +1930,9 @@ type internal FsiInteractionProcessor istate, CompletedWithReportedError e #endif - let mainThreadProcessParsedInteractions (action, istate) = + let mainThreadProcessParsedInteractions errorLogger (action, istate) = istate |> mainThreadProcessAction (fun tcConfig istate -> - execParsedInteractions (tcConfig, istate, action) None) + execParsedInteractions (tcConfig, istate, action, errorLogger, None)) let parseExpression (tokenizer:LexFilter.LexFilter) = reusingLexbufForParsing tokenizer.LexBuffer (fun () -> @@ -1937,20 +1942,22 @@ type internal FsiInteractionProcessor // reusingLexbufForParsing tokenizer.LexBuffer (fun () -> // Parser.typEOF tokenizer.Lexer tokenizer.LexBuffer) - let mainThreadProcessParsedExpression (expr, istate) = - istate |> InteractiveCatch (fun istate -> + let mainThreadProcessParsedExpression errorLogger (expr, istate) = + istate |> InteractiveCatch errorLogger (fun istate -> istate |> mainThreadProcessAction (fun _tcConfig istate -> - fsiDynamicCompiler.EvalParsedExpression(istate, expr) )) + fsiDynamicCompiler.EvalParsedExpression(errorLogger, istate, expr) )) let commitResult (istate, result) = match result with - | FsiInteractionStepStatus.CtrlC -> raise (OperationCanceledException()) - | FsiInteractionStepStatus.EndOfFile -> failwith "End of input" + | FsiInteractionStepStatus.CtrlC -> Choice2Of2 (Some (OperationCanceledException() :> exn)) + | FsiInteractionStepStatus.EndOfFile -> Choice2Of2 (Some (System.Exception "End of input")) | FsiInteractionStepStatus.Completed res -> setCurrState istate - res - | FsiInteractionStepStatus.CompletedWithReportedError e -> - raise (System.Exception("Evaluation failed", e)) + Choice1Of2 res + | FsiInteractionStepStatus.CompletedWithReportedError (StopProcessing userExnOpt) -> + Choice2Of2 userExnOpt + | FsiInteractionStepStatus.CompletedWithReportedError _ -> + Choice2Of2 None /// Parse then process one parsed interaction. /// @@ -1962,7 +1969,7 @@ 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) = + member __.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:LexFilter.LexFilter, errorLogger) = if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = @@ -1976,7 +1983,7 @@ type internal FsiInteractionProcessor else fsiConsolePrompt.Print(); - istate |> InteractiveCatch (fun istate -> + istate |> InteractiveCatch errorLogger (fun istate -> if !progress then fprintfn fsiConsoleOutput.Out "entering ParseInteraction..."; // Parse the interaction. When FSI.EXE is waiting for input from the console the @@ -1987,7 +1994,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 istate -> mainThreadProcessParsedInteractions (action, istate)) + let res = istate |> runCodeOnMainThread (fun istate -> mainThreadProcessParsedInteractions errorLogger (action, istate)) if !progress then fprintfn fsiConsoleOutput.Out "Just called runCodeOnMainThread, res = %O..." res; res) @@ -1995,7 +2002,7 @@ type internal FsiInteractionProcessor member __.CurrentState = currState /// Perform an "include" on a script file (i.e. a script file specified on the command line) - member processor.EvalIncludedScript (istate, sourceFile, m) = + member processor.EvalIncludedScript (istate, sourceFile, m, errorLogger) = let tcConfig = TcConfig.Create(tcConfigB, validate=false) // Resolve the filename to an absolute filename let sourceFile = tcConfig.ResolveSourceFile(m,sourceFile,tcConfig.implicitIncludeDir) @@ -2004,9 +2011,9 @@ type internal FsiInteractionProcessor WithImplicitHome (tcConfigB, directoryName sourceFile) (fun () -> // An included script file may contain maybe several interaction blocks. // We repeatedly parse and process these, until an error occurs. - let tokenizer = fsiStdinLexerProvider.CreateIncludedScriptLexer sourceFile + let tokenizer = fsiStdinLexerProvider.CreateIncludedScriptLexer (sourceFile, errorLogger) let rec run istate = - let istate,cont = processor.ParseAndExecOneSetOfInteractionsFromLexbuf ((fun f istate -> f istate), istate, tokenizer) + let istate,cont = processor.ParseAndExecOneSetOfInteractionsFromLexbuf ((fun f istate -> f istate), istate, tokenizer, errorLogger) match cont with Completed _ -> run istate | _ -> istate,cont let istate,cont = run istate @@ -2020,20 +2027,20 @@ type internal FsiInteractionProcessor /// Load the source files, one by one. Called on the main thread. - member processor.EvalIncludedScripts (istate, sourceFiles) = + member processor.EvalIncludedScripts (istate, sourceFiles, errorLogger) = match sourceFiles with | [] -> istate | sourceFile :: moreSourceFiles -> // Catch errors on a per-file basis, so results/bindings from pre-error files can be kept. - let istate,cont = InteractiveCatch (fun istate -> processor.EvalIncludedScript (istate, sourceFile, rangeStdin)) istate + let istate,cont = InteractiveCatch errorLogger (fun istate -> processor.EvalIncludedScript (istate, sourceFile, rangeStdin, errorLogger)) istate match cont with - | Completed _ -> processor.EvalIncludedScripts (istate, moreSourceFiles) + | Completed _ -> processor.EvalIncludedScripts (istate, moreSourceFiles, errorLogger) | CompletedWithReportedError _ -> istate // do not process any more files | CtrlC -> istate // do not process any more files | EndOfFile -> assert false; istate // This is unexpected. EndOfFile is replaced by Completed in the called function - member processor.LoadInitialFiles () = + member processor.LoadInitialFiles (errorLogger) = /// Consume initial source files in chunks of scripts or non-scripts let rec consume istate sourceFiles = match sourceFiles with @@ -2043,9 +2050,9 @@ type internal FsiInteractionProcessor let sourceFiles = List.map fst sourceFiles let istate = if isScript1 then - processor.EvalIncludedScripts (istate, sourceFiles) + processor.EvalIncludedScripts (istate, sourceFiles, errorLogger) else - istate |> InteractiveCatch (fun istate -> fsiDynamicCompiler.EvalSourceFiles(istate, rangeStdin, sourceFiles, lexResourceManager), Completed None) |> fst + istate |> InteractiveCatch errorLogger (fun istate -> fsiDynamicCompiler.EvalSourceFiles(istate, rangeStdin, sourceFiles, lexResourceManager, errorLogger), Completed None) |> fst consume istate rest setCurrState (consume currState fsiOptions.SourceFiles) @@ -2055,40 +2062,39 @@ type internal FsiInteractionProcessor /// Send a dummy interaction through F# Interactive, to ensure all the most common code generation paths are /// JIT'ed and ready for use. - member __.LoadDummyInteraction() = - setCurrState (currState |> InteractiveCatch (fun istate -> fsiDynamicCompiler.EvalParsedDefinitions (istate, true, false, []), Completed None) |> fst) + member __.LoadDummyInteraction(errorLogger) = + setCurrState (currState |> InteractiveCatch errorLogger (fun istate -> fsiDynamicCompiler.EvalParsedDefinitions (errorLogger, istate, true, false, []), Completed None) |> fst) - member __.EvalInteraction(sourceText) = + member __.EvalInteraction(sourceText, scriptFileName, errorLogger) = use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive) use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(sourceText) - let tokenizer = fsiStdinLexerProvider.CreateBufferLexer("input.fsx", lexbuf) + let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) currState - |> InteractiveCatch(fun istate -> + |> InteractiveCatch errorLogger (fun istate -> let expr = ParseInteraction tokenizer - mainThreadProcessParsedInteractions (expr, istate) ) + mainThreadProcessParsedInteractions errorLogger (expr, istate) ) |> commitResult - |> ignore - member this.EvalScript(scriptPath) = + member this.EvalScript (scriptPath, errorLogger) = // Todo: this runs the script as expected but errors are displayed one line to far in debugger let sourceText = sprintf "#load @\"%s\" " scriptPath - this.EvalInteraction sourceText + this.EvalInteraction (sourceText, scriptPath, errorLogger) - member __.EvalExpression(sourceText) = + member __.EvalExpression (sourceText, scriptFileName, errorLogger) = use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive) use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(sourceText) - let tokenizer = fsiStdinLexerProvider.CreateBufferLexer("input.fsx", lexbuf) + let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) currState - |> InteractiveCatch(fun istate -> + |> InteractiveCatch errorLogger (fun istate -> let expr = parseExpression tokenizer let m = expr.Range // Make this into "(); expr" to suppress generalization and compilation-as-function let exprWithSeq = SynExpr.Sequential(SequencePointInfoForSeq.SuppressSequencePointOnStmtOfSequential,true,SynExpr.Const(SynConst.Unit,m.StartRange), expr, m) - mainThreadProcessParsedExpression (exprWithSeq, istate)) + mainThreadProcessParsedExpression errorLogger (exprWithSeq, istate)) |> commitResult member __.PartialAssemblySignatureUpdated = event.Publish @@ -2101,7 +2107,7 @@ type internal FsiInteractionProcessor // mainForm.Invoke to pipe a message back through the form's main event loop. (The message // is a delegate to execute on the main Thread) // - member processor.StartStdinReadAndProcessThread () = + member processor.StartStdinReadAndProcessThread (errorLogger) = if !progress then fprintfn fsiConsoleOutput.Out "creating stdinReaderThread"; @@ -2111,7 +2117,7 @@ type internal FsiInteractionProcessor use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID try try - let initialTokenizer = fsiStdinLexerProvider.CreateStdinLexer() + let initialTokenizer = fsiStdinLexerProvider.CreateStdinLexer(errorLogger) if !progress then fprintfn fsiConsoleOutput.Out "READER: stdin thread started..."; // Delay until we've peeked the input or read the entire first line @@ -2123,13 +2129,13 @@ type internal FsiInteractionProcessor let rec loop currTokenizer = let istateNew,contNew = - processor.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnEventLoop, currState, currTokenizer) + processor.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnEventLoop errorLogger, currState, currTokenizer, errorLogger) setCurrState istateNew match contNew with | EndOfFile -> () - | CtrlC -> loop (fsiStdinLexerProvider.CreateStdinLexer()) // After each interrupt, restart to a brand new tokenizer + | CtrlC -> loop (fsiStdinLexerProvider.CreateStdinLexer(errorLogger)) // After each interrupt, restart to a brand new tokenizer | CompletedWithReportedError _ | Completed _ -> loop currTokenizer @@ -2394,7 +2400,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | None -> None - let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, errorLogger, outWriter, tcImports, tcGlobals, ilGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, niceNameGen, resolveType) + let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, outWriter, tcImports, tcGlobals, ilGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, niceNameGen, resolveType) let fsiInterruptController = FsiInterruptController(fsiOptions, fsiConsoleOutput) @@ -2403,10 +2409,27 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i /// This reference cell holds the most recent interactive state let initialInteractiveState = fsiDynamicCompiler.GetInitialInteractiveState () - let fsiStdinLexerProvider = FsiStdinLexerProvider(tcConfigB, fsiStdinSyphon, fsiConsoleInput, fsiConsoleOutput, fsiOptions, lexResourceManager, errorLogger) + let fsiStdinLexerProvider = FsiStdinLexerProvider(tcConfigB, fsiStdinSyphon, fsiConsoleInput, fsiConsoleOutput, fsiOptions, lexResourceManager) - let fsiInteractionProcessor = FsiInteractionProcessor(fsi, tcConfigB, errorLogger, fsiOptions, fsiDynamicCompiler, fsiConsolePrompt, fsiConsoleOutput, fsiInterruptController, fsiStdinLexerProvider, lexResourceManager, initialInteractiveState) + let fsiInteractionProcessor = FsiInteractionProcessor(fsi, tcConfigB, fsiOptions, fsiDynamicCompiler, fsiConsolePrompt, fsiConsoleOutput, fsiInterruptController, fsiStdinLexerProvider, lexResourceManager, initialInteractiveState) + let commitResult res = + match res with + | Choice1Of2 r -> r + | Choice2Of2 None -> failwith "Operation failed. The error text has been print the error stream. To return the corresponding FSharpErrorInfo use the EvalInteractionNonThrowing, EvalScriptNonThrowing or EvalExpressionNonThrowing" + | Choice2Of2 (Some userExn) -> raise userExn + + let commitResultNonThrowing tcConfig scriptFile (errorLogger: CompilationErrorLogger) res = + let errs = errorLogger.GetErrors() + let userRes = + match res with + | Choice1Of2 r -> Choice1Of2 r + | Choice2Of2 None -> Choice2Of2 (System.Exception "Operation could not be completed due to earlier error") + | Choice2Of2 (Some userExn) -> Choice2Of2 userExn + + userRes, FsiInteractiveChecker.CreateErrorInfos (tcConfig, true, scriptFile, errs) + + let dummyScriptFileName = "input.fsx" interface IDisposable with member x.Dispose() = @@ -2444,7 +2467,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i fprintfn fsiConsoleOutput.Error "%s" (exn.ToString()) errorLogger.SetError() try - errorLogger.AbortOnError() + errorLogger.AbortOnError(fsiConsoleOutput) with StopProcessing _ -> // BUG 664864: Watson Clr20r3 across buckets with: Application FSIAnyCPU.exe from Dev11 RTM; Exception AE251Y0L0P2WC0QSWDZ0E2IDRYQTDSVB; FSIANYCPU.NI.EXE!Microsoft.FSharp.Compiler.Interactive.Shell+threadException // reason: some window that use System.Windows.Forms.DataVisualization types (possible FSCharts) was created in FSI. @@ -2505,14 +2528,39 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i member x.InteractiveChecker = checker member x.EvalExpression(sourceText) = - fsiInteractionProcessor.EvalExpression(sourceText) + fsiInteractionProcessor.EvalExpression(sourceText, dummyScriptFileName, errorLogger) + |> commitResult + + member x.EvalExpressionNonThrowing(sourceText) = + let tcConfig = TcConfig.Create(tcConfigB,validate=false) + let errorLogger = CompilationErrorLogger("EvalInteraction",tcConfig) + fsiInteractionProcessor.EvalExpression(sourceText, dummyScriptFileName, errorLogger) + |> commitResultNonThrowing tcConfig dummyScriptFileName errorLogger member x.EvalInteraction(sourceText) : unit = - fsiInteractionProcessor.EvalInteraction(sourceText) + fsiInteractionProcessor.EvalInteraction(sourceText, dummyScriptFileName, errorLogger) + |> commitResult + |> ignore + + member x.EvalInteractionNonThrowing(sourceText) = + let tcConfig = TcConfig.Create(tcConfigB,validate=false) + let errorLogger = CompilationErrorLogger("EvalInteraction",tcConfig) + fsiInteractionProcessor.EvalInteraction(sourceText, dummyScriptFileName, errorLogger) + |> commitResultNonThrowing tcConfig "input.fsx" errorLogger + |> function Choice1Of2(_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs member x.EvalScript(scriptPath) : unit = - fsiInteractionProcessor.EvalScript(scriptPath) + fsiInteractionProcessor.EvalScript(scriptPath, errorLogger) + |> commitResult + |> ignore + member x.EvalScriptNonThrowing(scriptPath) = + let tcConfig = TcConfig.Create(tcConfigB,validate=false) + let errorLogger = CompilationErrorLogger("EvalInteraction",tcConfig) + fsiInteractionProcessor.EvalScript(scriptPath, errorLogger) + |> commitResultNonThrowing tcConfig scriptPath errorLogger + |> function Choice1Of2(_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs + /// Performs these steps: /// - Load the dummy interaction, if any /// - Set up exception handling, if any @@ -2537,7 +2585,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i if fsiOptions.Interact then // page in the type check env - fsiInteractionProcessor.LoadDummyInteraction() + fsiInteractionProcessor.LoadDummyInteraction(errorLogger) if !progress then fprintfn fsiConsoleOutput.Out "MAIN: InstallKillThread!"; // Compute how long to pause before a ThreadAbort is actually executed. @@ -2554,15 +2602,16 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | :? System.Exception as err -> x.ReportUnhandledExceptionSafe false err | _ -> ()) - fsiInteractionProcessor.LoadInitialFiles() + fsiInteractionProcessor.LoadInitialFiles(errorLogger) - fsiInteractionProcessor.StartStdinReadAndProcessThread() + fsiInteractionProcessor.StartStdinReadAndProcessThread(errorLogger) DriveFsiEventLoop (fsi, fsiConsoleOutput ) else // not interact if !progress then fprintfn fsiConsoleOutput.Out "Run: not interact, loading intitial files..." - fsiInteractionProcessor.LoadInitialFiles() + fsiInteractionProcessor.LoadInitialFiles(errorLogger) + if !progress then fprintfn fsiConsoleOutput.Out "Run: done..." exit (min errorLogger.ErrorCount 1) diff --git a/src/fsharp/fsi/fsi.fsi b/src/fsharp/fsi/fsi.fsi index f3791babd3..a150bf3ccd 100644 --- a/src/fsharp/fsi/fsi.fsi +++ b/src/fsharp/fsi/fsi.fsi @@ -13,6 +13,7 @@ module Microsoft.FSharp.Compiler.Interactive.Shell open System.IO +open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.SourceCodeServices [] @@ -146,6 +147,15 @@ type FsiEvaluationSession = /// by input from 'stdin'. member EvalInteraction : code: string -> 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 + /// of the input. Errors and warnings are collected apart from any exception arising from execution + /// which is returned via a Choice. Execution is performed on the 'Run()' thread. + /// + /// 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[] + /// 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 /// were no errors overall. Execution is performed on the 'Run()' thread. @@ -154,16 +164,33 @@ type FsiEvaluationSession = /// by input from 'stdin'. member EvalScript : filePath: string -> unit + /// Execute the given script. Stop on first error, discarding the rest + /// of the script. Errors and warnings are collected apart from any exception arising from execution + /// which is returned via a Choice. Execution is performed on the 'Run()' thread. + /// + /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered + /// by input from 'stdin'. + member EvalScriptNonThrowing : filePath: string -> Choice * FSharpErrorInfo[] + /// 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 - /// of the input. Errors are sent to the output writer, a 'true' return value indicates there - /// were no errors overall. Parsing is performed on the current thread, and execution is performed + /// of the input. Errors are sent to the output writer. Parsing is performed on the current thread, and execution is performed /// sycnhronously on the 'main' thread. /// /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. member EvalExpression : code: string -> FsiValue option + /// 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 + /// of the input. Errors and warnings are collected apart from any exception arising from execution + /// which is returned via a Choice. Parsing is performed on the current thread, and execution is performed + /// sycnhronously on the 'main' thread. + /// + /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered + /// by input from 'stdin'. + member EvalExpressionNonThrowing : code: string -> Choice * FSharpErrorInfo[] + /// Raised when an interaction is successfully typechecked and executed, resulting in an update to the /// type checking state. /// diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index d0a7a6aed1..7fb8fe0a97 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -1084,7 +1084,7 @@ type FrameworkImportsCache(keepStrongly) = /// An error logger that capture errors, filtering them according to warning levels etc. -type CompilationErrorLogger (debugName:string, tcConfig:TcConfig) = +type internal CompilationErrorLogger (debugName:string, tcConfig:TcConfig) = inherit ErrorLogger("CompilationErrorLogger("+debugName+")") let warningsSeenInScope = new ResizeArray<_>() @@ -1192,7 +1192,7 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig // This operation is done when constructing the builder itself, rather than as an incremental task. let nonFrameworkAssemblyInputs = // Note we are not calling errorLogger.GetErrors() anywhere for this task. - // REVIEW: Consider if this is ok. I believe so, because this is a background build and we aren'T currently reporting errors from the background build. + // This is ok because not much can actually go wrong here. let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", tcConfig) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger,BuildPhase.Parameter, projectDirectory) @@ -1207,12 +1207,11 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig DateTime.Now with e -> // Note we are not calling errorLogger.GetErrors() anywhere for this task. This warning will not be reported... - // REVIEW: Consider if this is ok. I believe so, because this is a background build and we aren't currently reporting errors from the background build. errorLogger.Warning(e) DateTime.Now yield (Choice1Of2 r.resolvedPath,originalTimeStamp) for pr in projectReferences do - yield Choice2Of2 pr, defaultArg (pr.GetLogicalTimeStamp()) DateTime.Now] + yield Choice2Of2 pr, defaultArg (pr.GetLogicalTimeStamp()) DateTime.Now] // The IncrementalBuilder needs to hold up to one item that needs to be disposed, which is the tcImports for the incremental // build. @@ -1725,7 +1724,7 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig else MSBuildResolver.CompileTimeLike tcConfigB.conditionalCompilationDefines <- - let define = if useScriptResolutionRules then "INTERACTIVE" else "COMPILED" + let define = if useScriptResolutionRules then "INTERACTIVE" else "MPILED" define::tcConfigB.conditionalCompilationDefines tcConfigB.projectReferences <- projectReferences diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi index 95fde7656e..e0c7dc99fd 100755 --- a/src/fsharp/vs/IncrementalBuild.fsi +++ b/src/fsharp/vs/IncrementalBuild.fsi @@ -52,6 +52,16 @@ type internal FrameworkImportsCache = member Clear: unit -> unit member Downsize: unit -> unit +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationErrorLogger = + inherit ErrorLogger + + /// Create the error logger + new : debugName:string * tcConfig:TcConfig -> CompilationErrorLogger + + /// Get the captured errors + member GetErrors : unit -> (PhasedError * FSharpErrorSeverity) list + /// Represents the state in the incremental graph assocaited with checking a file type internal PartialCheckResults = { TcState : TcState diff --git a/src/fsharp/vs/SimpleServices.fs b/src/fsharp/vs/SimpleServices.fs index e28b73c93c..9017f9b70d 100644 --- a/src/fsharp/vs/SimpleServices.fs +++ b/src/fsharp/vs/SimpleServices.fs @@ -136,7 +136,7 @@ namespace Microsoft.FSharp.Compiler.SimpleSourceCodeServices let tryCompile errorLogger f = use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) use unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - let exiter = { new Exiter with member x.Exit n = raise (StopProcessing "") } + let exiter = { new Exiter with member x.Exit n = raise (StopProcessing None) } try f exiter 0 diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index bc6bfcc91a..bae45ccf81 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1525,7 +1525,8 @@ module internal Parser = for e in relatedErrors do yield! oneError true e ] - let CreateErrorInfos (tcConfig:TcConfig, allErrors, mainInputFileName, fileInfo, errors) = + let CreateErrorInfos (tcConfig:TcConfig, allErrors, mainInputFileName, errors) = + let fileInfo = (Int32.MaxValue, Int32.MaxValue) [| for (exn,warn) in errors do yield! ReportError (tcConfig, allErrors, mainInputFileName, fileInfo, (exn, warn)) |] @@ -2390,8 +2391,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun | Some builder -> let inputOpt,_,_,parseErrors = builder.GetParseResultsForFile filename let dependencyFiles = builder.Dependencies - let fileInfo = (Int32.MaxValue, Int32.MaxValue) - let errors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, fileInfo, parseErrors) |] + let errors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, parseErrors) |] FSharpParseFileResults(errors = errors, input = inputOpt, parseHadErrors = false, dependencyFiles = dependencyFiles) ) @@ -2506,9 +2506,8 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun | Some builder -> let (inputOpt, _, _, untypedErrors) = builder.GetParseResultsForFile filename let tcProj = builder.GetCheckResultsAfterFileInProject filename - let fileInfo = (Int32.MaxValue, Int32.MaxValue) - let untypedErrors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, fileInfo, untypedErrors) |] - let tcErrors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, fileInfo, tcProj.Errors) |] + let untypedErrors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, untypedErrors) |] + let tcErrors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, tcProj.Errors) |] let parseResults = FSharpParseFileResults(errors = untypedErrors, input = inputOpt, parseHadErrors = false, dependencyFiles = builder.Dependencies) let loadClosure = scriptClosureCache.TryGet options let scope = @@ -2537,8 +2536,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun FSharpCheckProjectResults (keepAssemblyContents, Array.ofList creationErrors, None, reactorOps) | Some builder -> let (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetCheckResultsAndImplementationsForProject() - let fileInfo = (Int32.MaxValue, Int32.MaxValue) - let errors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (tcProj.TcConfig, true, Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation, fileInfo, tcProj.Errors) |] + let errors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (tcProj.TcConfig, true, Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation, tcProj.Errors) |] FSharpCheckProjectResults (keepAssemblyContents, errors, Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.PartialAssemblySignature, tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt), reactorOps) /// Get the timestamp that would be on the output if fully built immediately @@ -2873,6 +2871,9 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso type FsiInteractiveChecker(reactorOps: IReactorOperations, tcConfig, tcGlobals, tcImports, tcState, loadClosure) = let keepAssemblyContents = false + static member CreateErrorInfos (tcConfig, allErrors, mainInputFileName, errors) = + Parser.CreateErrorInfos(tcConfig, allErrors, mainInputFileName, errors) + member __.ParseAndCheckInteraction (source) = let mainInputFileName = "stdin.fsx" diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index ce05060ba8..405d3bf006 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -683,6 +683,7 @@ type FSharpChecker = type internal FsiInteractiveChecker = internal new : ops: IReactorOperations * tcConfig: TcConfig * tcGlobals: TcGlobals * tcImports: TcImports * tcState: TcState * loadClosure: LoadClosure option -> FsiInteractiveChecker member internal ParseAndCheckInteraction : source:string -> FSharpParseFileResults * FSharpCheckFileResults * FSharpCheckProjectResults + static member internal CreateErrorInfos : tcConfig: TcConfig * allErrors:bool * mainInputFileName : string * seq -> FSharpErrorInfo[] /// Information about the compilation environment type [] CompilerEnvironment = diff --git a/tests/service/FsiTests.fs b/tests/service/FsiTests.fs index 9ec2438f90..5ebc67b720 100644 --- a/tests/service/FsiTests.fs +++ b/tests/service/FsiTests.fs @@ -36,9 +36,31 @@ let evalExpression text = | Some value -> sprintf "%A" value.ReflectionValue | None -> sprintf "null or no result" -/// Evaluate interaction & ignore the result -let evalInteraction text = - fsiSession.EvalInteraction(text) +let formatErrors (errs: FSharpErrorInfo[]) = + [ for err in errs do yield sprintf "%s %d,%d - %d,%d; %s" (match err.Severity with FSharpErrorSeverity.Error -> "error" | FSharpErrorSeverity.Warning -> "warning") err.StartLineAlternate err.StartColumn err.EndLineAlternate err.EndColumn err.Message ] + +let showErrorsAndResult (x, errs) = + [ match x with + | Choice1Of2 res -> yield sprintf "result %A" res + | Choice2Of2 (exn:exn) -> yield sprintf "exception %s" exn.Message + yield! formatErrors errs ] + +let showErrors (x, errs: FSharpErrorInfo[]) = + [ match x with + | Choice1Of2 () -> () + | Choice2Of2 (exn:exn) -> yield sprintf "exception %s" exn.Message + yield! formatErrors errs ] + +/// Evaluate expression & return the result +let evalExpressionNonThrowing text = + let res, errs = fsiSession.EvalExpressionNonThrowing(text) + [ match res with + | Choice1Of2 valueOpt -> + match valueOpt with + | Some value -> yield sprintf "%A" value.ReflectionValue + | None -> yield sprintf "null or no result" + | Choice2Of2 (exn:exn) -> yield sprintf "exception %s" exn.Message + yield! formatErrors errs ] // For some reason NUnit doesn't like running these FsiEvaluationSession tests. We need to work out why. //#if INTERACTIVE @@ -46,6 +68,10 @@ let evalInteraction text = let ``EvalExpression test 1``() = evalExpression "42+1" |> shouldEqual "43" +[] +let ``EvalExpression test 1 nothrow``() = + evalExpressionNonThrowing "42+1" |> shouldEqual ["43"] + [] // 'fsi' can be evaluated because we passed it in explicitly up above let ``EvalExpression fsi test``() = @@ -54,7 +80,14 @@ let ``EvalExpression fsi test``() = [] // 'fsi' can be evaluated because we passed it in explicitly up above let ``EvalExpression fsi test 2``() = - evalInteraction "fsi.AddPrinter |> ignore" + fsiSession.EvalInteraction "fsi.AddPrinter |> ignore" + +[] +// 'fsi' can be evaluated because we passed it in explicitly up above +let ``EvalExpression fsi test 2 non throwing``() = + fsiSession.EvalInteractionNonThrowing "fsi.AddPrinter |> ignore" + |> showErrors + |> shouldEqual [] [] @@ -64,6 +97,15 @@ let ``EvalExpression typecheck failure``() = with e -> true) |> shouldEqual true +[] +let ``EvalExpression typecheck failure nothrow``() = + evalExpressionNonThrowing("42+1.0") + |> shouldEqual + ["exception Operation could not be completed due to earlier error"; + "error 1,3 - 1,6; The type 'float' does not match the type 'int'"; + "error 1,2 - 1,3; The type 'float' does not match the type 'int'"] + + [] let ``EvalExpression function value 1``() = fsiSession.EvalExpression "(fun x -> x + 1)" |> fun s -> s.IsSome @@ -99,42 +141,75 @@ let ``EvalExpression parse failure``() = with e -> true) |> shouldEqual true +[] +let ``EvalExpression parse failure nothrow``() = + evalExpressionNonThrowing """ let let let let x = 1 """ + |> shouldEqual + ["exception Operation could not be completed due to earlier error"; + "error 1,5 - 1,8; Unexpected keyword 'let' or 'use' in binding"; + "error 1,1 - 1,4; Block following this 'let' is unfinished. Expect an expression."] + [] let ``EvalInteraction typecheck failure``() = - (try evalInteraction "let x = 42+1.0" |> ignore + (try fsiSession.EvalInteraction "let x = 42+1.0" |> ignore false with e -> true) |> shouldEqual true +[] +let ``EvalInteraction typecheck failure nothrow``() = + fsiSession.EvalInteractionNonThrowing "let x = 42+1.0" + |> showErrors + |> shouldEqual + ["exception Operation could not be completed due to earlier error"; + "error 1,11 - 1,14; The type 'float' does not match the type 'int'"; + "error 1,10 - 1,11; The type 'float' does not match the type 'int'"] + [] let ``EvalInteraction runtime failure``() = - (try evalInteraction """let x = (failwith "fail" : int) """ |> ignore + (try fsiSession.EvalInteraction """let x = (failwith "fail" : int) """ |> ignore false with e -> true) |> shouldEqual true +[] +let ``EvalInteraction runtime failure nothrow``() = + fsiSession.EvalInteractionNonThrowing """let x = (failwith "fail" : int) """ + |> showErrors + |> shouldEqual ["exception fail"] + [] let ``EvalInteraction parse failure``() = - (try evalInteraction """ let let let let x = """ |> ignore + (try fsiSession.EvalInteraction """ let let let let x = """ |> ignore false with e -> true) |> shouldEqual false // EvalInteraction doesn't fail for parse failures, it just reports errors. +[] +let ``EvalInteraction parse failure nothrow``() = + fsiSession.EvalInteractionNonThrowing """ let let let let x = """ + |> showErrors + |> shouldEqual + ["exception Operation could not be completed due to earlier error"; + "error 1,5 - 1,8; Unexpected keyword 'let' or 'use' in binding"; + "warning 1,0 - 1,22; Possible incorrect indentation: this token is offside of context started at position (1:14). Try indenting this token further or using standard formatting conventions."; + "warning 1,22 - 1,22; Possible incorrect indentation: this token is offside of context started at position (1:14). Try indenting this token further or using standard formatting conventions."] + [] let ``PartialAssemblySignatureUpdated test``() = let count = ref 0 fsiSession.PartialAssemblySignatureUpdated.Add(fun x -> count := count.Value + 1) count.Value |> shouldEqual 0 - evalInteraction """ let x = 1 """ + fsiSession.EvalInteraction """ let x = 1 """ count.Value |> shouldEqual 1 - evalInteraction """ let x = 1 """ + fsiSession.EvalInteraction """ let x = 1 """ count.Value |> shouldEqual 2 [] let ``ParseAndCheckInteraction test 1``() = - evalInteraction """ let xxxxxx = 1 """ - evalInteraction """ type CCCC() = member x.MMMMM() = 1 + 1 """ + fsiSession.EvalInteraction """ let xxxxxx = 1 """ + fsiSession.EvalInteraction """ type CCCC() = member x.MMMMM() = 1 + 1 """ let untypedResults, typedResults, _ = fsiSession.ParseAndCheckInteraction("xxxxxx") untypedResults.FileName |> shouldEqual "stdin.fsx" untypedResults.Errors.Length |> shouldEqual 0 @@ -191,15 +266,26 @@ let ``EvalScript accepts paths verbatim``() = (try let scriptPath = @"C:\bad\path\no\donut.fsx" fsiSession.EvalScript scriptPath |> ignore - true + false with | e -> - // Microsoft.FSharp.Compiler.Build is internal, so we can't access the exception class here - String.Equals(e.InnerException.GetType().FullName, - "Microsoft.FSharp.Compiler.CompileOps+FileNameNotResolved", - StringComparison.InvariantCultureIgnoreCase)) + true) |> shouldEqual true +[] +// Regression test for #184 +let ``EvalScript accepts paths verbatim nothrow``() = + // Path contains escape sequences (\b and \n) + // Let's ensure the exception thrown (if any) is FileNameNotResolved + let scriptPath = @"C:\bad\path\no\donut.fsx" + fsiSession.EvalScriptNonThrowing scriptPath + |> showErrors + |> List.map (fun s -> s.[0..20]) // avoid seeing the hardwired paths + |> Seq.toList + |> shouldEqual + ["exception Operation c"; + "error 1,0 - 1,33; Una"] + [] let ``Disposing interactive session (collectible)``() = @@ -263,21 +349,28 @@ let ``interactive session events``() = let RunManually() = ``EvalExpression test 1``() + ``EvalExpression test 1 nothrow``() ``EvalExpression fsi test``() ``EvalExpression fsi test 2``() ``EvalExpression typecheck failure``() + ``EvalExpression typecheck failure nothrow``() ``EvalExpression function value 1``() ``EvalExpression function value 2``() ``EvalExpression runtime failure``() ``EvalExpression parse failure``() + ``EvalExpression parse failure nothrow``() ``EvalInteraction typecheck failure``() + ``EvalInteraction typecheck failure nothrow``() ``EvalInteraction runtime failure``() + ``EvalInteraction runtime failure nothrow``() ``EvalInteraction parse failure``() + ``EvalInteraction parse failure nothrow``() ``PartialAssemblySignatureUpdated test``() ``ParseAndCheckInteraction test 1``() ``Bad arguments to session creation 1``() ``Bad arguments to session creation 2``() ``EvalScript accepts paths verbatim``() + ``EvalScript accepts paths verbatim nothrow``() ``interactive session events``() ``Disposing interactive session (collectible)``()