re-add changes/files removed during a hasty cherry-pick

Author: brettfo

src/fsharp/TastPickle.fs

@@ -12337,24 +12337,17 @@ module TcRecdUnionAndEnumDeclarations = begin
         let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method
         let vis, _ = ComputeAccessAndCompPath env None m vis None parent
         let vis = CombineReprAccess parent vis
-        let realUnionCaseName =  
-            if id.idText = opNameCons then "Cons" 
-            elif id.idText = opNameNil then "Empty"
-            else id.idText
-            
-        if realUnionCaseName = "Tags" then
-            errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(realUnionCaseName, "Tags"), m))
-                        
-        CheckUnionCaseName cenv realUnionCaseName id.idRange 
-        
+
+        CheckUnionCaseName cenv id
+
         let mkName nFields i = if nFields <= 1 then "Item" else "Item"+string (i+1)
         let rfields, recordTy = 
             match args with
             | UnionCaseFields flds -> 
                 let nFields = flds.Length
                 let rfields = flds |> List.mapi (fun i fld -> TcAnonFieldDecl cenv env parent tpenv (mkName nFields i) fld)
                 ValidateFieldNames(flds, rfields)
-                
+
                 rfields, thisTy
             | UnionCaseFullType (ty, arity) -> 
                 let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty
@@ -12370,7 +12363,7 @@ module TcRecdUnionAndEnumDeclarations = begin
                 if not (typeEquiv cenv.g recordTy thisTy) then 
                     error(Error(FSComp.SR.tcReturnTypesForUnionMustBeSameAsType(), m))
                 rfields, recordTy
-        NewUnionCase id realUnionCaseName rfields recordTy attrs (xmldoc.ToXmlDoc()) vis
+        NewUnionCase id rfields recordTy attrs (xmldoc.ToXmlDoc()) vis
 
 
     let TcUnionCaseDecls cenv env parent (thisTy: TType) tpenv unionCases =
@@ -15621,8 +15614,8 @@ module EstablishTypeDefinitionCores =
 
                     structLayoutAttributeCheck(false)
                     noAllowNullLiteralAttributeCheck()
-                    TcRecdUnionAndEnumDeclarations.CheckUnionCaseName  cenv unionCaseName.idText unionCaseName.idRange
-                    let unionCase = NewUnionCase unionCaseName unionCaseName.idText [] thisTy [] XmlDoc.Empty tycon.Accessibility
+                    TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName
+                    let unionCase = NewUnionCase unionCaseName [] thisTy [] XmlDoc.Empty tycon.Accessibility
                     writeFakeUnionCtorsToSink [ unionCase ]
                     MakeUnionRepr [ unionCase ], None, NoSafeInitInfo
 

src/fsharp/TypeChecker.fs

@@ -1598,9 +1598,6 @@ and
       /// Return type constructed by the case. Normally exactly the type of the enclosing type, sometimes an abbreviation of it 
       ReturnType: TType
 
-      /// Name of the case in generated IL code 
-      CompiledName: string
-
       /// Documentation for the case 
       XmlDoc: XmlDoc
 
@@ -1636,6 +1633,13 @@ and
 
     member uc.DisplayName = uc.Id.idText
 
+    /// Name of the case in generated IL code.
+    member uc.CompiledName =
+        let idText = uc.Id.idText
+        if idText = opNameCons then "Cons" 
+        elif idText = opNameNil then "Empty"
+        else idText
+
     member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex 
 
     member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList
@@ -5662,7 +5666,6 @@ let NewRigidTypar nm m = NewTypar (TyparKind.Type, TyparRigidity.Rigid, Typar(mk
 
 let NewUnionCase id tys rty attribs docOption access: UnionCase = 
     { Id=id
-      CompiledName=nm
       XmlDoc=docOption
       XmlDocSig=""
       Accessibility=access

src/fsharp/tast.fs

@@ -0,0 +1,86 @@
+#if INTERACTIVE
+#r "../../artifacts/bin/fcs/net46/FSharp.Compiler.Service.dll" // note, build FSharp.Compiler.Service.Tests.fsproj to generate this, this DLL has a public API so can be used from F# Interactive
+#r "../../artifacts/bin/fcs/net46/nunit.framework.dll"
+#load "FsUnit.fs"
+#load "Common.fs"
+#else
+module Tests.Service.AssemblyContentProviderTests
+#endif
+
+open System
+open System.IO
+open System.Text
+open NUnit.Framework
+open FSharp.Compiler.SourceCodeServices
+
+let private filePath = "C:\\test.fs"
+
+let private projectOptions : FSharpProjectOptions = 
+    { ProjectFileName = "C:\\test.fsproj"
+      ProjectId = None
+      SourceFiles =  [| filePath |]
+      ReferencedProjects = [| |]
+      OtherOptions = [| |]
+      IsIncompleteTypeCheckEnvironment = true
+      UseScriptResolutionRules = false
+      LoadTime = DateTime.MaxValue
+      OriginalLoadReferences = []
+      UnresolvedReferences = None
+      ExtraProjectInfo = None
+      Stamp = None }
+
+let private checker = FSharpChecker.Create()
+
+let (=>) (source: string) (expected: string list) =
+    let lines =
+        use reader = new StringReader(source)
+        [| let line = ref (reader.ReadLine())
+           while not (isNull !line) do
+               yield !line
+               line := reader.ReadLine()
+           if source.EndsWith "\n" then
+               // last trailing space not returned
+               // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak
+               yield "" |]
+
+    let _, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, 0, source, projectOptions) |> Async.RunSynchronously
+    
+    let checkFileResults =
+        match checkFileAnswer with
+        | FSharpCheckFileAnswer.Aborted -> failwithf "ParseAndCheckFileInProject aborted"
+        | FSharpCheckFileAnswer.Succeeded(checkFileResults) -> checkFileResults
+
+    let actual = 
+        AssemblyContentProvider.getAssemblySignatureContent AssemblyContentType.Full checkFileResults.PartialAssemblySignature
+        |> List.map (fun x -> x.CleanedIdents |> String.concat ".") 
+        |> List.sort
+
+    let expected = List.sort expected
+
+    if actual <> expected then failwithf "\n\nExpected\n\n%A\n\nbut was\n\n%A" expected actual
+
+[<Test>]
+let ``implicitly added Module suffix is removed``() =
+    """
+type MyType = { F: int }
+
+module MyType =
+    let func123 x = x
+"""
+    => ["Test"
+        "Test.MyType"
+        "Test.MyType"
+        "Test.MyType.func123"]
+        
+[<Test>]
+let ``Module suffix added by an xplicitly applied MuduleSuffix attribute is removed``() =
+    """
+[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module MyType =
+    let func123 x = x
+"""
+    => [ "Test"
+         "Test.MyType"
+         "Test.MyType.func123" ]
+
+

tests/service/AssemblyContentProviderTests.fs

@@ -0,0 +1,33 @@
+#if INTERACTIVE
+#r "../../artifacts/bin/fcs/net46/FSharp.Compiler.Service.dll" // note, build FSharp.Compiler.Service.Tests.fsproj to generate this, this DLL has a public API so can be used from F# Interactive
+#r "../../artifacts/bin/fcs/net46/nunit.framework.dll"
+#load "FsUnit.fs"
+#load "Common.fs"
+#else
+module FSharp.Compiler.Service.Tests.AssemblyReaderShim
+#endif
+
+open FSharp.Compiler.Service.Tests.Common
+open FsUnit
+open FSharp.Compiler.AbstractIL.ILBinaryReader
+open NUnit.Framework
+
+[<Test>]
+let ``Assembly reader shim gets requests`` () =
+    let defaultReader = Shim.AssemblyReader
+    let mutable gotRequest = false
+    let reader =
+        { new IAssemblyReader with
+            member x.GetILModuleReader(path, opts) =
+                gotRequest <- true
+                defaultReader.GetILModuleReader(path, opts)
+        }
+    Shim.AssemblyReader <- reader
+    let source = """
+module M
+let x = 123
+"""
+
+    let fileName, options = Common.mkTestFileAndOptions source [| |]
+    Common.checker.ParseAndCheckFileInProject(fileName, 0, source, options) |> Async.RunSynchronously |> ignore
+    gotRequest |> should be True