Fix missing completion items in constructors of inherited types

src/fsharp/TypeChecker.fs

@@ -1509,21 +1509,26 @@ let MakeAndPublishVal cenv env (altActualParent, inSig, declKind, vrec, (ValSche
 
     PublishValueDefn cenv env declKind vspec
 
+    let shouldNotifySink (vspec: Val) =
+        match vspec.MemberInfo with
+        // `this` reference named `__`. It's either:
+        // * generated by compiler for auto properties or 
+        // * provided by source code (i.e. `member __.Method = ...`)
+        // We don't notify sink about it to prevent generating `FSharpSymbol` for it and appearing in completion list.
+        | None when
+            let baseOrThisInfo = vspec.BaseOrThisInfo
+            baseOrThisInfo = ValBaseOrThisInfo.BaseVal || // visualfsharp#3699
+            baseOrThisInfo = ValBaseOrThisInfo.MemberThisVal && vspec.LogicalName = "__" -> false
+        | _ -> true
+
     match cenv.tcSink.CurrentSink with 
-    | None -> ()
-    | Some _ -> 
-        if not vspec.IsCompilerGenerated then
-            match vspec.MemberInfo with
-            // `this` reference named `__`. It's either:
-            // * generated by compiler for auto properties or 
-            // * provided by source code (i.e. `member __.Method = ...`)
-            // We don't notify sink about it to prevent generating `FSharpSymbol` for it and appearing in completion list.
-            | None when vspec.BaseOrThisInfo = ValBaseOrThisInfo.MemberThisVal && vspec.LogicalName = "__" -> () 
-            | _ ->
-                let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) 
-                CallEnvSink cenv.tcSink (vspec.Range, nenv, env.eAccessRights)
-                let item = Item.Value(mkLocalValRef vspec)
-                CallNameResolutionSink cenv.tcSink (vspec.Range, nenv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights)
+    | Some _ when not vspec.IsCompilerGenerated && shouldNotifySink vspec -> 
+        let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) 
+        CallEnvSink cenv.tcSink (vspec.Range, nenv, env.eAccessRights)
+        let item = Item.Value(mkLocalValRef vspec)
+        CallNameResolutionSink cenv.tcSink (vspec.Range, nenv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights)
+    | _ -> ()
+
     vspec
 
 let MakeAndPublishVals cenv env (altActualParent, inSig, declKind, vrec, valSchemes, attrs, doc, konst) =

tests/service/EditorTests.fs

@@ -336,6 +336,50 @@ type Test() =
     let decls = typeCheckResults.GetDeclarationListInfo(Some parseResult, 4, inputLines.[3], PartialLongName.Empty(14), (fun _ -> []), fun _ -> false)|> Async.RunSynchronously
     decls.Items |> Seq.exists (fun d -> d.Name = "abc") |> shouldEqual true
 
+
+[<Test>]
+let ``Completion in base constructor`` () = 
+    let input = 
+      """
+type A(foo) =
+    class
+    end
+
+type B(bar) =
+    inherit A(bar)""" 
+
+    // Split the input & define file name
+    let inputLines = input.Split('\n')
+    let file = "/home/user/Test.fsx"
+    let parseResult, typeCheckResults =  parseAndCheckScript(file, input) 
+
+    let decls = typeCheckResults.GetDeclarationListInfo(Some parseResult, 7, inputLines.[6], PartialLongName.Empty(17), (fun _ -> []), fun _ -> false)|> Async.RunSynchronously
+    decls.Items |> Seq.exists (fun d -> d.Name = "bar") |> shouldEqual true
+
+
+
+[<Test>]
+let ``Completion in do in base constructor`` () = 
+    let input = 
+      """
+type A() =
+    class
+    end
+
+type B(bar) =
+    inherit A()
+
+    do bar""" 
+
+    // Split the input & define file name
+    let inputLines = input.Split('\n')
+    let file = "/home/user/Test.fsx"
+    let parseResult, typeCheckResults =  parseAndCheckScript(file, input) 
+
+    let decls = typeCheckResults.GetDeclarationListInfo(Some parseResult, 9, inputLines.[8], PartialLongName.Empty(7), (fun _ -> []), fun _ -> false)|> Async.RunSynchronously
+    decls.Items |> Seq.exists (fun d -> d.Name = "bar") |> shouldEqual true
+
+
 [<Test; Ignore("SKIPPED: see #139")>]
 let ``Symbol based find function from member 1`` () = 
     let input =