add hostPID command line arg, to fix zombie fsac after the client is force closed

build.fsx

@@ -73,38 +73,55 @@ let runIntegrationTest (fn: string) : bool =
     true
   | None ->
     tracefn "Running FSIHelper '%s', '%s', '%s'"  FSIHelper.fsiPath dir fn
-    let result, msgs = FSIHelper.executeFSI dir fn []
-    let msgs = msgs |> Seq.filter (fun x -> x.IsError) |> Seq.toList
-    if not result then
-      for msg in msgs do
-        traceError msg.Message
-    result
+    let testExecution =
+      try
+        let fsiExec = async {
+            return Some (FSIHelper.executeFSI dir fn [])
+          }
+        Async.RunSynchronously (fsiExec, TimeSpan.FromMinutes(10.0).TotalMilliseconds |> int)
+      with :? TimeoutException ->
+        None
+    match testExecution with
+    | None -> //timeout
+      false
+    | Some (result, msgs) ->
+      let msgs = msgs |> Seq.filter (fun x -> x.IsError) |> Seq.toList
+      if not result then
+        for msg in msgs do
+          traceError msg.Message
+      result
 
 Target "IntegrationTest" (fun _ ->
+  trace "Running Integration tests..."
   let runOk =
    integrationTests
    |> Seq.map runIntegrationTest
    |> Seq.forall id
 
   if not runOk then
+    trace "Integration tests did not run successfully"
     failwith "Integration tests did not run successfully"
   else
+    trace "checking tests results..."
     let ok, out, err =
       Git.CommandHelper.runGitCommand
                         "."
                         ("-c core.fileMode=false diff --exit-code " + integrationTestDir)
     if not ok then
       trace (toLines out)
       failwithf "Integration tests failed:\n%s" err
+  trace "Done Integration tests."
 )
 
 Target "UnitTest" (fun _ ->
+    trace "Running Unit tests."
     !! testAssemblies
     |> NUnit3 (fun p ->
         { p with
             ShadowCopy = true
-            TimeOut = TimeSpan.FromMinutes 20.
+            TimeOut = TimeSpan.FromMinutes 10.
             OutputDir = "TestResults.xml" })
+    trace "Done Unit tests."
 )
 
 

paket.dependencies

@@ -1,6 +1,7 @@
 framework: net45
 source https://www.nuget.org/api/v2/
 
+nuget Argu 3.7
 nuget FSharp.Compiler.Service 11.0.9 framework: >= net45
 nuget FSharp.Compiler.Service.ProjectCracker 11.0.9
 nuget Dotnet.ProjInfo 0.7.4

paket.lock

@@ -1,6 +1,7 @@
 FRAMEWORK: NET45
 NUGET
   remote: https://www.nuget.org/api/v2
+    Argu (3.7)
     Dotnet.ProjInfo (0.7.4)
       FSharp.Core (>= 4.0.0.1)
     FAKE (4.61.3)

src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj

@@ -40,6 +40,7 @@
   </ItemGroup>
   <ItemGroup>
     <Compile Include="Utils.fs" />
+    <Compile Include="ProcessWatcher.fs" />
     <Compile Include="UntypedAstUtils.fs" />
     <Compile Include="TypedAstUtils.fs" />
     <Compile Include="Extensions.fs" />

src/FsAutoComplete.Core/ProcessWatcher.fs

@@ -0,0 +1,33 @@
+namespace FsAutoComplete
+
+open System.Diagnostics
+open System
+
+module ProcessWatcher =
+
+  type private OnExitMessage =
+    | Watch of Process * (Process -> unit)
+
+  let private watcher = new MailboxProcessor<OnExitMessage>(fun inbox ->
+    let rec loop underWatch =
+        async {
+            let! message = inbox.TryReceive(System.TimeSpan.FromSeconds(0.5).TotalMilliseconds |> int)
+            let next =
+                match message with
+                | Some (Watch (proc, a)) ->
+                    (proc, a) :: underWatch
+                | None ->
+                    let exited, alive = underWatch |> List.partition (fun (p, _) -> p.HasExited)
+                    exited |> List.iter (fun (p,a) -> a p)
+                    alive
+            do! loop next
+        }
+    loop [] )
+
+  let watch proc onExitCallback =
+    if Utils.runningOnMono then
+        watcher.Start()
+        watcher.Post (OnExitMessage.Watch(proc, onExitCallback))
+    else
+        proc.EnableRaisingEvents <- true
+        proc.Exited |> Event.add (fun _ -> onExitCallback proc)

src/FsAutoComplete.Suave/FsAutoComplete.Suave.fs

@@ -35,6 +35,30 @@ module internal Utils =
             System.Text.Encoding.UTF8.GetString(rawForm)
         req.rawForm |> getString |> fromJson<'a>
 
+  let zombieCheckWithHostPID pid quit =
+    try
+      let hostProcess = System.Diagnostics.Process.GetProcessById(pid)
+      ProcessWatcher.watch hostProcess (fun _ -> quit ())
+    with
+    | e ->
+      printfn "Host process ID %i not found: %s" pid e.Message
+      // If the process dies before we get here then request shutdown
+      // immediately
+      quit ()
+
+open Argu
+
+type CLIArguments =
+    | [<MainCommand; Unique>] Port of tcp_port:int
+    | [<CustomCommandLine("--hostPID")>] HostPID of pid:int
+with
+    interface IArgParserTemplate with
+        member s.Usage =
+            match s with
+            | Port _ -> "the listening port."
+            | HostPID _ -> "the Host process ID."
+
+
 [<EntryPoint>]
 let main argv =
     let mutable client : WebSocket option  = None
@@ -160,20 +184,35 @@ let main argv =
             path "/unionCaseGenerator" >=> positionHandler (fun data tyRes lineStr lines   -> commands.GetUnionPatternMatchCases tyRes { Line = data.Line; Col = data.Column } lines lineStr)
         ]
 
-    let port =
+    let main (args: ParseResults<CLIArguments>) =
+        let port = args.GetResult (<@ Port @>, defaultValue = 8088)
+
+        let defaultBinding = defaultConfig.bindings.[0]
+        let withPort = { defaultBinding.socketBinding with port = uint16 port }
+        let serverConfig =
+            { defaultConfig with bindings = [{ defaultBinding with socketBinding = withPort }]}
         try
-            int argv.[0]
+            match args.TryGetResult (<@ HostPID @>) with
+            | Some pid ->
+                serverConfig.logger.Log Logging.LogLevel.Info (fun () -> Logging.LogLine.mk "FsAutoComplete.Suave" Logging.LogLevel.Info Logging.TraceHeader.empty None (sprintf "tracking host PID %i" pid))
+                zombieCheckWithHostPID pid (fun () -> exit 0)
+            | None -> () 
+
+            startWebServer serverConfig app
+            0
         with
-        _ -> 8088
+        | e ->
+            printfn "Server crashing error - %s \n %s" e.Message e.StackTrace
+            1
 
-    let defaultBinding = defaultConfig.bindings.[0]
-    let withPort = { defaultBinding.socketBinding with port = uint16 port }
-    let serverConfig =
-        { defaultConfig with bindings = [{ defaultBinding with socketBinding = withPort }]}
+    let parser = ArgumentParser.Create<CLIArguments>(programName = "FsAutoComplete.Suave.exe")
     try
-        startWebServer serverConfig app
+        let results = parser.Parse argv
+        main results
     with
-    | e ->
-        printfn "Server crashing error - %s \n %s" e.Message e.StackTrace
-
-    0
+        | :? ArguParseException as ex ->
+            printfn "%s" (parser.PrintUsage())
+            2
+        | e ->
+            printfn "Server crashing error - %s \n %s" e.Message e.StackTrace
+            3

src/FsAutoComplete.Suave/FsAutoComplete.Suave.fsproj

@@ -78,6 +78,17 @@
   <Target Name="AfterBuild">
   </Target>
   -->
+  <Choose>
+    <When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And $(TargetFrameworkVersion) == 'v4.5'">
+      <ItemGroup>
+        <Reference Include="Argu">
+          <HintPath>..\..\packages\Argu\lib\net40\Argu.dll</HintPath>
+          <Private>True</Private>
+          <Paket>True</Paket>
+        </Reference>
+      </ItemGroup>
+    </When>
+  </Choose>
   <Choose>
     <When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And $(TargetFrameworkVersion) == 'v4.5'">
       <ItemGroup>

src/FsAutoComplete.Suave/paket.references

@@ -2,4 +2,5 @@ Suave
 FSharp.Compiler.Service
 FSharp.Compiler.Service.ProjectCracker
 Newtonsoft.Json
-FSharp.Core
+FSharp.Core
+Argu

src/FsAutoComplete/CommandInput.fs

@@ -28,6 +28,7 @@ type Command =
   | Project of string * bool
   | Colorization of bool
   | CompilerLocation
+  | Started
   | Quit
 
 module CommandInput =

src/FsAutoComplete/Debug.fs

@@ -11,6 +11,7 @@ module Debug =
     ref None
 
   let output = ref stdout
+  let hostPID : int option ref = ref None
 
   [<Sealed>]
   type Format<'T> private () =
@@ -55,6 +56,21 @@ module Debug =
       while not(System.Diagnostics.Debugger.IsAttached) do
         System.Threading.Thread.Sleep(100)
 
+
+  let zombieCheckWithHostPID quit =
+    match !hostPID with
+    | None -> ()
+    | Some pid ->
+      try
+        let hostProcess = System.Diagnostics.Process.GetProcessById(pid)
+        ProcessWatcher.watch hostProcess (fun _ -> quit ())
+      with
+      | e ->
+        printfn "Host process ID %i not found: %s" pid e.Message
+        // If the process dies before we get here then request shutdown
+        // immediately
+        quit ()
+
   let inline flush () =
     if !verbose then
       (!output).Flush()

src/FsAutoComplete/Options.fs

@@ -85,4 +85,11 @@ module Options =
       "wait-for-debugger", "wait for a debugger to attach to the process",
         fun _ -> Debug.waitForDebugger := true
 
+      "hostPID=", "Host process ID",
+        fun s -> try
+                   Debug.hostPID := Some (int s)
+                 with
+                   | e -> printfn "Bad Host process ID '%s' expected int: %s" s e.Message
+                          exit 1
+
     ]

src/FsAutoComplete/Program.fs

@@ -22,6 +22,8 @@ module internal Main =
     while not quit do
       async {
           match commandQueue.Take() with
+          | Started ->
+              return [ Response.info writeJson (sprintf "Started (PID=%i)" (System.Diagnostics.Process.GetCurrentProcess().Id)) ]
           | Parse (file, kind, lines) ->
               let! res = commands.Parse file lines 0
               //Hack for tests
@@ -91,8 +93,12 @@ module internal Main =
       1
     else
       Debug.checkIfWaitForDebugger()
+      Debug.zombieCheckWithHostPID (fun () -> commandQueue.Add(Command.Quit))
       try
         async {
+          if !Debug.verbose then
+            commandQueue.Add(Command.Started)
+
           while true do
             commandQueue.Add (CommandInput.parseCommand(Console.ReadLine()))
         }

test/FsAutoComplete.IntegrationTests/TestHelpers.fsx

@@ -15,9 +15,7 @@ type FsAutoCompleteWrapper() =
   let cachedOutput = new Text.StringBuilder()
 
   do
-    p.StartInfo.FileName <-
-      IO.Path.Combine(__SOURCE_DIRECTORY__,
-                      "../../src/FsAutoComplete/bin/Debug/fsautocomplete.exe")
+    p.StartInfo.FileName <- FsAutoCompleteWrapper.ExePath ()
     p.StartInfo.RedirectStandardOutput <- true
     p.StartInfo.RedirectStandardError  <- true
     p.StartInfo.RedirectStandardInput  <- true
@@ -27,6 +25,10 @@ type FsAutoCompleteWrapper() =
       p.StartInfo.Arguments <- "--wait-for-debugger"
     p.Start () |> ignore
 
+  static member ExePath () =
+      IO.Path.Combine(__SOURCE_DIRECTORY__,
+                      "../../src/FsAutoComplete/bin/Debug/fsautocomplete.exe")
+
   member x.project (s: string) : unit =
     fprintf p.StandardInput "project \"%s\"\n" s