Fix #3113 by porting the relevant roslyn codeand integrate it into the codebase (#7024)

Author: matthid

.gitignore

@@ -117,7 +117,8 @@ source_link.json
 .vs/
 System.ValueTuple.dll
 tests/fsharpqa/testenv/bin/System.ValueTuple.dll
-*/.fake
+**/.fake
+.ionide
 /fcs/packages/
 */paket-files/
 /fcs/TestResult.xml

fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -225,6 +225,18 @@
     </Compile>
   </ItemGroup>
   <ItemGroup>
+    <Compile Include="$(FSharpSourcesRoot)/absil/writenativeres.fsi">
+      <Link>AbsIL/writenativeres.fsi</Link>
+    </Compile>
+    <Compile Include="$(FSharpSourcesRoot)/absil/writenativeres.fs">
+      <Link>AbsIL/writenativeres.fs</Link>
+    </Compile>
+    <Compile Include="$(FSharpSourcesRoot)/absil/cvtres.fsi">
+      <Link>AbsIL/cvtres.fsi</Link>
+    </Compile>
+    <Compile Include="$(FSharpSourcesRoot)/absil/cvtres.fs">
+      <Link>AbsIL/cvtres.fs</Link>
+    </Compile>
     <Compile Include="$(FSharpSourcesRoot)/absil/ilsupp.fsi">
       <Link>AbsIL/ilsupp.fsi</Link>
     </Compile>

src/absil/cvtres.fs

@@ -0,0 +1,37 @@
+module internal FSharp.Compiler.AbstractIL.Internal.CVTres
+
+open System
+open System.IO
+
+type BYTE = System.Byte
+type DWORD = System.UInt32
+type WCHAR = System.Char
+type WORD = System.UInt16
+
+[<Class>]
+type RESOURCE_STRING =
+    member Ordinal: WORD with get, set
+    member theString : string with get, set
+
+[<Class>]
+type RESOURCE =
+    member pstringType : RESOURCE_STRING with get, set
+    member pstringName : RESOURCE_STRING with get, set
+    member DataSize : DWORD with get, set
+    member HeaderSize : DWORD with get, set
+    member DataVersion : DWORD with get, set
+    member MemoryFlags : WORD with get, set
+    member LanguageId : WORD with get, set
+    member Version : DWORD with get, set
+    member Characteristics : DWORD with get, set
+    member data : byte[] with get, set
+
+[<Class>]
+type CvtResFile =
+    static member ReadResFile : stream:Stream -> System.Collections.Generic.List<RESOURCE>
+
+[<Class>]
+type Win32ResourceConversions =
+    static member AppendIconToResourceStream : resStream:Stream * iconStream:Stream -> unit
+    static member AppendVersionToResourceStream : resStream:Stream * isDll:System.Boolean * fileVersion:string * originalFileName:string * internalName:string * productVersion:string * assemblyVersion:Version * ?fileDescription:string * ?legalCopyright:string * ?legalTrademarks:string * ?productName:string * ?comments:string * ?companyName:string -> unit 
+    static member AppendManifestToResourceStream : resStream:Stream * manifestStream:Stream * isDll:System.Boolean -> unit 

src/absil/cvtres.fsi

@@ -20,9 +20,7 @@ open Internal.Utilities
 open Internal.Utilities.Collections
 open FSharp.Compiler.AbstractIL 
 open FSharp.Compiler.AbstractIL.Internal 
-#if !FX_NO_PDB_READER
-open FSharp.Compiler.AbstractIL.Internal.Support 
-#endif
+open FSharp.Compiler.AbstractIL.Internal.Support
 open FSharp.Compiler.AbstractIL.Diagnostics 
 open FSharp.Compiler.AbstractIL.Internal.BinaryConstants 
 open FSharp.Compiler.AbstractIL.IL  
@@ -1551,14 +1549,10 @@ let readNativeResources (pectxt: PEReader) =
     [ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then 
         let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr)
         if pectxt.noFileOnDisk then
-#if !FX_NO_LINKEDRESOURCES
             let unlinkedResource =
                 let linkedResource = seekReadBytes (pectxt.pefile.GetView()) start pectxt.nativeResourcesSize
                 unlinkResource pectxt.nativeResourcesAddr linkedResource
             yield ILNativeResource.Out unlinkedResource
-#else
-            ()
-#endif
         else
             yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ]
 

src/absil/ilread.fs

@@ -22,16 +22,15 @@ open System.Diagnostics.SymbolStore
 open System.Runtime.InteropServices
 open System.Runtime.CompilerServices
 
+
 let DateTime1970Jan01 = new DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *)
 let absilWriteGetTimeStamp () = (DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int
 
-#if !FX_NO_LINKEDRESOURCES
 // Force inline, so GetLastWin32Error calls are immediately after interop calls as seen by FxCop under Debug build.
 let inline ignore _x = ()
 
 // Native Resource linking/unlinking
 type IStream = System.Runtime.InteropServices.ComTypes.IStream
-#endif
 
 let check _action (hresult) =
   if uint32 hresult >= 0x80000000ul then
@@ -56,7 +55,6 @@ let bytesToQWord ((b0: byte), (b1: byte), (b2: byte), (b3: byte), (b4: byte), (b
 let dwToBytes n = [| byte (n &&& 0xff) ; byte ((n >>> 8) &&& 0xff) ; byte ((n >>> 16) &&& 0xff) ; byte ((n >>> 24) &&& 0xff) |], 4
 let wToBytes (n: int16) = [| byte (n &&& 0xffs) ; byte ((n >>> 8) &&& 0xffs) |], 2
 
-#if !FX_NO_LINKEDRESOURCES
 // REVIEW: factor these classes under one hierarchy, use reflection for creation from buffer and toBytes()
 // Though, everything I'd like to unify is static - metaclasses?
 type IMAGE_FILE_HEADER (m: int16, secs: int16, tds: int32, ptst: int32, nos: int32, soh: int16, c: int16) =
@@ -583,7 +581,7 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink
 
         !size
 
-let linkNativeResources (unlinkedResources: byte[] list)  (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
+let linkNativeResourcesViaCVTres (unlinkedResources: byte[] list)  (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) = 
     let nPEFileType = match fileType with X86  -> 0 | X64 -> 2
     let mutable tempResFiles: string list = []
     let mutable objBytes: byte[] = [||]
@@ -751,6 +749,39 @@ let linkNativeResources (unlinkedResources: byte[] list)  (ulLinkedResourceBaseR
         // return the buffer
         pResBuffer
 
+let linkNativeResourcesManaged (unlinkedResources: byte[] list)  (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
+   ignore fileType
+   ignore outputFilePath
+   
+   let resources =
+       unlinkedResources
+       |> Seq.map (fun s -> new MemoryStream(s))
+       |> Seq.map (fun s -> 
+           let res = CVTres.CvtResFile.ReadResFile s
+           s.Dispose()
+           res)
+       |> Seq.collect id
+       // See MakeWin32ResourceList https://github.com/dotnet/roslyn/blob/f40b89234db51da1e1153c14af184e618504be41/src/Compilers/Core/Portable/Compilation/Compilation.cs
+       |> Seq.map (fun r -> 
+           WriteNativeRes.Win32Resource(data = r.data, codePage = 0u, languageId = uint32 r.LanguageId, 
+                               id = int (int16 r.pstringName.Ordinal), name = r.pstringName.theString,
+                               typeId = int (int16 r.pstringType.Ordinal), typeName = r.pstringType.theString))
+   let bb = new System.Reflection.Metadata.BlobBuilder()
+   WriteNativeRes.NativeResourceWriter.SerializeWin32Resources(bb, resources, ulLinkedResourceBaseRVA)
+   bb.ToArray()
+
+let linkNativeResources (unlinkedResources: byte[] list)  (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) =
+#if ENABLE_MONO_SUPPORT
+    if IL.runningOnMono then
+        linkNativeResourcesManaged unlinkedResources ulLinkedResourceBaseRVA fileType outputFilePath
+    else
+#endif
+#if !FX_NO_LINKEDRESOURCES
+        linkNativeResourcesViaCVTres unlinkedResources ulLinkedResourceBaseRVA fileType outputFilePath
+#else
+        linkNativeResourcesManaged unlinkedResources ulLinkedResourceBaseRVA fileType outputFilePath
+#endif
+
 let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) =
     let mutable nResNodes = 0
 
@@ -854,7 +885,6 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) =
             resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset)
 
     pResBuffer
-#endif
 
 #if !FX_NO_PDB_WRITER
 // PDB Writing

src/absil/ilsupp.fs

@@ -29,20 +29,16 @@ open FSharp.Compiler.AbstractIL
 open FSharp.Compiler.AbstractIL.Internal
 open FSharp.Compiler.AbstractIL.IL 
 
-#if !FX_NO_LINKEDRESOURCES
 type IStream = System.Runtime.InteropServices.ComTypes.IStream
-#endif
 
 /// Unmanaged resource file linker - for native resources (not managed ones).
 /// The function may be called twice, once with a zero-RVA and
 /// arbitrary buffer, and once with the real buffer.  The size of the
 /// required buffer is returned.
 type PEFileType = X86 | X64
 
-#if !FX_NO_LINKEDRESOURCES
 val linkNativeResources: unlinkedResources:byte[] list ->  rva:int32 -> PEFileType -> tempFilePath:string -> byte[]
 val unlinkResource: int32 -> byte[] -> byte[]
-#endif
 
 #if !FX_NO_PDB_WRITER
 /// PDB reader and associated types

src/absil/ilsupp.fsi

@@ -3744,28 +3744,18 @@ let writeBinaryAndReportMappings (outfile,
             match modul.NativeResources with
             | [] -> [||]
             | resources ->
-#if ENABLE_MONO_SUPPORT
-                if runningOnMono then
-                  [||]
-                else
-#endif
-#if FX_NO_LINKEDRESOURCES
-                  ignore resources
-                  ignore resourceFormat
-                  [||]
-#else
-                  let unlinkedResources = 
-                      resources |> List.map (function 
-                          | ILNativeResource.Out bytes -> bytes
-                          | ILNativeResource.In (fileName, linkedResourceBase, start, len) -> 
-                               let linkedResource = File.ReadBinaryChunk (fileName, start, len)
-                               unlinkResource linkedResourceBase linkedResource)
-                               
-                  begin
-                    try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName outfile)
-                    with e -> failwith ("Linking a native resource failed: "+e.Message+"")
-                  end
-#endif
+                let unlinkedResources = 
+                    resources |> List.map (function 
+                        | ILNativeResource.Out bytes -> bytes
+                        | ILNativeResource.In (fileName, linkedResourceBase, start, len) -> 
+                             let linkedResource = File.ReadBinaryChunk (fileName, start, len)
+                             unlinkResource linkedResourceBase linkedResource)
+                             
+                begin
+                  try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName outfile)
+                  with e -> failwith ("Linking a native resource failed: "+e.Message+"")
+                end
+
           let nativeResourcesSize = nativeResources.Length
 
           let nativeResourcesChunk, next = chunk nativeResourcesSize next
@@ -4169,14 +4159,12 @@ let writeBinaryAndReportMappings (outfile,
 
           writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize)
 
-          // DATA SECTION 
-#if !FX_NO_LINKEDRESOURCES
+          // DATA SECTION
           match nativeResources with
           | [||] -> ()
           | resources ->
                 write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |]
                 writeBytes os resources
-#endif
 
           if dummydatap.size <> 0x0 then
               write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |]