Don't emit XML doc for interface impls (#12918)

src/fsharp/IlxGen.fs

@@ -6569,52 +6569,26 @@ and GenEventForProperty cenv eenvForMeth (mspec: ILMethodSpec) (v: Val) ilAttrsT
                otherMethods= [],
                customAttrs = mkILCustomAttrs ilAttrsThatGoOnPrimaryItem)
 
-and ComputeUseMethodImpl cenv (v: Val, slotsig: SlotSig) =
-    let oty = slotsig.ImplementedType
-    let otcref = tcrefOfAppTy cenv.g oty
-    let tcref = v.MemberApparentEntity
-    // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation
-    isInterfaceTy cenv.g oty &&
-    (let isCompare =
-        Option.isSome tcref.GeneratedCompareToValues &&
-         (typeEquiv cenv.g oty cenv.g.mk_IComparable_ty ||
-          tyconRefEq cenv.g cenv.g.system_GenericIComparable_tcref otcref)
-
-     not isCompare) &&
-
-    (let isGenericEquals =
-        Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq cenv.g cenv.g.system_GenericIEquatable_tcref otcref
-
-     not isGenericEquals) &&
-    (let isStructural =
-        (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralComparable_ty) ||
-        (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralEquatable_ty)
-
-     not isStructural)
-
-and ComputeMethodImplNameFixupForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) =
-     if isNil memberInfo.ImplementedSlotSigs then
+and ComputeMethodImplNameFixupForMemberBinding cenv (v: Val) =
+     if isNil v.ImplementedSlotSigs then
          None
      else
-         let slotsig = memberInfo.ImplementedSlotSigs |> List.last
-         let useMethodImpl = ComputeUseMethodImpl cenv (v, slotsig)
+         let slotsig = v.ImplementedSlotSigs |> List.last
+         let useMethodImpl = ComputeUseMethodImpl cenv.g v
          let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig)
          Some nameOfOverridingMethod
 
-and ComputeFlagFixupsForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) =
-     [ if isNil memberInfo.ImplementedSlotSigs then
-           yield fixupVirtualSlotFlags
+and ComputeFlagFixupsForMemberBinding cenv (v: Val) =
+     [ let useMethodImpl = ComputeUseMethodImpl cenv.g v
+
+       if useMethodImpl then
+          fixupMethodImplFlags
        else
-           for slotsig in memberInfo.ImplementedSlotSigs do
-             let useMethodImpl = ComputeUseMethodImpl cenv (v, slotsig)
+          fixupVirtualSlotFlags
 
-             if useMethodImpl then
-                yield fixupMethodImplFlags
-             else
-                yield fixupVirtualSlotFlags
-           match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with
-           | Some nm -> yield renameMethodDef nm
-           | None -> () ]
+       match ComputeMethodImplNameFixupForMemberBinding cenv v with
+       | Some nm -> renameMethodDef nm
+       | None -> () ]
 
 and ComputeMethodImplAttribs cenv (_v: Val) attrs =
     let g = cenv.g
@@ -6805,10 +6779,10 @@ and GenMethodForBinding
                ((memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) ||
                 memberInfo.MemberFlags.IsOverrideOrExplicitImpl) then
 
-                let useMethodImpl = memberInfo.ImplementedSlotSigs |> List.exists (fun slotsig -> ComputeUseMethodImpl cenv (v, slotsig))
+                let useMethodImpl = ComputeUseMethodImpl cenv.g v
 
                 let nameOfOverridingMethod =
-                    match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with
+                    match ComputeMethodImplNameFixupForMemberBinding cenv v with
                     | None -> mspec.Name
                     | Some nm -> nm
 
@@ -6853,7 +6827,7 @@ and GenMethodForBinding
                    elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) ||
                         memberInfo.MemberFlags.IsOverrideOrExplicitImpl then
 
-                       let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v, memberInfo)
+                       let flagFixups = ComputeFlagFixupsForMemberBinding cenv v
                        let mdef = mkILGenericVirtualMethod (mspec.Name, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody)
                        let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups
 

src/fsharp/TypedTree.fs

@@ -2695,6 +2695,12 @@ type Val =
         | Some memberInfo when memberInfo.MemberFlags.IsOverrideOrExplicitImpl -> true
         | _ -> false
             
+    /// Gets the dispatch slots implemented by this method
+    member x.ImplementedSlotSigs =
+        match x.MemberInfo with 
+        | Some memberInfo -> memberInfo.ImplementedSlotSigs
+        | _ -> []
+            
     /// Indicates if this is declared 'mutable'
     member x.IsMutable = (match x.val_flags.MutabilityInfo with Immutable -> false | Mutable -> true)
 
@@ -3799,6 +3805,9 @@ type ValRef =
     /// Indicates if this value was a member declared 'override' or an implementation of an interface slot
     member x.IsOverrideOrExplicitImpl = x.Deref.IsOverrideOrExplicitImpl
 
+    /// Gets the dispatch slots implemented by this method
+    member x.ImplementedSlotSigs = x.Deref.ImplementedSlotSigs
+
     /// Is this a member, if so some more data about the member.
     member x.MemberInfo = x.Deref.MemberInfo
 

src/fsharp/TypedTreeOps.fs

@@ -8478,14 +8478,14 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty =
     | TType_measure _ -> "?"
 
 and tyargsEnc g (gtpsType, gtpsMethod) args = 
-     match args with     
-     | [] -> ""
-     | [a] when (match (stripTyEqns g a) with TType_measure _ -> true | _ -> false) -> ""  // float<m> should appear as just "float" in the generated .XML xmldoc file
-     | _ -> angleEnc (commaEncs (List.map (typeEnc g (gtpsType, gtpsMethod)) args)) 
+    match args with     
+    | [] -> ""
+    | [a] when (match (stripTyEqns g a) with TType_measure _ -> true | _ -> false) -> ""  // float<m> should appear as just "float" in the generated .XML xmldoc file
+    | _ -> angleEnc (commaEncs (List.map (typeEnc g (gtpsType, gtpsMethod)) args)) 
 
 let XmlDocArgsEnc g (gtpsType, gtpsMethod) argTys =
-  if isNil argTys then "" 
-  else "(" + String.concat "," (List.map (typeEnc g (gtpsType, gtpsMethod)) argTys) + ")"
+    if isNil argTys then "" 
+    else "(" + String.concat "," (List.map (typeEnc g (gtpsType, gtpsMethod)) argTys) + ")"
 
 let buildAccessPath (cp: CompilationPath option) =
     match cp with
@@ -8493,64 +8493,72 @@ let buildAccessPath (cp: CompilationPath option) =
         let ap = cp.AccessPath |> List.map fst |> List.toArray
         System.String.Join(".", ap)      
     | None -> "Extension Type"
+
 let prependPath path name = if path = "" then name else path + "." + name
 
 let XmlDocSigOfVal g full path (v: Val) =
-  let parentTypars, methTypars, cxs, argInfos, rty, prefix, path, name = 
+    let parentTypars, methTypars, cxs, argInfos, rty, prefix, path, name = 
 
-    // CLEANUP: this is one of several code paths that treat module values and members 
-    // separately when really it would be cleaner to make sure GetTopValTypeInFSharpForm, GetMemberTypeInFSharpForm etc.
-    // were lined up so code paths like this could be uniform
+        // CLEANUP: this is one of several code paths that treat module values and members 
+        // separately when really it would be cleaner to make sure GetTopValTypeInFSharpForm, GetMemberTypeInFSharpForm etc.
+        // were lined up so code paths like this could be uniform
     
-    match v.MemberInfo with 
-    | Some membInfo when not v.IsExtensionMember -> 
-        // Methods, Properties etc.
-        let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v
-        let tps, witnessInfos, argInfos, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags (Option.get v.ValReprInfo) numEnclosingTypars v.Type v.Range
-        let prefix, name = 
-          match membInfo.MemberFlags.MemberKind with 
-          | SynMemberKind.ClassConstructor 
-          | SynMemberKind.Constructor -> "M:", "#ctor"
-          | SynMemberKind.Member -> "M:", v.CompiledName g.CompilerGlobalState
-          | SynMemberKind.PropertyGetSet 
-          | SynMemberKind.PropertySet
-          | SynMemberKind.PropertyGet -> "P:", v.PropertyName
-        let path = if v.HasDeclaringEntity then prependPath path v.TopValDeclaringEntity.CompiledName else path
-        let parentTypars, methTypars = 
-          match PartitionValTypars g v with
-          | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars
-          | None -> [], tps
-        parentTypars, methTypars, witnessInfos, argInfos, rty, prefix, path, name
-    | _ ->
-        // Regular F# values and extension members 
-        let w = arityOfVal v
-        let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v
-        let tps, witnessInfos, argInfos, rty, _ = GetTopValTypeInCompiledForm g w numEnclosingTypars v.Type v.Range
-        let name = v.CompiledName g.CompilerGlobalState
-        let prefix =
-          if w.NumCurriedArgs = 0 && isNil tps then "P:"
-          else "M:"
-        [], tps, witnessInfos, argInfos, rty, prefix, path, name
-
-  let witnessArgTys = GenWitnessTys g cxs
-  let argTys = argInfos |> List.concat |> List.map fst
-  let argTys = witnessArgTys @ argTys @ (match rty with Some t when full -> [t] | _ -> []) 
-  let args = XmlDocArgsEnc g (parentTypars, methTypars) argTys
-  let arity = List.length methTypars in (* C# XML doc adds ``<arity> to *generic* member names *)
-  let genArity = if arity=0 then "" else sprintf "``%d" arity
-  prefix + prependPath path name + genArity + args
+        match v.MemberInfo with 
+        | Some membInfo when not v.IsExtensionMember -> 
+
+            // Methods, Properties etc.
+            let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v
+            let tps, witnessInfos, argInfos, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags (Option.get v.ValReprInfo) numEnclosingTypars v.Type v.Range
+
+            let prefix, name = 
+                match membInfo.MemberFlags.MemberKind with 
+                | SynMemberKind.ClassConstructor 
+                | SynMemberKind.Constructor -> "M:", "#ctor"
+                | SynMemberKind.Member -> "M:", v.CompiledName g.CompilerGlobalState
+                | SynMemberKind.PropertyGetSet 
+                | SynMemberKind.PropertySet
+                | SynMemberKind.PropertyGet -> "P:", v.PropertyName
+
+            let path = if v.HasDeclaringEntity then prependPath path v.TopValDeclaringEntity.CompiledName else path
+
+            let parentTypars, methTypars = 
+                match PartitionValTypars g v with
+                | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars
+                | None -> [], tps
+
+            parentTypars, methTypars, witnessInfos, argInfos, rty, prefix, path, name
+
+        | _ ->
+            // Regular F# values and extension members 
+            let w = arityOfVal v
+            let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v
+            let tps, witnessInfos, argInfos, rty, _ = GetTopValTypeInCompiledForm g w numEnclosingTypars v.Type v.Range
+            let name = v.CompiledName g.CompilerGlobalState
+            let prefix =
+                if w.NumCurriedArgs = 0 && isNil tps then "P:"
+                else "M:"
+            [], tps, witnessInfos, argInfos, rty, prefix, path, name
+
+    let witnessArgTys = GenWitnessTys g cxs
+    let argTys = argInfos |> List.concat |> List.map fst
+    let argTys = witnessArgTys @ argTys @ (match rty with Some t when full -> [t] | _ -> []) 
+    let args = XmlDocArgsEnc g (parentTypars, methTypars) argTys
+    let arity = List.length methTypars
+    let genArity = if arity=0 then "" else sprintf "``%d" arity
+    prefix + prependPath path name + genArity + args
   
-let BuildXmlDocSig prefix paths = prefix + List.fold prependPath "" paths
+let BuildXmlDocSig prefix path = prefix + List.fold prependPath "" path
 
-let XmlDocSigOfUnionCase = BuildXmlDocSig "T:" // Would like to use "U:", but ParseMemberSignature only accepts C# signatures
+// Would like to use "U:", but ParseMemberSignature only accepts C# signatures
+let XmlDocSigOfUnionCase path = BuildXmlDocSig "T:" path
 
-let XmlDocSigOfField = BuildXmlDocSig "F:"
+let XmlDocSigOfField path = BuildXmlDocSig "F:" path
 
-let XmlDocSigOfProperty = BuildXmlDocSig "P:"
+let XmlDocSigOfProperty path = BuildXmlDocSig "P:" path
 
-let XmlDocSigOfTycon = BuildXmlDocSig "T:"
+let XmlDocSigOfTycon path = BuildXmlDocSig "T:" path
 
-let XmlDocSigOfSubModul = BuildXmlDocSig "T:"
+let XmlDocSigOfSubModul path = BuildXmlDocSig "T:" path
 
 let XmlDocSigOfEntity (eref: EntityRef) =
     XmlDocSigOfTycon [(buildAccessPath eref.CompilationPathOpt); eref.Deref.CompiledName]
@@ -9970,3 +9978,30 @@ let (|ResumableCodeInvoke|_|) g expr =
         Some (iref, f, args, m, (fun (f2, args2) -> Expr.App ((iref, a, b, (f2 :: args2), m))))
     | _ -> None
 
+let ComputeUseMethodImpl g (v: Val) =
+    v.ImplementedSlotSigs |> List.exists (fun slotsig ->
+        let oty = slotsig.ImplementedType
+        let otcref = tcrefOfAppTy g oty
+        let tcref = v.MemberApparentEntity
+
+        // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode
+        isInterfaceTy g oty &&
+
+        (let isCompare =
+            Option.isSome tcref.GeneratedCompareToValues &&
+             (typeEquiv g oty g.mk_IComparable_ty ||
+              tyconRefEq g g.system_GenericIComparable_tcref otcref)
+
+         not isCompare) &&
+
+        (let isGenericEquals =
+            Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues &&
+            tyconRefEq g g.system_GenericIEquatable_tcref otcref
+
+         not isGenericEquals) &&
+
+        (let isStructural =
+            (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv g oty g.mk_IStructuralComparable_ty) ||
+            (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv g oty g.mk_IStructuralEquatable_ty)
+
+         not isStructural))

src/fsharp/TypedTreeOps.fsi

@@ -2281,17 +2281,17 @@ val XmlDocArgsEnc: TcGlobals -> Typars * Typars -> TType list -> string
 
 val XmlDocSigOfVal: TcGlobals -> full: bool ->  string -> Val -> string
 
-val XmlDocSigOfUnionCase: (string list -> string)
+val XmlDocSigOfUnionCase: path: string list -> string
 
-val XmlDocSigOfField: (string list -> string)
+val XmlDocSigOfField: path: string list -> string
 
-val XmlDocSigOfProperty: (string list -> string)
+val XmlDocSigOfProperty: path: string list -> string
 
-val XmlDocSigOfTycon: (string list -> string)
+val XmlDocSigOfTycon: path: string list -> string
 
-val XmlDocSigOfSubModul: (string list -> string)
+val XmlDocSigOfSubModul: path: string list -> string
 
-val XmlDocSigOfEntity: EntityRef -> string
+val XmlDocSigOfEntity: eref: EntityRef -> string
 
 //---------------------------------------------------------------------------
 // Resolve static optimizations
@@ -2546,3 +2546,6 @@ val mkDebugPoint: m: range -> expr: Expr -> Expr
 
 /// Match an if...then...else expression or the result of "a && b" or "a || b"
 val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) option
+
+/// Determine if a value is a method implementing an interface dispatch slot using a private method impl
+val ComputeUseMethodImpl: g: TcGlobals -> v: Val -> bool
\ No newline at end of file

src/fsharp/XmlDocFileWriter.fs

@@ -18,87 +18,116 @@ module XmlDocWriter =
 
     let ComputeXmlDocSigs (tcGlobals, generatedCcu: CcuThunk) =
         let g = tcGlobals
-        let doValSig ptext (v: Val)  = if hasDoc v.XmlDoc then v.XmlDocSig <- XmlDocSigOfVal g false ptext v
+
+        let doValSig ptext (v: Val) =
+            if hasDoc v.XmlDoc then
+                v.XmlDocSig <- XmlDocSigOfVal g false ptext v
+
         let doTyconSig ptext (tc: Tycon) =
-            if (hasDoc tc.XmlDoc) then tc.XmlDocSig <- XmlDocSigOfTycon [ptext; tc.CompiledName]
+            if hasDoc tc.XmlDoc then
+                tc.XmlDocSig <- XmlDocSigOfTycon [ptext; tc.CompiledName]
+
             for vref in tc.MembersOfFSharpTyconSorted do
                 doValSig ptext vref.Deref
 
             for uc in tc.UnionCasesArray do
-                if (hasDoc uc.XmlDoc) then
+                if hasDoc uc.XmlDoc then
                     uc.XmlDocSig <- XmlDocSigOfUnionCase [ptext; tc.CompiledName; uc.Id.idText]
+
                 for field in uc.RecdFieldsArray do
-                    if (hasDoc field.XmlDoc) then
+                    if hasDoc field.XmlDoc then
                         // union case fields are exposed as properties
                         field.XmlDocSig <- XmlDocSigOfProperty [ptext; tc.CompiledName; uc.Id.idText; field.Id.idText]
 
             for rf in tc.AllFieldsArray do
-                if (hasDoc rf.XmlDoc) then
+                if hasDoc rf.XmlDoc then
                     rf.XmlDocSig <-
-                        if tc.IsRecordTycon && (not rf.IsStatic) then
+                        if tc.IsRecordTycon && not rf.IsStatic then
                             // represents a record field, which is exposed as a property
                             XmlDocSigOfProperty [ptext; tc.CompiledName; rf.Id.idText]
                         else
                             XmlDocSigOfField [ptext; tc.CompiledName; rf.Id.idText]
 
-        let doModuleMemberSig path (m: ModuleOrNamespace) = m.XmlDocSig <- XmlDocSigOfSubModul [path]
-        (* moduleSpec - recurses *)
+        let doModuleMemberSig path (m: ModuleOrNamespace) =
+            m.XmlDocSig <- XmlDocSigOfSubModul [path]
+
         let rec doModuleSig path (mspec: ModuleOrNamespace) =
             let mtype = mspec.ModuleOrNamespaceType
+
             let path =
-                (* skip the first item in the path which is the assembly name *)
+                // skip the first item in the path which is the assembly name
                 match path with
                 | None -> Some ""
                 | Some "" -> Some mspec.LogicalName
                 | Some p -> Some (p+"."+mspec.LogicalName)
-            let ptext = match path with None -> "" | Some t -> t
-            if mspec.IsModule then doModuleMemberSig ptext mspec
+
+            let ptext = defaultArg path ""
+
+            if mspec.IsModule then
+                doModuleMemberSig ptext mspec
+
             let vals =
                 mtype.AllValsAndMembers
                 |> Seq.toList
                 |> List.filter (fun x  -> not x.IsCompilerGenerated)
                 |> List.filter (fun x -> x.MemberInfo.IsNone || x.IsExtensionMember)
-            List.iter (doModuleSig  path)  mtype.ModuleAndNamespaceDefinitions
-            List.iter (doTyconSig  ptext) mtype.ExceptionDefinitions
-            List.iter (doValSig    ptext) vals
-            List.iter (doTyconSig  ptext) mtype.TypeDefinitions
+
+            mtype.ModuleAndNamespaceDefinitions |> List.iter (doModuleSig path)
+            mtype.ExceptionDefinitions |> List.iter (doTyconSig ptext)
+            vals |> List.iter (doValSig ptext)
+            mtype.TypeDefinitions |> List.iter (doTyconSig ptext)
 
         doModuleSig None generatedCcu.Contents
 
-    let WriteXmlDocFile (assemblyName, generatedCcu: CcuThunk, xmlfile) =
+    let WriteXmlDocFile (g, assemblyName, generatedCcu: CcuThunk, xmlfile) =
         if not (FileSystemUtils.hasSuffixCaseInsensitive "xml" xmlfile ) then
             error(Error(FSComp.SR.docfileNoXmlSuffix(), Range.rangeStartup))
 
         let mutable members = []
+
         let addMember id xmlDoc =
             if hasDoc xmlDoc then
                 let doc = xmlDoc.GetXmlText()
                 members <- (id, doc) :: members
-        let doVal (v: Val) = addMember v.XmlDocSig v.XmlDoc
-        let doField (rf: RecdField) = addMember rf.XmlDocSig rf.XmlDoc
+
+        let doVal (v: Val) =
+            addMember v.XmlDocSig v.XmlDoc
+
+        let doField (rf: RecdField) =
+            addMember rf.XmlDocSig rf.XmlDoc
+
         let doUnionCase (uc: UnionCase) =
             addMember uc.XmlDocSig uc.XmlDoc
             for field in uc.RecdFieldsArray do
                 addMember field.XmlDocSig field.XmlDoc
+
         let doTycon (tc: Tycon) = 
             addMember tc.XmlDocSig tc.XmlDoc
+
             for vref in tc.MembersOfFSharpTyconSorted do
-                doVal vref.Deref
+                if not (ComputeUseMethodImpl g vref.Deref) then
+                    doVal vref.Deref
+
             for uc in tc.UnionCasesArray do
                 doUnionCase uc
+
             for rf in tc.AllFieldsArray do
                 doField rf
 
-        let modulMember (m: ModuleOrNamespace) = addMember m.XmlDocSig m.XmlDoc
+        let modulMember (m: ModuleOrNamespace) =
+            addMember m.XmlDocSig m.XmlDoc
 
         let rec doModule (mspec: ModuleOrNamespace) =
             let mtype = mspec.ModuleOrNamespaceType
-            if mspec.IsModule then modulMember mspec
+            if mspec.IsModule then
+                modulMember mspec
+
             let vals =
                 mtype.AllValsAndMembers
                 |> Seq.toList
                 |> List.filter (fun x  -> not x.IsCompilerGenerated)
                 |> List.filter (fun x -> x.MemberInfo.IsNone || x.IsExtensionMember)
+
             List.iter doModule mtype.ModuleAndNamespaceDefinitions
             List.iter doTycon mtype.ExceptionDefinitions
             List.iter doVal vals
@@ -112,9 +141,11 @@ module XmlDocWriter =
         fprintfn os "<doc>"
         fprintfn os "<assembly><name>%s</name></assembly>" assemblyName
         fprintfn os "<members>"
-        members |> List.iter (fun (id, doc) ->
-            fprintfn os  "<member name=\"%s\">" id
+
+        for (nm, doc) in members do
+            fprintfn os  "<member name=\"%s\">" nm
             fprintfn os  "%s" doc
-            fprintfn os  "</member>")
+            fprintfn os  "</member>"
+
         fprintfn os "</members>"
         fprintfn os "</doc>"

src/fsharp/XmlDocFileWriter.fsi

@@ -15,4 +15,4 @@ module XmlDocWriter =
 
     /// Writes the XmlDocSig property of each element (field, union case, etc) 
     /// of the specified compilation unit to an XML document in a new text file.
-    val WriteXmlDocFile: assemblyName: string * generatedCcu: CcuThunk * xmlfile: string -> unit
+    val WriteXmlDocFile: g: TcGlobals * assemblyName: string * generatedCcu: CcuThunk * xmlfile: string -> unit

src/fsharp/fsc.fs

@@ -757,7 +757,7 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener
     ReportTime tcConfig "Write XML docs"
     tcConfig.xmlDocOutputFile |> Option.iter (fun xmlFile ->
         let xmlFile = tcConfig.MakePathAbsolute xmlFile
-        XmlDocWriter.WriteXmlDocFile (assemblyName, generatedCcu, xmlFile))
+        XmlDocWriter.WriteXmlDocFile (tcGlobals, assemblyName, generatedCcu, xmlFile))
 
     // Pass on only the minimum information required for the next phase
     Args (ctok, tcConfig, tcImports, frameworkTcImports, tcGlobals, errorLogger, generatedCcu, outfile, typedImplFiles, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter)

tests/FSharp.Test.Utilities/TestFramework.fs

@@ -113,7 +113,7 @@ module Commands =
     let directoryExists workDir path =
         if path |> getfullpath workDir |> Directory.Exists then Some path else None
 
-    let copy_y workDir source dest =
+    let copy workDir source dest =
         log "copy /y %s %s" source dest
         File.Copy( source |> getfullpath workDir, dest |> getfullpath workDir, true)
         CmdResult.Success
@@ -619,16 +619,16 @@ let fsiAnyCpu cfg = Printf.ksprintf (Commands.fsi (exec cfg) cfg.FSIANYCPU)
 let fsi_script cfg = Printf.ksprintf (Commands.fsi (exec cfg) cfg.FSI_FOR_SCRIPTS)
 let fsiExpectFail cfg = Printf.ksprintf (Commands.fsi (execExpectFail cfg) cfg.FSI)
 let fsiAppendIgnoreExitCode cfg stdoutPath stderrPath = Printf.ksprintf (Commands.fsi (execAppendIgnoreExitCode cfg stdoutPath stderrPath) cfg.FSI)
-let fileguard cfg = (Commands.getfullpath cfg.Directory) >> (fun x -> new FileGuard(x))
+let fileguard cfg fileName = Commands.getfullpath cfg.Directory fileName |> (fun x -> new FileGuard(x))
 let getfullpath cfg = Commands.getfullpath cfg.Directory
-let fileExists cfg = Commands.fileExists cfg.Directory >> Option.isSome
+let fileExists cfg fileName = Commands.fileExists cfg.Directory fileName |> Option.isSome
 let fsiStdin cfg stdinPath = Printf.ksprintf (Commands.fsi (execStdin cfg stdinPath) cfg.FSI)
 let fsiStdinAppendBothIgnoreExitCode cfg stdoutPath stderrPath stdinPath = Printf.ksprintf (Commands.fsi (execStdinAppendBothIgnoreExitCode cfg stdoutPath stderrPath stdinPath) cfg.FSI)
 let rm cfg x = Commands.rm cfg.Directory x
 let rmdir cfg x = Commands.rmdir cfg.Directory x
 let mkdir cfg = Commands.mkdir_p cfg.Directory
-let copy_y cfg f = Commands.copy_y cfg.Directory f >> checkResult
-let copySystemValueTuple cfg = copy_y cfg (getDirectoryName(cfg.FSC) ++ "System.ValueTuple.dll") ("." ++ "System.ValueTuple.dll")
+let copy cfg fromFile toFile = Commands.copy cfg.Directory fromFile toFile |> checkResult
+let copySystemValueTuple cfg = copy cfg (getDirectoryName(cfg.FSC) ++ "System.ValueTuple.dll") ("." ++ "System.ValueTuple.dll")
 
 let diff normalize path1 path2 =
     let result = System.Text.StringBuilder()

tests/fsharp/TypeProviderTests.fs

@@ -116,7 +116,7 @@ let helloWorld p =
     let bincompat1 = getfullpath cfg "bincompat1"
 
     Directory.EnumerateFiles(bincompat1 ++ "..", "*.dll")
-    |> Seq.iter (fun from -> Commands.copy_y bincompat1 from ("." ++ Path.GetFileName(from)) |> ignore)
+    |> Seq.iter (fun from -> Commands.copy bincompat1 from ("." ++ Path.GetFileName(from)) |> ignore)
 
     fscIn cfg bincompat1 "%s" "-g -a -o:test_lib.dll -r:provider.dll" [".." ++ "test.fsx"]
 
@@ -129,8 +129,8 @@ let helloWorld p =
     log "pushd bincompat2"
     let bincompat2 = getfullpath cfg "bincompat2"
 
-    Directory.EnumerateFiles(bincompat2 ++ ".." ++ "bincompat1", "*.dll")
-    |> Seq.iter (fun from -> Commands.copy_y bincompat2 from ("." ++ Path.GetFileName(from)) |> ignore)
+    for fromFile in Directory.EnumerateFiles(bincompat2 ++ ".." ++ "bincompat1", "*.dll") do
+        Commands.copy bincompat2 fromFile ("." ++ Path.GetFileName(fromFile)) |> ignore
 
     fscIn cfg bincompat2 "%s" "--define:ADD_AN_OPTIONAL_STATIC_PARAMETER --define:USE_IMPLICIT_ITypeProvider2 --out:provider.dll -g -a" [".." ++ "provider.fsx"]
 

tests/fsharp/core/xmldoc/lib.fs

+namespace XmlDoc
+
+open System.Collections
+open System.Collections.Generic
+
+type InterfaceImpl() =
+
+    interface IEnumerable with
+        /// This should not appear
+        member this.GetEnumerator() = failwith ""
+
+/// Simple type
+type SimpleType
+     /// Simple constructor
+     () =
+
+    /// Simple getter property
+    member this.P = 1
+
+    /// Simple setter property
+    member this.SetterProperty with get() = 1 and set (v: int) = ()
+
+    /// Simple method
+    member this.M() = 1

tests/fsharp/core/xmldoc/lib.xml.bsl

+<?xml version="1.0" encoding="utf-8"?>
+<doc>
+<assembly><name>lib</name></assembly>
+<members>
+<member name="P:XmlDoc.SimpleType.SetterProperty(System.Int32)">
+<summary>
+ Simple setter property
+</summary>
+</member>
+<member name="P:XmlDoc.SimpleType.SetterProperty">
+<summary>
+ Simple setter property
+</summary>
+</member>
+<member name="P:XmlDoc.SimpleType.P">
+<summary>
+ Simple getter property
+</summary>
+</member>
+<member name="M:XmlDoc.SimpleType.M">
+<summary>
+ Simple method
+</summary>
+</member>
+<member name="M:XmlDoc.SimpleType.#ctor">
+<summary>
+ Simple constructor
+</summary>
+</member>
+<member name="T:XmlDoc.SimpleType">
+<summary>
+ Simple type
+</summary>
+</member>
+</members>
+</doc>

tests/fsharp/single-test.fs

@@ -327,7 +327,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion =
             |> List.rev
             |> List.tryFind (fileExists cfg)
 
-        source1 |> Option.iter (fun from -> copy_y cfg from "tmptest.fs")
+        source1 |> Option.iter (fun from -> copy cfg from "tmptest.fs")
 
         log "Generated signature file..."
         fsc cfg "%s --sig:tmptest.fsi --define:FSC_NETFX_TEST_GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"]

tests/fsharp/tests.fs

@@ -819,9 +819,9 @@ module CoreTests =
 
         csc cfg """/nologo  /target:library /r:split\a-part1.dll /out:split\a.dll /define:PART2;SPLIT""" ["a.cs"]
 
-        copy_y cfg ("orig" ++ "b.dll") ("split" ++ "b.dll")
+        copy cfg ("orig" ++ "b.dll") ("split" ++ "b.dll")
 
-        copy_y cfg ("orig" ++ "c.dll") ("split" ++ "c.dll")
+        copy cfg ("orig" ++ "c.dll") ("split" ++ "c.dll")
 
         fsc cfg """-o:orig\test.exe -r:orig\b.dll -r:orig\a.dll""" ["test.fs"]
 
@@ -835,6 +835,22 @@ module CoreTests =
 
         peverify cfg ("split" ++ "c.dll")
 
+    [<Test>]
+    let xmldoc () =
+        let cfg = testConfig "core/xmldoc"
+
+        fsc cfg "%s -a --doc:lib.xml -o:lib.dll -g" cfg.fsc_flags ["lib.fs"]
+        let outFile = "lib.xml"
+        let expectedFile = "lib.xml.bsl"
+
+        if not (fileExists cfg expectedFile) then
+            copy cfg outFile expectedFile
+
+        let diffs = fsdiff cfg outFile expectedFile
+        match diffs with
+        | "" -> ()
+        | _ -> Assert.Fail (sprintf "'%s' and '%s' differ; %A" outFile expectedFile diffs)
+
     [<Test>]
     let fsfromcs () =
         let cfg = testConfig "core/fsfromcs"
@@ -1036,8 +1052,6 @@ module CoreTests =
 
        if requireENCulture () then
 
-        let copy from' = Commands.copy_y cfg.Directory from' >> checkResult
-
         let ``fsi <a >b 2>c`` =
             // "%FSI%" %fsc_flags_errors_ok%  --nologo                                    <test.fsx >z.raw.output.test.default.txt 2>&1
             let ``exec <a >b 2>c`` (inFile, outFile, errFile) p =
@@ -1059,13 +1073,12 @@ module CoreTests =
         removeCDandHelp rawFileOut diffFileOut
         removeCDandHelp rawFileErr diffFileErr
 
-        let withDefault default' to' =
-            if not (fileExists cfg to') then copy default' to'
+        let withDefault defaultFile toFile =
+            if not (fileExists cfg toFile) then copy cfg defaultFile toFile
 
         expectedFileOut |> withDefault diffFileOut
         expectedFileErr |> withDefault diffFileErr
 
-
         match fsdiff cfg diffFileOut expectedFileOut with
         | "" -> ()
         | diffs -> Assert.Fail (sprintf "'%s' and '%s' differ; %A" diffFileOut expectedFileOut diffs)