提交 aa3cc293 编写于 作者: K KevinRansom

Enable coreclr build of fsharp.compiler.dll, improve testframework for coreclr test cases

上级 4206a5d6
...@@ -94,6 +94,7 @@ vsintegration/src/vs/FsPkgs/FSharp.Project/FS/FSharp.ProjectSystem.FSharp.fsi ...@@ -94,6 +94,7 @@ vsintegration/src/vs/FsPkgs/FSharp.Project/FS/FSharp.ProjectSystem.FSharp.fsi
vsintegration/src/vs/FsPkgs/FSharp.Project/FS/ctofiles/ vsintegration/src/vs/FsPkgs/FSharp.Project/FS/ctofiles/
tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Utils.dll tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Utils.dll
tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.dll tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.dll
tests/fsharp/optimize/stats/stats.txt
*.csproj.user *.csproj.user
......
...@@ -33,12 +33,15 @@ if not exist %_ngenexe% echo Error: Could not find ngen.exe. && goto :failure ...@@ -33,12 +33,15 @@ if not exist %_ngenexe% echo Error: Could not find ngen.exe. && goto :failure
%_msbuildexe% src/fsharp-library-build.proj /p:Configuration=Release %_msbuildexe% src/fsharp-library-build.proj /p:Configuration=Release
@if ERRORLEVEL 1 echo Error: library build failed && goto :failure @if ERRORLEVEL 1 echo Error: library build failed && goto :failure
%_msbuildexe% src/fsharp-compiler-build.proj /p:Configuration=Release
@if ERRORLEVEL 1 echo Error: compiler build failed && goto :failure
%_msbuildexe% src/fsharp-library-build.proj /p:TargetFramework=coreclr /p:Configuration=Release /p:RestorePackages=true %_msbuildexe% src/fsharp-library-build.proj /p:TargetFramework=coreclr /p:Configuration=Release /p:RestorePackages=true
@if ERRORLEVEL 1 echo Error: library coreclr build failed && goto :failure @if ERRORLEVEL 1 echo Error: library coreclr build failed && goto :failure
%_msbuildexe% src/fsharp-compiler-build.proj /p:TargetFramework=coreclr /p:Configuration=Release /p:RestorePackages=true
@if ERRORLEVEL 1 echo Error: compiler coreclr build failed && goto :failure
%_msbuildexe% src/fsharp-compiler-build.proj /p:Configuration=Release
@if ERRORLEVEL 1 echo Error: compiler build failed && goto :failure
%_msbuildexe% src/fsharp-library-build.proj /p:TargetFramework=portable47 /p:Configuration=Release %_msbuildexe% src/fsharp-library-build.proj /p:TargetFramework=portable47 /p:Configuration=Release
@if ERRORLEVEL 1 echo Error: library portable47 build failed && goto :failure @if ERRORLEVEL 1 echo Error: library portable47 build failed && goto :failure
......
...@@ -6,7 +6,7 @@ WARNING: DO NOT MODIFY this file unless you are knowledgeable about MSBuild and ...@@ -6,7 +6,7 @@ WARNING: DO NOT MODIFY this file unless you are knowledgeable about MSBuild and
created a backup copy. Incorrect changes to this file will make it created a backup copy. Incorrect changes to this file will make it
impossible to load or build your projects from the command-line or the IDE. impossible to load or build your projects from the command-line or the IDE.
Copyright (C) Microsoft Corporation. All rights reserved. Copyright (C) Microsoft Corporation. Apache 2.0 License.
*********************************************************************************************** ***********************************************************************************************
--> -->
...@@ -59,7 +59,6 @@ Copyright (C) Microsoft Corporation. All rights reserved. ...@@ -59,7 +59,6 @@ Copyright (C) Microsoft Corporation. All rights reserved.
<Exec Condition="'$(EnsureThereAreNoUnusedFsSrGenResources)'!='false' And '$(BuildingInsideVisualStudio)'!='true'" <Exec Condition="'$(EnsureThereAreNoUnusedFsSrGenResources)'!='false' And '$(BuildingInsideVisualStudio)'!='true'"
Command="$(FSharpSourcesRoot)\..\lkg\FSharp-$(LkgVersion)\bin\FindUnusedResources.exe %(FsSrGen.FullPath) $(FSharpSourcesRoot)" /> Command="$(FSharpSourcesRoot)\..\lkg\FSharp-$(LkgVersion)\bin\FindUnusedResources.exe %(FsSrGen.FullPath) $(FSharpSourcesRoot)" />
</Target> </Target>
<ItemGroup> <ItemGroup>
<AvailableItemName Include="FsSrGen"> <AvailableItemName Include="FsSrGen">
<Visible>false</Visible> <Visible>false</Visible>
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
<packages> <packages>
<package id="dnx-coreclr-win-x86" version="1.0.0-beta6-12032" /> <package id="dnx-coreclr-win-x86" version="1.0.0-beta6-12032" />
<package id="dnx-mono" version="1.0.0-beta5-12077" /> <package id="dnx-mono" version="1.0.0-beta5-12077" />
<package id="Microsoft.DotNet.BuildTools" version="1.0.25-prerelease-00053" /> <package id="Microsoft.DotNet.BuildTools" version="1.0.25-prerelease-00085" />
<package id="NUnit" version="2.6.4" targetFramework="net40" /> <package id="NUnit" version="2.6.4" targetFramework="net40" />
<package id="NUnit.Runners" version="2.6.4" /> <package id="NUnit.Runners" version="2.6.4" />
<package id="FSharp.Data" version="2.2.5" /> <package id="FSharp.Data" version="2.2.5" />
......
...@@ -3,6 +3,9 @@ ...@@ -3,6 +3,9 @@
<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> <Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Choose> <Choose>
<When Condition="'$(Configuration)' == 'Debug' or '$(Configuration)' == 'Release' or '$(Configuration)' == 'VSDebug' or '$(Configuration)' == 'VSRelease' "> <When Condition="'$(Configuration)' == 'Debug' or '$(Configuration)' == 'Release' or '$(Configuration)' == 'VSDebug' or '$(Configuration)' == 'VSRelease' ">
<PropertyGroup>
<SkipSigning>true</SkipSigning><!-- Skip using the ,net toolset to generate signing . -->
</PropertyGroup>
<Choose> <Choose>
<When Condition="'$(ProjectLanguage)' == 'FSharp'"> <When Condition="'$(ProjectLanguage)' == 'FSharp'">
<Choose> <Choose>
...@@ -33,12 +36,12 @@ ...@@ -33,12 +36,12 @@
</PropertyGroup> </PropertyGroup>
</When> </When>
<Otherwise> <Otherwise>
<PropertyGroup Condition="'$(SIGN_WITH_MSFT_KEY)' == 'true'"> <PropertyGroup Condition="'$(SIGN_WITH_MSFT_KEY)' == 'true' or '$(TargetFramework)' == 'coreclr'">
<OtherFlags>$(OtherFlags) --version:4.4.0.9055 --delaysign+ --keyfile:"$(FSharpSourcesRoot)\fsharp\msft.pubkey"</OtherFlags> <OtherFlags>$(OtherFlags) --version:4.4.0.9055 --delaysign+ --keyfile:"$(FSharpSourcesRoot)\fsharp\msft.pubkey"</OtherFlags>
<DefineConstants>STRONG_NAME_AND_DELAY_SIGN_FSHARP_COMPILER_WITH_MSFT_KEY;$(DefineConstants)</DefineConstants> <DefineConstants>STRONG_NAME_AND_DELAY_SIGN_FSHARP_COMPILER_WITH_MSFT_KEY;$(DefineConstants)</DefineConstants>
<StrongNames>true</StrongNames> <StrongNames>true</StrongNames>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(SIGN_WITH_MSFT_KEY)' != 'true'"> <PropertyGroup Condition="'$(SIGN_WITH_MSFT_KEY)' != 'true' and '$(TargetFramework)' != 'coreclr'">
<OtherFlags>$(OtherFlags) --version:4.4.0.9055 --keyfile:"$(FSharpSourcesRoot)\fsharp\test.snk"</OtherFlags> <OtherFlags>$(OtherFlags) --version:4.4.0.9055 --keyfile:"$(FSharpSourcesRoot)\fsharp\test.snk"</OtherFlags>
<DefineConstants>STRONG_NAME_FSHARP_COMPILER_WITH_TEST_KEY;$(DefineConstants)</DefineConstants> <DefineConstants>STRONG_NAME_FSHARP_COMPILER_WITH_TEST_KEY;$(DefineConstants)</DefineConstants>
<StrongNames>true</StrongNames> <StrongNames>true</StrongNames>
...@@ -125,6 +128,10 @@ ...@@ -125,6 +128,10 @@
<DefineConstants>$(DefineConstants);FX_NO_CUSTOMATTRIBUTEDATA</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_CUSTOMATTRIBUTEDATA</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_BIGINT</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_BIGINT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_CONDITIONAL_WEAK_TABLE</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_CONDITIONAL_WEAK_TABLE</DefineConstants>
<DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_MSBUILDRESOLVER_RUNTIMELIKE</DefineConstants>
<DefineConstants>$(DefineConstants);TYPE_PROVIDER_SECURITY</DefineConstants>
<DefineConstants>$(DefineConstants);FX_LCIDFROMCODEPAGE</DefineConstants>
<OtherFlags>$(OtherFlags) --simpleresolution</OtherFlags> <OtherFlags>$(OtherFlags) --simpleresolution</OtherFlags>
</PropertyGroup> </PropertyGroup>
...@@ -138,6 +145,13 @@ ...@@ -138,6 +145,13 @@
<DefineConstants>$(DefineConstants);QUERIES_IN_FSLIB</DefineConstants> <DefineConstants>$(DefineConstants);QUERIES_IN_FSLIB</DefineConstants>
<DefineConstants>$(DefineConstants);PUT_TYPE_PROVIDERS_IN_FSCORE;</DefineConstants> <DefineConstants>$(DefineConstants);PUT_TYPE_PROVIDERS_IN_FSCORE;</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_LINQ</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_LINQ</DefineConstants>
<DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_MSBUILDRESOLVER_RUNTIMELIKE</DefineConstants>
<DefineConstants>$(DefineConstants);TYPE_PROVIDER_SECURITY</DefineConstants>
<DefineConstants>$(DefineConstants);FX_LCIDFROMCODEPAGE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESX_RESOURCE_READER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESIDENT_COMPILER</DefineConstants>
<TargetFrameworkProfile></TargetFrameworkProfile> <TargetFrameworkProfile></TargetFrameworkProfile>
<!-- MSbuild works out the assembly references --> <!-- MSbuild works out the assembly references -->
</PropertyGroup> </PropertyGroup>
...@@ -146,27 +160,44 @@ ...@@ -146,27 +160,44 @@
<TargetFrameworkVersion>v4.5</TargetFrameworkVersion> <TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
<DefineConstants>$(DefineConstants);FSHARP_CORE_4_5</DefineConstants> <DefineConstants>$(DefineConstants);FSHARP_CORE_4_5</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_BEGINEND_READWRITE</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_BEGINEND_READWRITE</DefineConstants>
<DefineConstants Condition="'$(Configuration)'!='Proto'">$(DefineConstants);FX_ATLEAST_45</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_45</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_40</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_40</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_35</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_35</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_PORTABLE</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_PORTABLE</DefineConstants>
<DefineConstants>$(DefineConstants);QUERIES_IN_FSLIB</DefineConstants> <DefineConstants>$(DefineConstants);QUERIES_IN_FSLIB</DefineConstants>
<DefineConstants>$(DefineConstants);PUT_TYPE_PROVIDERS_IN_FSCORE;</DefineConstants> <DefineConstants>$(DefineConstants);PUT_TYPE_PROVIDERS_IN_FSCORE;</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_LINQ</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_LINQ</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_GLOBALIZATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_REFLECTION</DefineConstants> <DefineConstants>$(DefineConstants);FX_RESHAPED_REFLECTION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_REFLECTION_CORECLR</DefineConstants>
<DefineConstants>$(DefineConstants);RESHAPED_MSBUILD</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_CONVERTER</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_CONVERTER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_ARRAY_LONG_LENGTH</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_ARRAY_LONG_LENGTH</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_EXIT</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_EXIT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_DEFAULT_DEPENDENCY_TYPE</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_DEFAULT_DEPENDENCY_TYPE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_BINARY_SERIALIZATION</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_BINARY_SERIALIZATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_CUSTOMATTRIBUTEDATA</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_CUSTOMATTRIBUTEDATA</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_REFLECTION_METADATA_TOKENS</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_REFLECTION_MODULE_HANDLES</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WEB_CLIENT</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_WEB_CLIENT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_EVENTWAITHANDLE_NO_IDISPOSABLE</DefineConstants> <DefineConstants>$(DefineConstants);FX_EVENTWAITHANDLE_NO_IDISPOSABLE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_EXIT_CONTEXT_FLAGS</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_EXIT_CONTEXT_FLAGS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_WAITONE_MILLISECONDS</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_WAITONE_MILLISECONDS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_PARAMETERIZED_THREAD_START</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_PARAMETERIZED_THREAD_START</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_THREAD</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_THREAD</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SECURITY_PERMISSIONS</DefineConstants>
<DefineConstants>$(DefineConstants);NO_HEAPTERMINATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_REDUCED_EXCEPTIONS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_PDB_READER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_PDB_WRITER</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SYMBOLSTORE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_LINKEDRESOURCES</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_KEY_SIGNING</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_REFEMIT</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_APP_DOMAINS</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_SYSTEM_CONFIGURATION</DefineConstants>
<DefineConstants>$(DefineConstants);FX_RESHAPED_CONSOLE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_RUNTIMEENVIRONMENT</DefineConstants>
<DefineConstants>$(DefineConstants);NO_LOGGING_GUI</DefineConstants>
<TargetFrameworkProfile>profile7</TargetFrameworkProfile> <!-- We are currently directly referencing corefx assemblies, so profile7 is not really true --> <TargetFrameworkProfile>profile7</TargetFrameworkProfile> <!-- We are currently directly referencing corefx assemblies, so profile7 is not really true -->
<ImplicitlyExpandTargetFramework>false</ImplicitlyExpandTargetFramework> <!-- To stop msbuild being helpfull and referencing the dlls for the profile --> <ImplicitlyExpandTargetFramework>false</ImplicitlyExpandTargetFramework> <!-- To stop msbuild being helpfull and referencing the dlls for the profile -->
</PropertyGroup> </PropertyGroup>
...@@ -232,6 +263,7 @@ ...@@ -232,6 +263,7 @@
<DefineConstants>$(DefineConstants);FSHARP_CORE_NETCORE_PORTABLE</DefineConstants> <DefineConstants>$(DefineConstants);FSHARP_CORE_NETCORE_PORTABLE</DefineConstants>
<DefineConstants>$(DefineConstants);FSHARP_CORE_NETCORE_PORTABLE7</DefineConstants> <DefineConstants>$(DefineConstants);FSHARP_CORE_NETCORE_PORTABLE7</DefineConstants>
<DefineConstants>$(DefineConstants);QUERIES_IN_FSLIB</DefineConstants> <DefineConstants>$(DefineConstants);QUERIES_IN_FSLIB</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_45</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_35</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_35</DefineConstants>
<DefineConstants>$(DefineConstants);FX_ATLEAST_PORTABLE</DefineConstants> <DefineConstants>$(DefineConstants);FX_ATLEAST_PORTABLE</DefineConstants>
<DefineConstants>$(DefineConstants);FX_NO_BEGINEND_READWRITE</DefineConstants> <DefineConstants>$(DefineConstants);FX_NO_BEGINEND_READWRITE</DefineConstants>
...@@ -720,7 +752,7 @@ ...@@ -720,7 +752,7 @@
<NuGetPackagesPath Condition="'$(NuGetPackagesPath)' == ''">$(FSharpSourcesRoot)\..\packages</NuGetPackagesPath> <NuGetPackagesPath Condition="'$(NuGetPackagesPath)' == ''">$(FSharpSourcesRoot)\..\packages</NuGetPackagesPath>
<!-- fix this to be not so unfortunate looking --> <!-- fix this to be not so unfortunate looking -->
<BuildToolsDir>$(MSBuildThisFileDirectory)..\packages\Microsoft.DotNet.BuildTools.1.0.25-prerelease-00053\lib\</BuildToolsDir> <BuildToolsDir>$(MSBuildThisFileDirectory)..\packages\Microsoft.DotNet.BuildTools.1.0.25-prerelease-00085\lib\</BuildToolsDir>
<!-- Implicitly needed by packageresolve.targets. Should file a bug for a better error message here --> <!-- Implicitly needed by packageresolve.targets. Should file a bug for a better error message here -->
<PackagesDir>$(NuGetPackagesPath)\</PackagesDir> <PackagesDir>$(NuGetPackagesPath)\</PackagesDir>
...@@ -790,7 +822,7 @@ ...@@ -790,7 +822,7 @@
'$(TargetFramework)' == 'portable259')"/> '$(TargetFramework)' == 'portable259')"/>
<Error <Error
Text="TargetFramework '$(TargetFramework)' is only supported when building FSharp.Core.dll and FSharp.Core.Unittests.dll. All other components must be built with TargetFramework=net40" Text="TargetFramework '$(TargetFramework)' is only supported when building FSharp.Core.dll and FSharp.Core.Unittests.dll. All other components must be built with TargetFramework=net40"
Condition="'$(AssemblyName)' != 'FSharp.Core' and '$(AssemblyName)' != 'FSharp.Core.Unittests' and '$(TargetFramework)' != 'net40'"/> Condition="'$(AssemblyName)' != 'FSharp.Core' and '$(AssemblyName)' != 'FSharp.Core.Unittests' and '$(TargetFramework)' != 'net40' and '$(TargetFramework)' != 'coreclr'"/>
</Target> </Target>
......
...@@ -18,6 +18,7 @@ open System.Collections ...@@ -18,6 +18,7 @@ open System.Collections
let logging = false let logging = false
#if ENABLE_MONO_SUPPORT
// Officially supported way to detect if we are running on Mono. // Officially supported way to detect if we are running on Mono.
// See http://www.mono-project.com/FAQ:_Technical // See http://www.mono-project.com/FAQ:_Technical
// "How can I detect if am running in Mono?" section // "How can I detect if am running in Mono?" section
...@@ -31,6 +32,7 @@ let runningOnMono = ...@@ -31,6 +32,7 @@ let runningOnMono =
// called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get // called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get
// their issue fixed but we need to be robust here anyway. // their issue fixed but we need to be robust here anyway.
false false
#endif
let _ = if logging then dprintn "* warning: Il.logging is on" let _ = if logging then dprintn "* warning: Il.logging is on"
......
...@@ -2272,7 +2272,9 @@ type ILPropertyRef = ...@@ -2272,7 +2272,9 @@ type ILPropertyRef =
member Name: string member Name: string
interface System.IComparable interface System.IComparable
#if ENABLE_MONO_SUPPORT
val runningOnMono: bool val runningOnMono: bool
#endif
type ILReferences = type ILReferences =
{ AssemblyReferences: ILAssemblyRef list; { AssemblyReferences: ILAssemblyRef list;
......
...@@ -14,7 +14,7 @@ open Internal.Utilities.Collections ...@@ -14,7 +14,7 @@ open Internal.Utilities.Collections
// Code that uses this should probably be adjusted to use unsigned integer types. // Code that uses this should probably be adjusted to use unsigned integer types.
let (>>>&) (x:int32) (n:int32) = int32 (uint32 x >>> n) let (>>>&) (x:int32) (n:int32) = int32 (uint32 x >>> n)
let notlazy v = Lazy.CreateFromValue v let notlazy v = Lazy<_>.CreateFromValue v
let isSome x = match x with None -> false | _ -> true let isSome x = match x with None -> false | _ -> true
let isNone x = match x with None -> true | _ -> false let isNone x = match x with None -> true | _ -> false
...@@ -166,6 +166,11 @@ module Option = ...@@ -166,6 +166,11 @@ module Option =
module List = module List =
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
let sortWithOrder (c: IComparer<'T>) elements = List.sortWith (Order.toFunction c) elements let sortWithOrder (c: IComparer<'T>) elements = List.sortWith (Order.toFunction c) elements
let splitAfter n l = let splitAfter n l =
...@@ -175,7 +180,7 @@ module List = ...@@ -175,7 +180,7 @@ module List =
let existsi f xs = let existsi f xs =
let rec loop i xs = match xs with [] -> false | h::t -> f i h || loop (i+1) t let rec loop i xs = match xs with [] -> false | h::t -> f i h || loop (i+1) t
loop 0 xs loop 0 xs
let lengthsEqAndForall2 p l1 l2 = let lengthsEqAndForall2 p l1 l2 =
List.length l1 = List.length l2 && List.length l1 = List.length l2 &&
List.forall2 p l1 l2 List.forall2 p l1 l2
...@@ -920,6 +925,12 @@ type LayeredMultiMap<'Key,'Value when 'Key : equality and 'Key : comparison>(con ...@@ -920,6 +925,12 @@ type LayeredMultiMap<'Key,'Value when 'Key : equality and 'Key : comparison>(con
module Shim = module Shim =
open System.IO open System.IO
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
[<AbstractClass>] [<AbstractClass>]
type FileSystem() = type FileSystem() =
abstract ReadAllBytesShim: fileName:string -> byte[] abstract ReadAllBytesShim: fileName:string -> byte[]
......
...@@ -17,7 +17,7 @@ open System.Collections.Generic ...@@ -17,7 +17,7 @@ open System.Collections.Generic
open Internal.Utilities open Internal.Utilities
open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal
#if NO_PDB_READER #if FX_NO_PDB_READER
#else #else
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Support open Microsoft.FSharp.Compiler.AbstractIL.Internal.Support
#endif #endif
...@@ -190,8 +190,11 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = ...@@ -190,8 +190,11 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) =
member m.ReadUTF8String i = member m.ReadUTF8String i =
let n = m.CountUtf8String i let n = m.CountUtf8String i
#if FX_RESHAPED_REFLECTION
System.Text.Encoding.UTF8.GetString(NativePtr.ofNativeInt (m.Addr i), n)
#else
new System.String(NativePtr.ofNativeInt (m.Addr i), 0, n, System.Text.Encoding.UTF8) new System.String(NativePtr.ofNativeInt (m.Addr i), 0, n, System.Text.Encoding.UTF8)
#endif
type MMapChannel = type MMapChannel =
{ mutable mmPos: int; { mutable mmPos: int;
...@@ -1025,7 +1028,7 @@ type ILReaderContext = ...@@ -1025,7 +1028,7 @@ type ILReaderContext =
{ ilg: ILGlobals; { ilg: ILGlobals;
dataEndPoints: Lazy<int32 list>; dataEndPoints: Lazy<int32 list>;
sorted: int64; sorted: int64;
#if NO_PDB_READER #if FX_NO_PDB_READER
pdb: obj option; pdb: obj option;
#else #else
pdb: (PdbReader * (string -> ILSourceDocument)) option; pdb: (PdbReader * (string -> ILSourceDocument)) option;
...@@ -1572,7 +1575,7 @@ let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vid ...@@ -1572,7 +1575,7 @@ let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vid
// (e) the start of the native resources attached to the binary if any // (e) the start of the native resources attached to the binary if any
// ----------------------------------------------------------------------*) // ----------------------------------------------------------------------*)
#if NO_PDB_READER #if FX_NO_PDB_READER
let readNativeResources _ctxt = [] let readNativeResources _ctxt = []
#else #else
let readNativeResources ctxt = let readNativeResources ctxt =
...@@ -2994,7 +2997,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = ...@@ -2994,7 +2997,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints =
let instrs = ibuf.ToArray() let instrs = ibuf.ToArray()
instrs,rawToLabel, lab2pc, raw2nextLab instrs,rawToLabel, lab2pc, raw2nextLab
#if NO_PDB_READER #if FX_NO_PDB_READER
and seekReadMethodRVA ctxt (_idx,nm,_internalcall,noinline,numtypars) rva = and seekReadMethodRVA ctxt (_idx,nm,_internalcall,noinline,numtypars) rva =
#else #else
and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva =
...@@ -3008,7 +3011,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = ...@@ -3008,7 +3011,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva =
// -- an overall range for the method // -- an overall range for the method
// -- the sequence points for the method // -- the sequence points for the method
let localPdbInfos, methRangePdbInfo, seqpoints = let localPdbInfos, methRangePdbInfo, seqpoints =
#if NO_PDB_READER #if FX_NO_PDB_READER
[], None, [] [], None, []
#else #else
match ctxt.pdb with match ctxt.pdb with
...@@ -3067,7 +3070,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = ...@@ -3067,7 +3070,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva =
with e -> with e ->
// "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message // "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message
[],None,[] [],None,[]
#endif // NO_PDB_READER #endif
let baseRVA = ctxt.anyV2P("method rva",rva) let baseRVA = ctxt.anyV2P("method rva",rva)
// ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA // ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA
...@@ -3366,7 +3369,7 @@ and seekReadTopExportedTypes ctxt () = ...@@ -3366,7 +3369,7 @@ and seekReadTopExportedTypes ctxt () =
done; done;
List.rev !res) List.rev !res)
#if NO_PDB_READER #if FX_NO_PDB_READER
#else #else
let getPdbReader opts infile = let getPdbReader opts infile =
match opts.pdbPath with match opts.pdbPath with
...@@ -3939,10 +3942,16 @@ let rec genOpenBinaryReader infile is opts = ...@@ -3939,10 +3942,16 @@ let rec genOpenBinaryReader infile is opts =
//----------------------------------------------------------------------- //-----------------------------------------------------------------------
// Set up the PDB reader so we can read debug info for methods. // Set up the PDB reader so we can read debug info for methods.
// ---------------------------------------------------------------------- // ----------------------------------------------------------------------
#if NO_PDB_READER #if FX_NO_PDB_READER
let pdb = None let pdb = None
#else #else
let pdb = if runningOnMono then None else getPdbReader opts infile let pdb =
#if ENABLE_MONO_SUPPORT
if runningOnMono then
None
else
#endif
getPdbReader opts infile
#endif #endif
let rowAddr (tab:TableName) idx = tablePhysLocations.[tab.Index] + (idx - 1) * tableRowSizes.[tab.Index] let rowAddr (tab:TableName) idx = tablePhysLocations.[tab.Index] + (idx - 1) * tableRowSizes.[tab.Index]
...@@ -4067,7 +4076,7 @@ let mkDefault ilg = ...@@ -4067,7 +4076,7 @@ let mkDefault ilg =
pdbPath= None; pdbPath= None;
ilGlobals = ilg } ilGlobals = ilg }
#if NO_PDB_READER #if FX_NO_PDB_READER
let ClosePdbReader _x = () let ClosePdbReader _x = ()
#else #else
let ClosePdbReader pdb = let ClosePdbReader pdb =
...@@ -4095,7 +4104,7 @@ let OpenILModuleReader infile opts = ...@@ -4095,7 +4104,7 @@ let OpenILModuleReader infile opts =
ilAssemblyRefs = ilAssemblyRefs; ilAssemblyRefs = ilAssemblyRefs;
dispose = (fun () -> dispose = (fun () ->
cell := None; cell := None;
is.Close(); is.Dispose();
ClosePdbReader pdb) } ClosePdbReader pdb) }
// ++GLOBAL MUTABLE STATE // ++GLOBAL MUTABLE STATE
......
此差异已折叠。
// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information.
module internal Microsoft.FSharp.Compiler.AbstractIL.Internal.Support module internal Microsoft.FSharp.Compiler.AbstractIL.Internal.Support
let DateTime1970Jan01 = new System.DateTime(1970,1,1,0,0,0,System.DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *) let DateTime1970Jan01 = new System.DateTime(1970,1,1,0,0,0,System.DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *)
...@@ -8,25 +8,31 @@ let absilWriteGetTimeStamp () = (System.DateTime.UtcNow - DateTime1970Jan01).Tot ...@@ -8,25 +8,31 @@ let absilWriteGetTimeStamp () = (System.DateTime.UtcNow - DateTime1970Jan01).Tot
open Internal.Utilities open Internal.Utilities
open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Bytes open Microsoft.FSharp.Compiler.AbstractIL.Internal.Bytes
open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
open System open System
open System.IO open System.IO
open System.Text open System.Text
open System.Reflection open System.Reflection
#if FX_NO_SYMBOLSTORE
#else
open System.Diagnostics.SymbolStore open System.Diagnostics.SymbolStore
#endif
open System.Runtime.InteropServices open System.Runtime.InteropServices
open System.Runtime.CompilerServices open System.Runtime.CompilerServices
#if FX_NO_LINKEDRESOURCES
#else
// Force inline, so GetLastWin32Error calls are immediately after interop calls as seen by FxCop under Debug build. // Force inline, so GetLastWin32Error calls are immediately after interop calls as seen by FxCop under Debug build.
let inline ignore _x = () let inline ignore _x = ()
// Native Resource linking/unlinking // Native Resource linking/unlinking
type IStream = System.Runtime.InteropServices.ComTypes.IStream type IStream = System.Runtime.InteropServices.ComTypes.IStream
#endif
let check _action (hresult) = let check _action (hresult) =
if uint32 hresult >= 0x80000000ul then if uint32 hresult >= 0x80000000ul then
...@@ -36,9 +42,11 @@ let check _action (hresult) = ...@@ -36,9 +42,11 @@ let check _action (hresult) =
// Depending on the configuration, we may want to include the output file extension in the name // Depending on the configuration, we may want to include the output file extension in the name
// of the debug symbols file. This function takes output file name and returns debug file name. // of the debug symbols file. This function takes output file name and returns debug file name.
let getDebugFileName outfile = let getDebugFileName outfile =
#if ENABLE_MONO_SUPPORT
if IL.runningOnMono then if IL.runningOnMono then
outfile+".mdb" outfile+".mdb"
else else
#endif
(Filename.chopExtension outfile)+".pdb" (Filename.chopExtension outfile)+".pdb"
type PEFileType = X86 | X64 type PEFileType = X86 | X64
...@@ -57,6 +65,8 @@ let bytesToQWord ((b0 : byte) , (b1 : byte) , (b2 : byte) , (b3 : byte) , (b4 : ...@@ -57,6 +65,8 @@ let bytesToQWord ((b0 : byte) , (b1 : byte) , (b2 : byte) , (b3 : byte) , (b4 :
let dwToBytes n = [| (byte)(n &&& 0xff) ; (byte)((n >>> 8) &&& 0xff) ; (byte)((n >>> 16) &&& 0xff) ; (byte)((n >>> 24) &&& 0xff) |], 4 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 let wToBytes (n : int16) = [| (byte)(n &&& 0xffs) ; (byte)((n >>> 8) &&& 0xffs) |], 2
#if FX_NO_LINKEDRESOURCES
#else
// REVIEW: factor these classes under one hierarchy, use reflection for creation from buffer and toBytes() // 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? // 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) = type IMAGE_FILE_HEADER (m:int16, secs:int16, tds:int32, ptst:int32, nos:int32, soh:int16, c:int16) =
...@@ -578,7 +588,6 @@ type ResFormatNode(tid:int32, nid:int32, lid:int32, dataOffset:int32, pbLinkedRe ...@@ -578,7 +588,6 @@ type ResFormatNode(tid:int32, nid:int32, lid:int32, dataOffset:int32, pbLinkedRe
SaveChunk(bNil, 4 - dwFiller) SaveChunk(bNil, 4 - dwFiller)
!size !size
let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRVA:int32) (fileType:PEFileType) (outputFilePath:string) = let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRVA:int32) (fileType:PEFileType) (outputFilePath:string) =
let nPEFileType = match fileType with X86 -> 0 | X64 -> 2 let nPEFileType = match fileType with X86 -> 0 | X64 -> 2
...@@ -597,14 +606,13 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV ...@@ -597,14 +606,13 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV
let corSystemDir = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() let corSystemDir = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()
// We'll use the current dir and a random file name rather than System.IO.Path.GetTempFileName // We'll use the current dir and a random file name rather than System.IO.Path.GetTempFileName
// to try and prevent the command line invocation string from being > MAX_PATH // to try and prevent the command line invocation string from being > MAX_PATH
let outputFilePaths = let outputFilePaths =
if outputFilePath = "" then if outputFilePath = "" then
[ FileSystem.GetTempPathShim() ] [ FileSystem.GetTempPathShim() ]
else else
[ FileSystem.GetTempPathShim() ; (outputFilePath ^ "\\") ] [ FileSystem.GetTempPathShim() ; (outputFilePath ^ "\\") ]
// Get a unique random file // Get a unique random file
let rec GetUniqueRandomFileName(path) = let rec GetUniqueRandomFileName(path) =
let tfn = path ^ System.IO.Path.GetRandomFileName() let tfn = path ^ System.IO.Path.GetRandomFileName()
...@@ -613,17 +621,17 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV ...@@ -613,17 +621,17 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV
else else
tfn tfn
let machine = if 2 = nPEFileType then "X64" else "X86" let machine = if 2 = nPEFileType then "X64" else "X86"
let cmdLineArgsPreamble = sprintf "/NOLOGO /READONLY /MACHINE:%s" machine let cmdLineArgsPreamble = sprintf "/NOLOGO /READONLY /MACHINE:%s" machine
let cvtres = corSystemDir^"cvtres.exe " let cvtres = corSystemDir^"cvtres.exe "
let createCvtresArgs path = let createCvtresArgs path =
let tempObjFileName = GetUniqueRandomFileName(path) let tempObjFileName = GetUniqueRandomFileName(path)
let mutable cmdLineArgs = sprintf "%s \"/Out:%s\"" cmdLineArgsPreamble tempObjFileName let mutable cmdLineArgs = sprintf "%s \"/Out:%s\"" cmdLineArgsPreamble tempObjFileName
let mutable resFiles : string list = [] let mutable resFiles : string list = []
for _ulr in unlinkedResources do for _ulr in unlinkedResources do
let tempResFileName = GetUniqueRandomFileName(path) let tempResFileName = GetUniqueRandomFileName(path)
resFiles <- tempResFileName :: resFiles ; resFiles <- tempResFileName :: resFiles ;
...@@ -631,7 +639,7 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV ...@@ -631,7 +639,7 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV
let trf = resFiles let trf = resFiles
let cmd = cmdLineArgs let cmd = cmdLineArgs
cmd,tempObjFileName,trf cmd,tempObjFileName,trf
let cmdLineArgs,tempObjFileName,tempResFileNames = let cmdLineArgs,tempObjFileName,tempResFileNames =
let attempts = let attempts =
outputFilePaths |> outputFilePaths |>
...@@ -643,20 +651,20 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV ...@@ -643,20 +651,20 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV
| (i,t,f) :: _rest -> i,t,f // use the first one, since they're listed in order of precedence | (i,t,f) :: _rest -> i,t,f // use the first one, since they're listed in order of precedence
tempResFiles <- files tempResFiles <- files
(invoc,tmp,files) (invoc,tmp,files)
let cvtresInvocation = cvtres ^ cmdLineArgs let cvtresInvocation = cvtres ^ cmdLineArgs
try try
let mutable iFiles = 0 let mutable iFiles = 0
for ulr in unlinkedResources do for ulr in unlinkedResources do
// REVIEW: What can go wrong here? What happens when the various file calls fail // REVIEW: What can go wrong here? What happens when the various file calls fail
// dump the unlinked resource bytes into the temp file // dump the unlinked resource bytes into the temp file
System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) ; System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) ;
iFiles <- iFiles + 1 iFiles <- iFiles + 1
// call cvtres.exe using the full cmd line string we've generated // call cvtres.exe using the full cmd line string we've generated
// check to see if the generated string is too long - if it is, fail with E_FAIL // check to see if the generated string is too long - if it is, fail with E_FAIL
if cvtresInvocation.Length >= MAX_PATH then if cvtresInvocation.Length >= MAX_PATH then
System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL)
...@@ -667,12 +675,12 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV ...@@ -667,12 +675,12 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV
psi.CreateNoWindow <- true ; // REVIEW: For some reason, this still creates a window unless WindowStyle is set to hidden psi.CreateNoWindow <- true ; // REVIEW: For some reason, this still creates a window unless WindowStyle is set to hidden
psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden ; psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden ;
let p = System.Diagnostics.Process.Start(psi) let p = System.Diagnostics.Process.Start(psi)
// Wait for the process to finish // Wait for the process to finish
p.WaitForExit() p.WaitForExit()
check "Process.Start" p.ExitCode // TODO: really need to check against 0 check "Process.Start" p.ExitCode // TODO: really need to check against 0
// Conversion was successful, so read the object file // Conversion was successful, so read the object file
objBytes <- FileSystem.ReadAllBytesShim(tempObjFileName) ; objBytes <- FileSystem.ReadAllBytesShim(tempObjFileName) ;
//Array.Copy(objBytes, pbUnlinkedResource, pbUnlinkedResource.Length) //Array.Copy(objBytes, pbUnlinkedResource, pbUnlinkedResource.Length)
...@@ -680,99 +688,96 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV ...@@ -680,99 +688,96 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV
finally finally
// clean up the temp files // clean up the temp files
List.iter (fun tempResFileName -> System.IO.File.Delete(tempResFileName)) tempResFiles List.iter (fun tempResFileName -> System.IO.File.Delete(tempResFileName)) tempResFiles
// Part 2: Read the COFF file held in pbUnlinkedResource, spit it out into pResBuffer and apply the COFF fixups // Part 2: Read the COFF file held in pbUnlinkedResource, spit it out into pResBuffer and apply the COFF fixups
// pResBuffer will become the .rsrc section of the PE file // pResBuffer will become the .rsrc section of the PE file
if (objBytes = Unchecked.defaultof<byte[]>) then if (objBytes = Unchecked.defaultof<byte[]>) then
System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL)
let hMod = bytesToIFH objBytes 0 let hMod = bytesToIFH objBytes 0
if hMod.SizeOfOptionalHeader <> 0s then if hMod.SizeOfOptionalHeader <> 0s then
System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL)
let rsrc01Name = 0x313024637273722eL // ".rsrc$01" let rsrc01Name = 0x313024637273722eL // ".rsrc$01"
let rsrc02Name = 0x323024637273722eL // ".rsrc$02" let rsrc02Name = 0x323024637273722eL // ".rsrc$02"
let nullHdr = Unchecked.defaultof<IMAGE_SECTION_HEADER> let nullHdr = Unchecked.defaultof<IMAGE_SECTION_HEADER>
let mutable rsrc01 = nullHdr let mutable rsrc01 = nullHdr
let mutable rsrc02 = nullHdr let mutable rsrc02 = nullHdr
for i = 0 to (int)hMod.NumberOfSections do for i = 0 to (int)hMod.NumberOfSections do
let pSection = bytesToISH objBytes (IMAGE_FILE_HEADER.Width + (IMAGE_SECTION_HEADER.Width * i)) let pSection = bytesToISH objBytes (IMAGE_FILE_HEADER.Width + (IMAGE_SECTION_HEADER.Width * i))
if pSection.Name = rsrc01Name then if pSection.Name = rsrc01Name then
rsrc01 <- pSection rsrc01 <- pSection
else if pSection.Name = rsrc02Name then else if pSection.Name = rsrc02Name then
rsrc02 <- pSection rsrc02 <- pSection
if (nullHdr = rsrc01) || (nullHdr = rsrc02) then if (nullHdr = rsrc01) || (nullHdr = rsrc02) then
// One of the rsrc sections wasn't found // One of the rsrc sections wasn't found
System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL)
let size = rsrc01.SizeOfRawData + rsrc02.SizeOfRawData let size = rsrc01.SizeOfRawData + rsrc02.SizeOfRawData
let pResBuffer = Bytes.zeroCreate size let pResBuffer = Bytes.zeroCreate size
// Copy over the raw data // Copy over the raw data
Bytes.blit objBytes rsrc01.PointerToRawData pResBuffer 0 rsrc01.SizeOfRawData Bytes.blit objBytes rsrc01.PointerToRawData pResBuffer 0 rsrc01.SizeOfRawData
// map all the relocs in .rsrc$01 using the reloc and symbol tables in the COFF object // map all the relocs in .rsrc$01 using the reloc and symbol tables in the COFF object
let symbolTableHead = hMod.PointerToSymbolTable let symbolTableHead = hMod.PointerToSymbolTable
let IMAGE_SYM_CLASS_STATIC = 0x3uy let IMAGE_SYM_CLASS_STATIC = 0x3uy
let IMAGE_SYM_TYPE_NULL = 0x0s let IMAGE_SYM_TYPE_NULL = 0x0s
let GetSymbolEntry (buffer : byte[]) (idx : int) = let GetSymbolEntry (buffer : byte[]) (idx : int) =
bytesToIS buffer (symbolTableHead + (idx * IMAGE_SYMBOL.Width) ) bytesToIS buffer (symbolTableHead + (idx * IMAGE_SYMBOL.Width) )
for iReloc = 0 to (int)(rsrc01.NumberOfRelocations - 1s) do for iReloc = 0 to (int)(rsrc01.NumberOfRelocations - 1s) do
let pReloc = bytesToIR objBytes (rsrc01.PointerToRelocations + (iReloc * IMAGE_RELOCATION.Width)) let pReloc = bytesToIR objBytes (rsrc01.PointerToRelocations + (iReloc * IMAGE_RELOCATION.Width))
let IdxSymbol = pReloc.SymbolTableIndex let IdxSymbol = pReloc.SymbolTableIndex
let pSymbolEntry = GetSymbolEntry objBytes IdxSymbol let pSymbolEntry = GetSymbolEntry objBytes IdxSymbol
// Ensure the symbol entry is valid for a resource // Ensure the symbol entry is valid for a resource
if ((pSymbolEntry.StorageClass <> IMAGE_SYM_CLASS_STATIC) || if ((pSymbolEntry.StorageClass <> IMAGE_SYM_CLASS_STATIC) ||
(pSymbolEntry.Type <> IMAGE_SYM_TYPE_NULL) || (pSymbolEntry.Type <> IMAGE_SYM_TYPE_NULL) ||
(pSymbolEntry.SectionNumber <> 3s)) then (pSymbolEntry.SectionNumber <> 3s)) then
System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL)
// Ensure that RVA is a valid address inside rsrc02 // Ensure that RVA is a valid address inside rsrc02
if pSymbolEntry.Value >= rsrc02.SizeOfRawData then if pSymbolEntry.Value >= rsrc02.SizeOfRawData then
// pSymbolEntry.Value is too big // pSymbolEntry.Value is too big
System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL)
// store the value // store the value
let vBuff, vSize = dwToBytes (ulLinkedResourceBaseRVA + rsrc01.SizeOfRawData + pSymbolEntry.Value) let vBuff, vSize = dwToBytes (ulLinkedResourceBaseRVA + rsrc01.SizeOfRawData + pSymbolEntry.Value)
//Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer pReloc.VirtualAddress rsrc02.SizeOfRawData //Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer pReloc.VirtualAddress rsrc02.SizeOfRawData
Bytes.blit vBuff 0 pResBuffer pReloc.VirtualAddress vSize Bytes.blit vBuff 0 pResBuffer pReloc.VirtualAddress vSize
// Copy $02 (resource raw into pResBuffer // Copy $02 (resource raw into pResBuffer
Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer rsrc01.SizeOfRawData rsrc02.SizeOfRawData Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer rsrc01.SizeOfRawData rsrc02.SizeOfRawData
// return the buffer // return the buffer
pResBuffer pResBuffer
let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) =
let mutable nResNodes = 0 let mutable nResNodes = 0
let pirdType = bytesToIRD pbLinkedResource 0 let pirdType = bytesToIRD pbLinkedResource 0
let mutable pirdeType = Unchecked.defaultof<IMAGE_RESOURCE_DIRECTORY_ENTRY> let mutable pirdeType = Unchecked.defaultof<IMAGE_RESOURCE_DIRECTORY_ENTRY>
let nEntries = pirdType.NumberOfNamedEntries + pirdType.NumberOfIdEntries let nEntries = pirdType.NumberOfNamedEntries + pirdType.NumberOfIdEntries
// determine entry buffer size // determine entry buffer size
// TODO: coalesce these two loops // TODO: coalesce these two loops
for iEntry = 0 to ((int)nEntries - 1) do for iEntry = 0 to ((int)nEntries - 1) do
pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ;
if pirdeType.DataIsDirectory then if pirdeType.DataIsDirectory then
let nameBase = pirdeType.OffsetToDirectory let nameBase = pirdeType.OffsetToDirectory
let pirdName = bytesToIRD pbLinkedResource nameBase let pirdName = bytesToIRD pbLinkedResource nameBase
let mutable pirdeName = Unchecked.defaultof<IMAGE_RESOURCE_DIRECTORY_ENTRY> let mutable pirdeName = Unchecked.defaultof<IMAGE_RESOURCE_DIRECTORY_ENTRY>
let nEntries2 = pirdName.NumberOfNamedEntries + pirdName.NumberOfIdEntries let nEntries2 = pirdName.NumberOfNamedEntries + pirdName.NumberOfIdEntries
for iEntry2 = 0 to ((int)nEntries2 - 1) do for iEntry2 = 0 to ((int)nEntries2 - 1) do
pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ;
if pirdeName.DataIsDirectory then if pirdeName.DataIsDirectory then
let langBase = pirdeName.OffsetToDirectory let langBase = pirdeName.OffsetToDirectory
let pirdLang = bytesToIRD pbLinkedResource langBase let pirdLang = bytesToIRD pbLinkedResource langBase
...@@ -783,10 +788,10 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = ...@@ -783,10 +788,10 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) =
nResNodes <- nResNodes + 1 ; nResNodes <- nResNodes + 1 ;
else else
nResNodes <- nResNodes + 1 ; nResNodes <- nResNodes + 1 ;
let pResNodes : ResFormatNode [] = Array.zeroCreate nResNodes let pResNodes : ResFormatNode [] = Array.zeroCreate nResNodes
nResNodes <- 0 ; nResNodes <- 0 ;
// fill out the entry buffer // fill out the entry buffer
for iEntry = 0 to ((int)nEntries - 1) do for iEntry = 0 to ((int)nEntries - 1) do
pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ;
...@@ -803,7 +808,7 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = ...@@ -803,7 +808,7 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) =
for iEntry2 = 0 to ((int)nEntries2 - 1) do for iEntry2 = 0 to ((int)nEntries2 - 1) do
pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ;
let dwNameID = pirdeName.Name let dwNameID = pirdeName.Name
if pirdeName.DataIsDirectory then if pirdeName.DataIsDirectory then
let langBase = pirdeName.OffsetToDirectory let langBase = pirdeName.OffsetToDirectory
let pirdLang = bytesToIRD pbLinkedResource langBase let pirdLang = bytesToIRD pbLinkedResource langBase
...@@ -832,31 +837,33 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = ...@@ -832,31 +837,33 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) =
let rfn = ResFormatNode(dwTypeID, 0, 0, pirdeType.OffsetToData, pbLinkedResource) // REVIEW: I believe these 0s are what's causing the duplicate res naming problems let rfn = ResFormatNode(dwTypeID, 0, 0, pirdeType.OffsetToData, pbLinkedResource) // REVIEW: I believe these 0s are what's causing the duplicate res naming problems
pResNodes.[nResNodes] <- rfn ; pResNodes.[nResNodes] <- rfn ;
nResNodes <- nResNodes + 1 ; nResNodes <- nResNodes + 1 ;
// Ok, all tree leaves are in ResFormatNode structs, and nResNodes ptrs are in pResNodes // Ok, all tree leaves are in ResFormatNode structs, and nResNodes ptrs are in pResNodes
let mutable size = 0 let mutable size = 0
if nResNodes <> 0 then if nResNodes <> 0 then
size <- size + ResFormatHeader.Width ; // sizeof(ResFormatHeader) size <- size + ResFormatHeader.Width ; // sizeof(ResFormatHeader)
for i = 0 to (nResNodes - 1) do for i = 0 to (nResNodes - 1) do
size <- size + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, Unchecked.defaultof<byte[]>, 0) ; size <- size + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, Unchecked.defaultof<byte[]>, 0) ;
let pResBuffer = Bytes.zeroCreate size let pResBuffer = Bytes.zeroCreate size
if nResNodes <> 0 then if nResNodes <> 0 then
let mutable resBufferOffset = 0 let mutable resBufferOffset = 0
// Write a dummy header // Write a dummy header
let rfh = ResFormatHeader() let rfh = ResFormatHeader()
let rfhBytes = rfh.toBytes() let rfhBytes = rfh.toBytes()
Bytes.blit rfhBytes 0 pResBuffer 0 ResFormatHeader.Width Bytes.blit rfhBytes 0 pResBuffer 0 ResFormatHeader.Width
resBufferOffset <- resBufferOffset + ResFormatHeader.Width ; resBufferOffset <- resBufferOffset + ResFormatHeader.Width ;
for i = 0 to (nResNodes - 1) do for i = 0 to (nResNodes - 1) do
resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset) ; resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset) ;
pResBuffer pResBuffer
#endif
#if FX_NO_PDB_WRITER
#else
// PDB Writing // PDB Writing
[<ComImport; Interface>] [<ComImport; Interface>]
...@@ -1009,7 +1016,7 @@ type ISymUnmanagedWriter2 = ...@@ -1009,7 +1016,7 @@ type ISymUnmanagedWriter2 =
type PdbWriter = { symWriter : ISymUnmanagedWriter2 } type PdbWriter = { symWriter : ISymUnmanagedWriter2 }
type PdbDocumentWriter = { symDocWriter : ISymUnmanagedDocumentWriter } (* pointer to pDocumentWriter COM object *) type PdbDocumentWriter = { symDocWriter : ISymUnmanagedDocumentWriter } (* pointer to pDocumentWriter COM object *)
#endif
type idd = type idd =
{ iddCharacteristics: int32; { iddCharacteristics: int32;
iddMajorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddMajorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *)
...@@ -1017,6 +1024,8 @@ type idd = ...@@ -1017,6 +1024,8 @@ type idd =
iddType: int32; iddType: int32;
iddData: byte[];} iddData: byte[];}
#if FX_NO_PDB_WRITER
#else
let pdbInitialize (binaryName:string) (pdbName:string) = let pdbInitialize (binaryName:string) (pdbName:string) =
// collect necessary COM types // collect necessary COM types
let CorMetaDataDispenser = System.Type.GetTypeFromProgID("CLRMetaData.CorMetaDataDispenser") let CorMetaDataDispenser = System.Type.GetTypeFromProgID("CLRMetaData.CorMetaDataDispenser")
...@@ -1148,8 +1157,11 @@ let pdbGetDebugInfo (writer: PdbWriter) = ...@@ -1148,8 +1157,11 @@ let pdbGetDebugInfo (writer: PdbWriter) =
iddMinorVersion = (int32)iDD.MinorVersion; iddMinorVersion = (int32)iDD.MinorVersion;
iddType = iDD.Type; iddType = iDD.Type;
iddData = data} iddData = data}
#endif
#if FX_NO_PDB_WRITER
#else
// PDB reading // PDB reading
type PdbReader = { symReader: ISymbolReader } type PdbReader = { symReader: ISymbolReader }
type PdbDocument = { symDocument: ISymbolDocument } type PdbDocument = { symDocument: ISymbolDocument }
...@@ -1261,12 +1273,15 @@ let pdbVariableGetSignature (variable:PdbVariable) : byte[] = ...@@ -1261,12 +1273,15 @@ let pdbVariableGetSignature (variable:PdbVariable) : byte[] =
// the tuple is (AddressKind, AddressField1) // the tuple is (AddressKind, AddressField1)
let pdbVariableGetAddressAttributes (variable:PdbVariable) : (int32 * int32) = let pdbVariableGetAddressAttributes (variable:PdbVariable) : (int32 * int32) =
(int32 variable.symVariable.AddressKind,variable.symVariable.AddressField1) (int32 variable.symVariable.AddressKind,variable.symVariable.AddressField1)
#endif
// Key signing // Key signing
type keyContainerName = string type keyContainerName = string
type keyPair = byte[] type keyPair = byte[]
type pubkey = byte[] type pubkey = byte[]
#if FX_NO_KEY_SIGNING
#else
// new mscoree functionality // new mscoree functionality
// This type represents methods that we don't currently need, so I'm leaving unimplemented // This type represents methods that we don't currently need, so I'm leaving unimplemented
type UnusedCOMMethod = unit -> unit type UnusedCOMMethod = unit -> unit
...@@ -1452,3 +1467,4 @@ let signerSignFileWithKeyContainer fileName kcName = ...@@ -1452,3 +1467,4 @@ let signerSignFileWithKeyContainer fileName kcName =
let iclrSN = getICLRStrongName() let iclrSN = getICLRStrongName()
iclrSN.StrongNameSignatureGeneration(fileName, kcName, Unchecked.defaultof<byte[]>, 0u, ppb, &pcb) |> ignore iclrSN.StrongNameSignatureGeneration(fileName, kcName, Unchecked.defaultof<byte[]>, 0u, ppb, &pcb) |> ignore
iclrSN.StrongNameSignatureVerificationEx(fileName, true, &ok) |> ignore iclrSN.StrongNameSignatureVerificationEx(fileName, true, &ok) |> ignore
#endif
\ No newline at end of file
...@@ -7,23 +7,35 @@ ...@@ -7,23 +7,35 @@
/// The implementation of the functions can be found in ilsupp-*.fs /// The implementation of the functions can be found in ilsupp-*.fs
module internal Microsoft.FSharp.Compiler.AbstractIL.Internal.Support module internal Microsoft.FSharp.Compiler.AbstractIL.Internal.Support
#if FX_NO_PDB_WRITER
type PdbReader #else
type PdbWriter type PdbWriter
val pdbReadClose: PdbReader -> unit
val pdbInitialize : string -> string -> PdbWriter val pdbInitialize : string -> string -> PdbWriter
#endif
#if FX_NO_PDB_READER
#else
type PdbReader
val pdbReadClose: PdbReader -> unit
#endif
val absilWriteGetTimeStamp: unit -> int32 val absilWriteGetTimeStamp: unit -> int32
open System open System
open System.Runtime.InteropServices open System.Runtime.InteropServices
#if FX_NO_SYMBOLSTORE
#else
open System.Diagnostics.SymbolStore open System.Diagnostics.SymbolStore
#endif
open Internal.Utilities open Internal.Utilities
open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal
open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.IL
#if FX_NO_LINKEDRESOURCES
#else
type IStream = System.Runtime.InteropServices.ComTypes.IStream type IStream = System.Runtime.InteropServices.ComTypes.IStream
#endif
/// Takes the output file name and returns debug file name. /// Takes the output file name and returns debug file name.
...@@ -35,9 +47,14 @@ val getDebugFileName: string -> string ...@@ -35,9 +47,14 @@ val getDebugFileName: string -> string
/// required buffer is returned. /// required buffer is returned.
type PEFileType = X86 | X64 type PEFileType = X86 | X64
#if FX_NO_LINKEDRESOURCES
#else
val linkNativeResources: unlinkedResources:byte[] list -> rva:int32 -> PEFileType -> tempFilePath:string -> byte[] val linkNativeResources: unlinkedResources:byte[] list -> rva:int32 -> PEFileType -> tempFilePath:string -> byte[]
val unlinkResource: int32 -> byte[] -> byte[] val unlinkResource: int32 -> byte[] -> byte[]
#endif
#if FX_NO_PDB_WRITER
#else
/// PDB reader and associated types /// PDB reader and associated types
type PdbDocument type PdbDocument
type PdbMethod type PdbMethod
...@@ -76,21 +93,27 @@ val pdbScopeGetLocals: PdbMethodScope -> PdbVariable array ...@@ -76,21 +93,27 @@ val pdbScopeGetLocals: PdbMethodScope -> PdbVariable array
val pdbVariableGetName: PdbVariable -> string val pdbVariableGetName: PdbVariable -> string
val pdbVariableGetSignature: PdbVariable -> byte[] val pdbVariableGetSignature: PdbVariable -> byte[]
val pdbVariableGetAddressAttributes: PdbVariable -> int32 (* kind *) * int32 (* addrField1 *) val pdbVariableGetAddressAttributes: PdbVariable -> int32 (* kind *) * int32 (* addrField1 *)
#endif
#if FX_NO_PDB_WRITER
#else
//--------------------------------------------------------------------- //---------------------------------------------------------------------
// PDB writer. // PDB writer.
//--------------------------------------------------------------------- //---------------------------------------------------------------------
type PdbDocumentWriter type PdbDocumentWriter
#endif
#if FX_NO_LINKEDRESOURCES
#else
type idd = type idd =
{ iddCharacteristics: int32; { iddCharacteristics: int32;
iddMajorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddMajorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *)
iddMinorVersion: int32; (* acutally u16 in IMAGE_DEBUG_DIRECTORY *) iddMinorVersion: int32; (* acutally u16 in IMAGE_DEBUG_DIRECTORY *)
iddType: int32; iddType: int32;
iddData: byte[];} iddData: byte[];}
#endif
#if FX_NO_PDB_WRITER
#else
val pdbInitialize: val pdbInitialize:
string (* .exe/.dll already written and closed *) -> string (* .exe/.dll already written and closed *) ->
string (* .pdb to write *) -> string (* .pdb to write *) ->
...@@ -107,7 +130,10 @@ val pdbDefineLocalVariable: PdbWriter -> string -> byte[] -> int32 -> unit ...@@ -107,7 +130,10 @@ val pdbDefineLocalVariable: PdbWriter -> string -> byte[] -> int32 -> unit
val pdbSetMethodRange: PdbWriter -> PdbDocumentWriter -> int -> int -> PdbDocumentWriter -> int -> int -> unit val pdbSetMethodRange: PdbWriter -> PdbDocumentWriter -> int -> int -> PdbDocumentWriter -> int -> int -> unit
val pdbDefineSequencePoints: PdbWriter -> PdbDocumentWriter -> (int * int * int * int * int) array -> unit val pdbDefineSequencePoints: PdbWriter -> PdbDocumentWriter -> (int * int * int * int * int) array -> unit
val pdbGetDebugInfo: PdbWriter -> idd val pdbGetDebugInfo: PdbWriter -> idd
#endif
#if FX_NO_KEY_SIGNING
#else
//--------------------------------------------------------------------- //---------------------------------------------------------------------
// Strong name signing // Strong name signing
//--------------------------------------------------------------------- //---------------------------------------------------------------------
...@@ -124,3 +150,4 @@ val signerCloseKeyContainer: keyContainerName -> unit ...@@ -124,3 +150,4 @@ val signerCloseKeyContainer: keyContainerName -> unit
val signerSignatureSize: pubkey -> int val signerSignatureSize: pubkey -> int
val signerSignFileWithKeyPair: string -> keyPair -> unit val signerSignFileWithKeyPair: string -> keyPair -> unit
val signerSignFileWithKeyContainer: string -> keyContainerName -> unit val signerSignFileWithKeyContainer: string -> keyContainerName -> unit
#endif
...@@ -208,6 +208,8 @@ module SequencePoint = ...@@ -208,6 +208,8 @@ module SequencePoint =
/// 28 is the size of the IMAGE_DEBUG_DIRECTORY in ntimage.h /// 28 is the size of the IMAGE_DEBUG_DIRECTORY in ntimage.h
let sizeof_IMAGE_DEBUG_DIRECTORY = 28 let sizeof_IMAGE_DEBUG_DIRECTORY = 28
#if FX_NO_PDB_WRITER
#else
[<NoEquality; NoComparison>] [<NoEquality; NoComparison>]
type PdbData = type PdbData =
{ EntryPoint: int32 option; { EntryPoint: int32 option;
...@@ -273,8 +275,6 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = ...@@ -273,8 +275,6 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info =
EndColumn = (if adjustToPrevLine then 80 else sp2.Column); } EndColumn = (if adjustToPrevLine then 80 else sp2.Column); }
Array.sortInPlaceBy fst allSps; Array.sortInPlaceBy fst allSps;
let spOffset = ref 0 let spOffset = ref 0
info.Methods |> Array.iteri (fun i minfo -> info.Methods |> Array.iteri (fun i minfo ->
...@@ -365,8 +365,8 @@ let (?) this memb (args:'Args) : 'R = ...@@ -365,8 +365,8 @@ let (?) this memb (args:'Args) : 'R =
// Creating instances of needed classes from 'Mono.CompilerServices.SymbolWriter' assembly // Creating instances of needed classes from 'Mono.CompilerServices.SymbolWriter' assembly
let monoCompilerSvc = "Mono.CompilerServices.SymbolWriter, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756" let monoCompilerSvc = new AssemblyName("Mono.CompilerServices.SymbolWriter, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756")
let ctor (asmName:string) (clsName:string) (args:obj[]) = let ctor (asmName:AssemblyName) clsName (args:obj[]) =
let asm = Assembly.Load(asmName) let asm = Assembly.Load(asmName)
let ty = asm.GetType(clsName) let ty = asm.GetType(clsName)
System.Activator.CreateInstance(ty, args) System.Activator.CreateInstance(ty, args)
...@@ -432,7 +432,7 @@ let WriteMdbInfo fmdb f info = ...@@ -432,7 +432,7 @@ let WriteMdbInfo fmdb f info =
// Finished generating debug information for the curretn method // Finished generating debug information for the curretn method
wr?CloseMethod() wr?CloseMethod()
| _ -> () | _ -> ()
// Finalize - MDB requires the MVID of the generated .NET module // Finalize - MDB requires the MVID of the generated .NET module
let moduleGuid = new System.Guid(info.ModuleID |> Array.map byte) let moduleGuid = new System.Guid(info.ModuleID |> Array.map byte)
wr?WriteSymbolFile(moduleGuid) wr?WriteSymbolFile(moduleGuid)
...@@ -476,11 +476,16 @@ let DumpDebugInfo (outfile:string) (info:PdbData) = ...@@ -476,11 +476,16 @@ let DumpDebugInfo (outfile:string) (info:PdbData) =
writeScope "" meth.RootScope writeScope "" meth.RootScope
fprintfn sw "" fprintfn sw ""
#endif
//--------------------------------------------------------------------- //---------------------------------------------------------------------
// Strong name signing // Strong name signing
//--------------------------------------------------------------------- //---------------------------------------------------------------------
#if FX_NO_KEY_SIGNING
type ILStrongNameSigner = unit
#else
type ILStrongNameSigner = type ILStrongNameSigner =
| PublicKeySigner of Support.pubkey | PublicKeySigner of Support.pubkey
| KeyPair of Support.keyPair | KeyPair of Support.keyPair
...@@ -522,6 +527,7 @@ type ILStrongNameSigner = ...@@ -522,6 +527,7 @@ type ILStrongNameSigner =
| PublicKeySigner _ -> () | PublicKeySigner _ -> ()
| KeyPair kp -> Support.signerSignFileWithKeyPair file kp | KeyPair kp -> Support.signerSignFileWithKeyPair file kp
| KeyContainer kn -> Support.signerSignFileWithKeyContainer file kn | KeyContainer kn -> Support.signerSignFileWithKeyContainer file kn
#endif
//--------------------------------------------------------------------- //---------------------------------------------------------------------
// TYPES FOR TABLES // TYPES FOR TABLES
...@@ -3357,12 +3363,15 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG ...@@ -3357,12 +3363,15 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG
if not isDll then dprintn "warning: no entrypoint specified in executable binary"; if not isDll then dprintn "warning: no entrypoint specified in executable binary";
0x0 0x0
#if FX_NO_PDB_WRITER
let pdbData = ()
#else
let pdbData = let pdbData =
{ EntryPoint= (if isDll then None else Some entryPointToken); { EntryPoint= (if isDll then None else Some entryPointToken);
ModuleID = cenv.moduleGuid; ModuleID = cenv.moduleGuid;
Documents = cenv.documents.EntriesAsArray; Documents = cenv.documents.EntriesAsArray;
Methods= cenv.pdbinfo.ToArray() } Methods= cenv.pdbinfo.ToArray() }
#endif
let idxForNextedTypeDef (tds:ILTypeDef list, td:ILTypeDef) = let idxForNextedTypeDef (tds:ILTypeDef list, td:ILTypeDef) =
let enc = tds |> List.map (fun td -> td.Name) let enc = tds |> List.map (fun td -> td.Name)
GetIdxForTypeDef cenv (TdKey(enc, td.Name)) GetIdxForTypeDef cenv (TdKey(enc, td.Name))
...@@ -3412,12 +3421,16 @@ let count f arr = ...@@ -3412,12 +3421,16 @@ let count f arr =
module FileSystemUtilites = module FileSystemUtilites =
open System.Reflection open System.Reflection
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
let progress = try System.Environment.GetEnvironmentVariable("FSharp_DebugSetFilePermissions") <> null with _ -> false let progress = try System.Environment.GetEnvironmentVariable("FSharp_DebugSetFilePermissions") <> null with _ -> false
let setExecutablePermission filename = let setExecutablePermission filename =
#if ENABLE_MONO_SUPPORT
if runningOnMono then if runningOnMono then
try try
let monoPosix = Assembly.Load("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756") let monoPosix = Assembly.Load(new AssemblyName("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756"))
if progress then eprintf "loading type Mono.Unix.UnixFileInfo...\n"; if progress then eprintf "loading type Mono.Unix.UnixFileInfo...\n";
let monoUnixFileInfo = monoPosix.GetType("Mono.Unix.UnixFileSystemInfo") let monoUnixFileInfo = monoPosix.GetType("Mono.Unix.UnixFileSystemInfo")
let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |],System.Globalization.CultureInfo.InvariantCulture) let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |],System.Globalization.CultureInfo.InvariantCulture)
...@@ -3427,7 +3440,12 @@ module FileSystemUtilites = ...@@ -3427,7 +3440,12 @@ module FileSystemUtilites =
with e -> with e ->
if progress then eprintf "failure: %s...\n" (e.ToString()); if progress then eprintf "failure: %s...\n" (e.ToString());
// Fail silently // Fail silently
else
#else
ignore filename
#endif
()
let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,showTimes) modul noDebugData cilStartAddress = let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,showTimes) modul noDebugData cilStartAddress =
// When we know the real RVAs of the data section we fixup the references for the FieldRVA table. // When we know the real RVAs of the data section we fixup the references for the FieldRVA table.
...@@ -3877,13 +3895,20 @@ let writeDirectory os dict = ...@@ -3877,13 +3895,20 @@ let writeDirectory os dict =
let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk,0,chunk.Length) let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk,0,chunk.Length)
let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ILStrongNameSigner option, fixupOverlappingSequencePoints, emitTailcalls, showTimes, dumpDebugInfo) modul noDebugData = let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option,
#if FX_NO_KEY_SIGNING
#else
signer: ILStrongNameSigner option,
#endif
fixupOverlappingSequencePoints, emitTailcalls, showTimes, dumpDebugInfo) modul noDebugData =
// Store the public key from the signer into the manifest. This means it will be written // Store the public key from the signer into the manifest. This means it will be written
// to the binary and also acts as an indicator to leave space for delay sign // to the binary and also acts as an indicator to leave space for delay sign
reportTime showTimes "Write Started"; reportTime showTimes "Write Started";
let isDll = modul.IsDLL let isDll = modul.IsDLL
#if FX_NO_KEY_SIGNING
#else
let signer = let signer =
match signer,modul.Manifest with match signer,modul.Manifest with
| Some _, _ -> signer | Some _, _ -> signer
...@@ -3915,6 +3940,7 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -3915,6 +3940,7 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
dprintn "Warning: The output assembly is being signed or delay-signed with a strong name that is different to the original." dprintn "Warning: The output assembly is being signed or delay-signed with a strong name that is different to the original."
end; end;
{ modul with Manifest = match modul.Manifest with None -> None | Some m -> Some {m with PublicKey = pubkey} } { modul with Manifest = match modul.Manifest with None -> None | Some m -> Some {m with PublicKey = pubkey} }
#endif
let timestamp = absilWriteGetTimeStamp () let timestamp = absilWriteGetTimeStamp ()
...@@ -3924,9 +3950,14 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -3924,9 +3950,14 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
with e -> with e ->
failwith ("Could not open file for writing (binary mode): " + outfile) failwith ("Could not open file for writing (binary mode): " + outfile)
let pdbData,debugDirectoryChunk,debugDataChunk,textV2P,mappings =
#if FX_NO_KEY_SIGNING
let pdbData,mappings =
#else
let pdbData,debugDirectoryChunk,debugDataChunk,textV2P,mappings =
#endif
try try
let imageBaseReal = modul.ImageBase // FIXED CHOICE let imageBaseReal = modul.ImageBase // FIXED CHOICE
let alignVirt = modul.VirtualAlignment // FIXED CHOICE let alignVirt = modul.VirtualAlignment // FIXED CHOICE
let alignPhys = modul.PhysicalAlignment // FIXED CHOICE let alignPhys = modul.PhysicalAlignment // FIXED CHOICE
...@@ -4001,12 +4032,14 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4001,12 +4032,14 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
let _codePaddingChunk,next = chunk codePadding.Length next let _codePaddingChunk,next = chunk codePadding.Length next
let metadataChunk,next = chunk metadata.Length next let metadataChunk,next = chunk metadata.Length next
#if FX_NO_KEY_SIGNING
#else
let strongnameChunk,next = let strongnameChunk,next =
match signer with match signer with
| None -> nochunk next | None -> nochunk next
| Some s -> chunk s.SignatureSize next | Some s -> chunk s.SignatureSize next
#endif
let resourcesChunk,next = chunk resources.Length next let resourcesChunk,next = chunk resources.Length next
let rawdataChunk,next = chunk data.Length next let rawdataChunk,next = chunk data.Length next
...@@ -4051,25 +4084,29 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4051,25 +4084,29 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
let dataSectionAddr = next let dataSectionAddr = next
let dataSectionVirtToPhys v = v - dataSectionAddr + dataSectionPhysLoc let dataSectionVirtToPhys v = v - dataSectionAddr + dataSectionPhysLoc
#if FX_NO_LINKEDRESOURCES
#else
let resourceFormat = if modul.Is64Bit then Support.X64 else Support.X86 let resourceFormat = if modul.Is64Bit then Support.X64 else Support.X86
let nativeResources = let nativeResources =
match modul.NativeResources with match modul.NativeResources with
| [] -> [||] | [] -> [||]
| resources -> | resources ->
#if ENABLE_MONO_SUPPORT
if runningOnMono then if runningOnMono then
[||] [||]
else else
#endif
let unlinkedResources = List.map Lazy.force resources let unlinkedResources = List.map Lazy.force resources
begin begin
try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName(outfile)) try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName(outfile))
with e -> failwith ("Linking a native resource failed: "+e.Message+"") with e -> failwith ("Linking a native resource failed: "+e.Message+"")
end end
let nativeResourcesSize = nativeResources.Length let nativeResourcesSize = nativeResources.Length
let nativeResourcesChunk,next = chunk nativeResourcesSize next let nativeResourcesChunk,next = chunk nativeResourcesSize next
#endif
let dummydatap,next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next let dummydatap,next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next
let dataSectionSize = next - dataSectionAddr let dataSectionSize = next - dataSectionAddr
...@@ -4234,9 +4271,11 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4234,9 +4271,11 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
writeInt32 os 0x00; // Export Table Always 0 (see Section 23.1). writeInt32 os 0x00; // Export Table Always 0 (see Section 23.1).
// 00000100 // 00000100
writeDirectory os importTableChunk; // Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 writeDirectory os importTableChunk; // Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530
#if FX_NO_LINKEDRESOURCES
#else
// Native Resource Table: ECMA says Always 0 (see Section 23.1), but mscorlib and other files with resources bound into executable do not. For the moment assume the resources table is always the first resource in the file. // Native Resource Table: ECMA says Always 0 (see Section 23.1), but mscorlib and other files with resources bound into executable do not. For the moment assume the resources table is always the first resource in the file.
writeDirectory os nativeResourcesChunk; writeDirectory os nativeResourcesChunk;
#endif
// 00000110 // 00000110
writeInt32 os 0x00; // Exception Table Always 0 (see Section 23.1). writeInt32 os 0x00; // Exception Table Always 0 (see Section 23.1).
writeInt32 os 0x00; // Exception Table Always 0 (see Section 23.1). writeInt32 os 0x00; // Exception Table Always 0 (see Section 23.1).
...@@ -4335,8 +4374,11 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4335,8 +4374,11 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
(if modul.IsILOnly then 0x01 else 0x00) ||| (if modul.IsILOnly then 0x01 else 0x00) |||
(if modul.Is32Bit then 0x02 else 0x00) ||| (if modul.Is32Bit then 0x02 else 0x00) |||
(if modul.Is32BitPreferred then 0x00020003 else 0x00) ||| (if modul.Is32BitPreferred then 0x00020003 else 0x00) |||
#if FX_NO_KEY_SIGNING
0x00
#else
(if (match signer with None -> false | Some s -> s.IsFullySigned) then 0x08 else 0x00) (if (match signer with None -> false | Some s -> s.IsFullySigned) then 0x08 else 0x00)
#endif
let headerVersionMajor,headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion let headerVersionMajor,headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion
writePadding os "pad to cli header" cliHeaderPadding writePadding os "pad to cli header" cliHeaderPadding
...@@ -4353,7 +4395,10 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4353,7 +4395,10 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
// e.g. 0x0220 // e.g. 0x0220
writeDirectory os resourcesChunk; writeDirectory os resourcesChunk;
#if FX_NO_KEY_SIGNING
#else
writeDirectory os strongnameChunk; writeDirectory os strongnameChunk;
#endif
// e.g. 0x0230 // e.g. 0x0230
writeInt32 os 0x00; // code manager table, always 0 writeInt32 os 0x00; // code manager table, always 0
writeInt32 os 0x00; // code manager table, always 0 writeInt32 os 0x00; // code manager table, always 0
...@@ -4370,9 +4415,11 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4370,9 +4415,11 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
writeBytes os metadata; writeBytes os metadata;
// write 0x80 bytes of empty space for encrypted SHA1 hash, written by SN.EXE or call to signing API // write 0x80 bytes of empty space for encrypted SHA1 hash, written by SN.EXE or call to signing API
#if FX_NO_KEY_SIGNING
#else
if signer <> None then if signer <> None then
write (Some (textV2P strongnameChunk.addr)) os "strongname" (Array.create strongnameChunk.size 0x0uy); write (Some (textV2P strongnameChunk.addr)) os "strongname" (Array.create strongnameChunk.size 0x0uy);
#endif
write (Some (textV2P resourcesChunk.addr)) os "raw resources" [| |]; write (Some (textV2P resourcesChunk.addr)) os "raw resources" [| |];
writeBytes os resources; writeBytes os resources;
write (Some (textV2P rawdataChunk.addr)) os "raw data" [| |]; write (Some (textV2P rawdataChunk.addr)) os "raw data" [| |];
...@@ -4430,17 +4477,19 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4430,17 +4477,19 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize); writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize);
// DATA SECTION // DATA SECTION
#if FX_NO_LINKEDRESOURCES
#else
match nativeResources with match nativeResources with
| [||] -> () | [||] -> ()
| resources -> | resources ->
write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |]; write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |];
writeBytes os resources; writeBytes os resources;
#endif
if dummydatap.size <> 0x0 then if dummydatap.size <> 0x0 then
write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |]; write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |];
writePadding os "end of .rsrc" (relocSectionPhysLoc - dataSectionPhysLoc - dataSectionSize); writePadding os "end of .rsrc" (relocSectionPhysLoc - dataSectionPhysLoc - dataSectionSize);
// RELOC SECTION // RELOC SECTION
// See ECMA 24.3.2 // See ECMA 24.3.2
...@@ -4464,34 +4513,43 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4464,34 +4513,43 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
b0 reloc2; b1 reloc2; |]; b0 reloc2; b1 reloc2; |];
writePadding os "end of .reloc" (imageEndSectionPhysLoc - relocSectionPhysLoc - relocSectionSize); writePadding os "end of .reloc" (imageEndSectionPhysLoc - relocSectionPhysLoc - relocSectionSize);
os.Close(); os.Dispose();
try try
FileSystemUtilites.setExecutablePermission outfile FileSystemUtilites.setExecutablePermission outfile
with _ -> with _ ->
() ()
#if FX_NO_KEY_SIGNING
pdbData,mappings
#else
pdbData,debugDirectoryChunk,debugDataChunk,textV2P,mappings pdbData,debugDirectoryChunk,debugDataChunk,textV2P,mappings
#endif
// Looks like a finally... // Looks like a finally
with e -> with e ->
(try (try
os.Close(); os.Dispose();
FileSystem.FileDelete outfile FileSystem.FileDelete outfile
with _ -> ()); with _ -> ());
reraise() reraise()
reportTime showTimes "Writing Image"; reportTime showTimes "Writing Image";
#if FX_NO_PDB_WRITER
ignore fixupOverlappingSequencePoints
ignore dumpDebugInfo
ignore pdbData
#else
if dumpDebugInfo then if dumpDebugInfo then
DumpDebugInfo outfile pdbData DumpDebugInfo outfile pdbData
// Now we've done the bulk of the binary, do the PDB file and fixup the binary. // Now we've done the bulk of the binary, do the PDB file and fixup the binary.
begin match pdbfile with begin match pdbfile with
| None -> () | None -> ()
#if ENABLE_MONO_SUPPORT
| Some fmdb when runningOnMono -> | Some fmdb when runningOnMono ->
WriteMdbInfo fmdb outfile pdbData WriteMdbInfo fmdb outfile pdbData
#endif
| Some fpdb -> | Some fpdb ->
try try
let idd = WritePdbInfo fixupOverlappingSequencePoints showTimes outfile fpdb pdbData let idd = WritePdbInfo fixupOverlappingSequencePoints showTimes outfile fpdb pdbData
...@@ -4523,17 +4581,20 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4523,17 +4581,20 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
if debugDataChunk.size < idd.iddData.Length then if debugDataChunk.size < idd.iddData.Length then
failwith "Debug data area is not big enough. Debug info may not be usable"; failwith "Debug data area is not big enough. Debug info may not be usable";
writeBytes os2 idd.iddData; writeBytes os2 idd.iddData;
os2.Close() os2.Dispose()
with e -> with e ->
failwith ("Error while writing debug directory entry: "+e.Message); failwith ("Error while writing debug directory entry: "+e.Message);
(try os2.Close(); FileSystem.FileDelete outfile with _ -> ()); (try os2.Dispose(); FileSystem.FileDelete outfile with _ -> ());
reraise() reraise()
with e -> with e ->
reraise() reraise()
end; end;
reportTime showTimes "Finalize PDB"; reportTime showTimes "Finalize PDB";
#endif
#if FX_NO_KEY_SIGNING
#else
/// Sign the binary. No further changes to binary allowed past this point! /// Sign the binary. No further changes to binary allowed past this point!
match signer with match signer with
| None -> () | None -> ()
...@@ -4549,14 +4610,17 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ...@@ -4549,14 +4610,17 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer:
reportTime showTimes "Signing Image"; reportTime showTimes "Signing Image";
//Finished writing and signing the binary and debug info... //Finished writing and signing the binary and debug info...
#endif
mappings mappings
type options = type options =
{ ilg: ILGlobals; { ilg: ILGlobals;
pdbfile: string option; pdbfile: string option;
#if FX_NO_KEY_SIGNING
#else
signer: ILStrongNameSigner option; signer: ILStrongNameSigner option;
#endif
fixupOverlappingSequencePoints: bool; fixupOverlappingSequencePoints: bool;
emitTailcalls : bool; emitTailcalls : bool;
showTimes: bool; showTimes: bool;
...@@ -4564,8 +4628,12 @@ type options = ...@@ -4564,8 +4628,12 @@ type options =
let WriteILBinary outfile (args: options) modul noDebugData = let WriteILBinary outfile (args: options) modul noDebugData =
ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.fixupOverlappingSequencePoints, args.emitTailcalls, args.showTimes, args.dumpDebugInfo) modul noDebugData) ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile,
#if FX_NO_KEY_SIGNING
#else
args.signer,
#endif
args.fixupOverlappingSequencePoints, args.emitTailcalls, args.showTimes, args.dumpDebugInfo) modul noDebugData)
(****************************************************** (******************************************************
......
...@@ -7,6 +7,9 @@ open Microsoft.FSharp.Compiler.AbstractIL ...@@ -7,6 +7,9 @@ open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal
open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.IL
#if FX_NO_KEY_SIGNING
type ILStrongNameSigner = unit
#else
[<Sealed>] [<Sealed>]
type ILStrongNameSigner = type ILStrongNameSigner =
member PublicKey: byte[] member PublicKey: byte[]
...@@ -14,11 +17,15 @@ type ILStrongNameSigner = ...@@ -14,11 +17,15 @@ type ILStrongNameSigner =
static member OpenPublicKey: byte[] -> ILStrongNameSigner static member OpenPublicKey: byte[] -> ILStrongNameSigner
static member OpenKeyPairFile: string -> ILStrongNameSigner static member OpenKeyPairFile: string -> ILStrongNameSigner
static member OpenKeyContainer: string -> ILStrongNameSigner static member OpenKeyContainer: string -> ILStrongNameSigner
#endif
type options = type options =
{ ilg: ILGlobals { ilg: ILGlobals
pdbfile: string option; pdbfile: string option;
#if FX_NO_KEY_SIGNING
#else
signer : ILStrongNameSigner option; signer : ILStrongNameSigner option;
#endif
fixupOverlappingSequencePoints : bool; fixupOverlappingSequencePoints : bool;
emitTailcalls: bool; emitTailcalls: bool;
showTimes : bool; showTimes : bool;
......
...@@ -6,14 +6,15 @@ ...@@ -6,14 +6,15 @@
<!-- Compiler: .NET 2.0 and 4.0 only --> <!-- Compiler: .NET 2.0 and 4.0 only -->
<ItemGroup Condition=" '$(TargetFramework)' == 'net20' or <ItemGroup Condition=" '$(TargetFramework)' == 'net20' or
'$(TargetFramework)' == 'net40'"> '$(TargetFramework)' == 'net40' or
<ProjectFiles Include="fsharp\FSharp.Build\FSharp.Build.fsproj"/> '$(TargetFramework)' == 'coreclr' ">
<ProjectFiles Include="fsharp\FSharp.Build\FSharp.Build.fsproj" Condition="'$(TargetFramework)' != 'coreclr'" />
<ProjectFiles Include="fsharp\FSharp.Compiler\FSharp.Compiler.fsproj"/> <ProjectFiles Include="fsharp\FSharp.Compiler\FSharp.Compiler.fsproj"/>
<ProjectFiles Include="fsharp\FSharp.Compiler.Server.Shared\FSharp.Compiler.Server.Shared.fsproj"/> <ProjectFiles Include="fsharp\FSharp.Compiler.Server.Shared\FSharp.Compiler.Server.Shared.fsproj" Condition="'$(TargetFramework)' != 'coreclr'" />
<ProjectFiles Include="fsharp\FSharp.Compiler.Interactive.Settings\FSharp.Compiler.Interactive.Settings.fsproj"/> <ProjectFiles Include="fsharp\FSharp.Compiler.Interactive.Settings\FSharp.Compiler.Interactive.Settings.fsproj" Condition="'$(TargetFramework)' != 'coreclr'" />
<ProjectFiles Include="fsharp\Fsc\Fsc.fsproj"/> <ProjectFiles Include="fsharp\Fsc\Fsc.fsproj"/>
<ProjectFiles Include="fsharp\fsi\Fsi.fsproj"/> <ProjectFiles Include="fsharp\fsi\Fsi.fsproj" Condition="'$(TargetFramework)' != 'coreclr'" />
<ProjectFiles Include="fsharp\fsiAnyCpu\FsiAnyCpu.fsproj"/> <ProjectFiles Include="fsharp\fsiAnyCpu\FsiAnyCpu.fsproj" Condition="'$(TargetFramework)' != 'coreclr'" />
</ItemGroup> </ItemGroup>
......
...@@ -99,15 +99,6 @@ let rec AttachRange m (exn:exn) = ...@@ -99,15 +99,6 @@ let rec AttachRange m (exn:exn) =
type Exiter = type Exiter =
abstract Exit : int -> 'T abstract Exit : int -> 'T
let QuitProcessExiter =
{ new Exiter with
member x.Exit(n) =
try
System.Environment.Exit(n)
with _ ->
()
failwithf "%s" <| FSComp.SR.elSysEnvExitDidntExit() }
/// Closed enumeration of build phases. /// Closed enumeration of build phases.
type BuildPhase = type BuildPhase =
| DefaultPhase | DefaultPhase
...@@ -287,6 +278,10 @@ module ErrorLoggerExtensions = ...@@ -287,6 +278,10 @@ module ErrorLoggerExtensions =
// Reraise an exception if it is one we want to report to Watson. // Reraise an exception if it is one we want to report to Watson.
let ReraiseIfWatsonable(exn:exn) = let ReraiseIfWatsonable(exn:exn) =
#if FX_REDUCED_EXCEPTIONS
ignore exn
()
#else
match exn with match exn with
// These few SystemExceptions which we don't report to Watson are because we handle these in some way in Build.fs // These few SystemExceptions which we don't report to Watson are because we handle these in some way in Build.fs
| :? System.Reflection.TargetInvocationException -> () | :? System.Reflection.TargetInvocationException -> ()
...@@ -298,6 +293,7 @@ module ErrorLoggerExtensions = ...@@ -298,6 +293,7 @@ module ErrorLoggerExtensions =
PreserveStackTrace(exn) PreserveStackTrace(exn)
raise exn raise exn
| _ -> () | _ -> ()
#endif
type ErrorLogger with type ErrorLogger with
member x.ErrorR exn = match exn with StopProcessing | ReportedError _ -> raise exn | _ -> x.ErrorSink(PhasedError.Create(exn,CompileThreadStatic.BuildPhase)) member x.ErrorR exn = match exn with StopProcessing | ReportedError _ -> raise exn | _ -> x.ErrorSink(PhasedError.Create(exn,CompileThreadStatic.BuildPhase))
...@@ -311,7 +307,10 @@ module ErrorLoggerExtensions = ...@@ -311,7 +307,10 @@ module ErrorLoggerExtensions =
// Throws StopProcessing and exceptions raised by the ErrorSink(exn) handler. // Throws StopProcessing and exceptions raised by the ErrorSink(exn) handler.
match exn with match exn with
(* Don't send ThreadAbortException down the error channel *) (* Don't send ThreadAbortException down the error channel *)
#if FX_REDUCED_EXCEPTIONS
#else
| :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException),_) -> () | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException),_) -> ()
#endif
| ReportedError _ | WrappedError(ReportedError _,_) -> () | ReportedError _ | WrappedError(ReportedError _,_) -> ()
| StopProcessing | WrappedError(StopProcessing,_) -> raise exn | StopProcessing | WrappedError(StopProcessing,_) -> raise exn
| _ -> | _ ->
......
...@@ -9,6 +9,11 @@ open System.Collections.Generic ...@@ -9,6 +9,11 @@ open System.Collections.Generic
#if EXTENSIBLE_DUMPER #if EXTENSIBLE_DUMPER
#if DEBUG #if DEBUG
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
type internal ExtensibleDumper(x:obj) = type internal ExtensibleDumper(x:obj) =
static let mutable dumpers = new Dictionary<Type,(Type*MethodInfo) option>() static let mutable dumpers = new Dictionary<Type,(Type*MethodInfo) option>()
...@@ -21,7 +26,7 @@ type internal ExtensibleDumper(x:obj) = ...@@ -21,7 +26,7 @@ type internal ExtensibleDumper(x:obj) =
let dumpeeType = o.GetType() let dumpeeType = o.GetType()
let DeriveDumperName(dumpeeType:Type) = let DeriveDumperName(dumpeeType:Type) =
"Internal.Utilities.Diagnostic." + dumpeeType.Name + "Dumper" "Internal.Utilities.Diagnostic." + dumpeeType.Name + "Dumper"
match dumpers.TryGetValue(dumpeeType) with match dumpers.TryGetValue(dumpeeType) with
| true, Some(dumperType, methodInfo) -> | true, Some(dumperType, methodInfo) ->
...@@ -34,9 +39,9 @@ type internal ExtensibleDumper(x:obj) = ...@@ -34,9 +39,9 @@ type internal ExtensibleDumper(x:obj) =
"There is no dumper named "+(DeriveDumperName dumpeeType)+" with single constructor that takes "+dumpeeType.Name+" and property named Dump." "There is no dumper named "+(DeriveDumperName dumpeeType)+" with single constructor that takes "+dumpeeType.Name+" and property named Dump."
| false, _ -> | false, _ ->
let TryAdd(dumpeeType:Type) = let TryAdd(dumpeeType:Type) =
let dumperDerivedName = DeriveDumperName(dumpeeType) let dumperDerivedName = DeriveDumperName(dumpeeType)
let dumperAssembly = dumpeeType.Assembly // Dumper must live in the same assembly as dumpee let dumperAssembly = dumpeeType.Assembly // Dumper must live in the same assembly as dumpee
let dumperType = dumperAssembly.GetType(dumperDerivedName, (*throwOnError*)false) let dumperType = dumperAssembly.GetType(dumperDerivedName, (*throwOnError*)false, (*ignoreCase*)false)
if dumperType <> null then if dumperType <> null then
let dumpMethod = dumperType.GetMethod("ToString") let dumpMethod = dumperType.GetMethod("ToString")
if dumpMethod <> null then if dumpMethod <> null then
...@@ -46,15 +51,12 @@ type internal ExtensibleDumper(x:obj) = ...@@ -46,15 +51,12 @@ type internal ExtensibleDumper(x:obj) =
let parameters = constr.GetParameters() let parameters = constr.GetParameters()
if parameters.Length = 1 then if parameters.Length = 1 then
dumpers.[o.GetType()] <- Some(dumperType,dumpMethod) dumpers.[o.GetType()] <- Some(dumperType,dumpMethod)
dumpers.ContainsKey(o.GetType()) dumpers.ContainsKey(o.GetType())
if (not(TryAdd(o.GetType()))) then if (not(TryAdd(o.GetType()))) then
if (not(TryAdd(o.GetType().BaseType))) then if (not(TryAdd(o.GetType().BaseType))) then
dumpers.[dumpeeType] <- None dumpers.[dumpeeType] <- None
ExtensibleDumper.Dump(o) // Show the message ExtensibleDumper.Dump(o) // Show the message
#endif #endif
#endif #endif
...@@ -922,6 +922,7 @@ optsUseHighEntropyVA,"Enable high-entropy ASLR" ...@@ -922,6 +922,7 @@ optsUseHighEntropyVA,"Enable high-entropy ASLR"
optsSubSystemVersion,"Specify subsystem version of this assembly" optsSubSystemVersion,"Specify subsystem version of this assembly"
optsTargetProfile,"Specify target framework profile of this assembly. Valid values are mscorlib or netcore. Default - mscorlib" optsTargetProfile,"Specify target framework profile of this assembly. Valid values are mscorlib or netcore. Default - mscorlib"
optsEmitDebugInfoInQuotations,"Emit debug information in quotations" optsEmitDebugInfoInQuotations,"Emit debug information in quotations"
optsPreferredUiLang," Specify the preferred output language culture name (e.g. es-ES, ja-JP)"
1051,optsInvalidSubSystemVersion,"Invalid version '%s' for '--subsystemversion'. The version must be 4.00 or greater." 1051,optsInvalidSubSystemVersion,"Invalid version '%s' for '--subsystemversion'. The version must be 4.00 or greater."
1052,optsInvalidTargetProfile,"Invalid value '%s' for '--targetprofile', valid values are 'mscorlib' or 'netcore'." 1052,optsInvalidTargetProfile,"Invalid value '%s' for '--targetprofile', valid values are 'mscorlib' or 'netcore'."
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
...@@ -1140,6 +1141,8 @@ lexIndentOffForML,"Consider using a file with extension '.ml' or '.mli' instead" ...@@ -1140,6 +1141,8 @@ lexIndentOffForML,"Consider using a file with extension '.ml' or '.mli' instead"
1243,parsUnexpectedQuotationOperatorInTypeAliasDidYouMeanVerbatimString,"Unexpected quotation operator '<@' in type definition. If you intend to pass a verbatim string as a static argument to a type provider, put a space between the '<' and '@' characters." 1243,parsUnexpectedQuotationOperatorInTypeAliasDidYouMeanVerbatimString,"Unexpected quotation operator '<@' in type definition. If you intend to pass a verbatim string as a static argument to a type provider, put a space between the '<' and '@' characters."
1244,parsErrorParsingAsOperatorName,"Attempted to parse this as an operator name, but failed" 1244,parsErrorParsingAsOperatorName,"Attempted to parse this as an operator name, but failed"
1245,lexInvalidUnicodeLiteral,"\U%s is not a valid Unicode character escape sequence" 1245,lexInvalidUnicodeLiteral,"\U%s is not a valid Unicode character escape sequence"
# reshaped_msbuild.fs
1300,toolLocationHelperUnsupportedFrameworkVersion,"The specified .NET Framework version "%s" is not supported. Please specify a value from the enumeration Microsoft.Build.Utilities.TargetDotNetFrameworkVersion."
# Fsc.exe resource strings # Fsc.exe resource strings
fscTooManyErrors,"Exiting - too many errors" fscTooManyErrors,"Exiting - too many errors"
2001,docfileNoXmlSuffix,"The documentation file has no .xml suffix" 2001,docfileNoXmlSuffix,"The documentation file has no .xml suffix"
......
...@@ -16,9 +16,9 @@ ...@@ -16,9 +16,9 @@
<ProjectGuid>{D8BC791F-C1A9-49DC-9432-0F3090537555}</ProjectGuid> <ProjectGuid>{D8BC791F-C1A9-49DC-9432-0F3090537555}</ProjectGuid>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<FsSrGen Include="..\FSharp.Build\FSBuild.txt"> <FsSrGen Include="..\FSharp.Build\FSBuild.txt">
<Link>FSBuild.txt</Link> <Link>FSBuild.txt</Link>
</FsSrGen> </FsSrGen>
<Compile Include="..\..\utils\CompilerLocationUtils.fs"> <Compile Include="..\..\utils\CompilerLocationUtils.fs">
<Link>CompilerLocationUtils.fs</Link> <Link>CompilerLocationUtils.fs</Link>
</Compile> </Compile>
......
...@@ -145,7 +145,11 @@ type [<Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:Iden ...@@ -145,7 +145,11 @@ type [<Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:Iden
let mutable win32manifest : string = null let mutable win32manifest : string = null
let mutable vserrors : bool = false let mutable vserrors : bool = false
let mutable validateTypeProviders : bool = false let mutable validateTypeProviders : bool = false
#if PREFERRED_UI_LANG
let mutable vsPreferredUiLang : string = null
#else
let mutable vslcid : string = null let mutable vslcid : string = null
#endif
let mutable utf8output : bool = false let mutable utf8output : bool = false
let mutable subsystemVersion : string = null let mutable subsystemVersion : string = null
let mutable highEntropyVA : bool = false let mutable highEntropyVA : bool = false
...@@ -313,9 +317,15 @@ type [<Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:Iden ...@@ -313,9 +317,15 @@ type [<Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:Iden
with get() = validateTypeProviders with get() = validateTypeProviders
and set(p) = validateTypeProviders <- p and set(p) = validateTypeProviders <- p
#if PREFERRED_UI_LANG
member fsc.VsPreferredUiLang
with get() = vsPreferredUiLang
and set(p) = vsPreferredUiLang <- p
#else
member fsc.LCID member fsc.LCID
with get() = vslcid with get() = vslcid
and set(p) = vslcid <- p and set(p) = vslcid <- p
#endif
member fsc.Utf8Output member fsc.Utf8Output
with get() = utf8output with get() = utf8output
...@@ -488,8 +498,11 @@ type [<Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:Iden ...@@ -488,8 +498,11 @@ type [<Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:Iden
if validateTypeProviders then if validateTypeProviders then
builder.AppendSwitch("--validate-type-providers") builder.AppendSwitch("--validate-type-providers")
#if PREFERRED_UI_LANG
builder.AppendSwitchIfNotNull("--preferreduilang:", vsPreferredUiLang)
#else
builder.AppendSwitchIfNotNull("--LCID:", vslcid) builder.AppendSwitchIfNotNull("--LCID:", vslcid)
#endif
if utf8output then if utf8output then
builder.AppendSwitch("--utf8output") builder.AppendSwitch("--utf8output")
......
...@@ -52,6 +52,9 @@ ...@@ -52,6 +52,9 @@
<OtherFlags>--internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing</OtherFlags> <OtherFlags>--internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing</OtherFlags>
<Link>ilpars.fsy</Link> <Link>ilpars.fsy</Link>
</FsYacc> </FsYacc>
<Compile Include="..\..\utils\reshaped_reflection.fs">
<Link>Reflection\reshaped_reflection.fs</Link>
</Compile>
<Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.dll.fs"> <Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.dll.fs">
<Link>assemblyinfo.FSharp.Compiler.dll.fs</Link> <Link>assemblyinfo.FSharp.Compiler.dll.fs</Link>
</Compile> </Compile>
...@@ -442,7 +445,6 @@ ...@@ -442,7 +445,6 @@
<Reference Include="Microsoft.Build, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" /> <Reference Include="Microsoft.Build, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<Reference Include="Microsoft.Build.Utilities.v4.0" /> <Reference Include="Microsoft.Build.Utilities.v4.0" />
<Reference Include="Microsoft.Build.Tasks.v4.0" /> <Reference Include="Microsoft.Build.Tasks.v4.0" />
</ItemGroup> </ItemGroup>
<Import Project="$(FSharpSourcesRoot)\FSharpSource.targets" /> <Import Project="$(FSharpSourcesRoot)\FSharpSource.targets" />
<Import Project="$(FSharpSourcesRoot)\..\lkg\FSharp-$(LkgVersion)\bin\FSharp.PowerPack.targets" /> <Import Project="$(FSharpSourcesRoot)\..\lkg\FSharp-$(LkgVersion)\bin\FSharp.PowerPack.targets" />
......
...@@ -14,9 +14,6 @@ ...@@ -14,9 +14,6 @@
<TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v2.0</TargetFrameworkVersion> <TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v2.0</TargetFrameworkVersion>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<FsSrGen Include="..\fsiserver\FSServerShared.txt">
<Link>FSServerShared.txt</Link>
</FsSrGen>
<Compile Include="InternalsVisibleTo.fs" /> <Compile Include="InternalsVisibleTo.fs" />
<Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.Server.Shared.dll.fs"> <Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.Server.Shared.dll.fs">
<Link>assemblyinfo.FSharp.Compiler.Server.Shared.dll.fs</Link> <Link>assemblyinfo.FSharp.Compiler.Server.Shared.dll.fs</Link>
...@@ -25,10 +22,15 @@ ...@@ -25,10 +22,15 @@
<Link>fsiserver.fs</Link> <Link>fsiserver.fs</Link>
</Compile> </Compile>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup Condition="'$(TargetFramework)' == 'coreclr'">
<None Include="project.json" />
</ItemGroup>
<ItemGroup Condition="'$(TargetFramework)' != 'coreclr'">
<Reference Include="mscorlib" /> <Reference Include="mscorlib" />
<Reference Include="System" /> <Reference Include="System" />
<Reference Include="System.Runtime.Remoting" /> <Reference Include="System.Runtime.Remoting" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Core\FSharp.Core.fsproj"> <ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Core\FSharp.Core.fsproj">
<Project>{DED3BBD7-53F4-428A-8C9F-27968E768605}</Project> <Project>{DED3BBD7-53F4-428A-8C9F-27968E768605}</Project>
<Name>FSharp.Core</Name> <Name>FSharp.Core</Name>
......
...@@ -10,13 +10,18 @@ ...@@ -10,13 +10,18 @@
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform> <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<OutputType>Library</OutputType> <OutputType>Library</OutputType>
<AssemblyName>FSharp.Compiler</AssemblyName> <AssemblyName>FSharp.Compiler</AssemblyName>
<DefineConstants>EXTENSIONTYPING;COMPILER;INCLUDE_METADATA_READER;INCLUDE_METADATA_WRITER;EXTENSIBLE_DUMPER;TYPE_PROVIDER_SECURITY;$(DefineConstants)</DefineConstants> <DefineConstants>EXTENSIONTYPING;COMPILER;INCLUDE_METADATA_READER;INCLUDE_METADATA_WRITER;EXTENSIBLE_DUMPER;$(DefineConstants)</DefineConstants>
<DefineConstants Condition=" '$(TargetFramework)'=='coreclr'">$(DefineConstants);PREFERRED_UI_LANG</DefineConstants>
<NoWarn>$(NoWarn);62;9</NoWarn> <NoWarn>$(NoWarn);62;9</NoWarn>
<ProjectGuid>{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}</ProjectGuid> <ProjectGuid>{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}</ProjectGuid>
<AllowCrossTargeting>true</AllowCrossTargeting> <AllowCrossTargeting>true</AllowCrossTargeting>
<BaseAddress>0x06800000</BaseAddress> <BaseAddress>0x06800000</BaseAddress>
<OtherFlags>$(OtherFlags) /warnon:1182</OtherFlags> <OtherFlags>$(OtherFlags) /warnon:1182</OtherFlags>
<OtherFlags Condition=" '$(TargetFramework)'=='coreclr'">$(OtherFlags) --targetprofile:netcore</OtherFlags>
</PropertyGroup> </PropertyGroup>
<!-- References -->
<Import Project="$(FSharpSourcesRoot)\.nuget\NuGet.targets" Condition="Exists('$(FSharpSourcesRoot)\.nuget\NuGet.targets')" />
<Import Project="$(FSharpSourcesRoot)\FSharpSource.targets" />
<ItemGroup> <ItemGroup>
<Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.dll.fs"> <Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.dll.fs">
<Link>assemblyinfo.FSharp.Compiler.dll.fs</Link> <Link>assemblyinfo.FSharp.Compiler.dll.fs</Link>
...@@ -27,6 +32,12 @@ ...@@ -27,6 +32,12 @@
<EmbeddedResource Include="..\FSStrings.resx"> <EmbeddedResource Include="..\FSStrings.resx">
<Link>FSStrings.resx</Link> <Link>FSStrings.resx</Link>
</EmbeddedResource> </EmbeddedResource>
<Compile Include="..\..\utils\reshaped_reflection.fs">
<Link>Reflection\reshaped_reflection.fs</Link>
</Compile>
<Compile Include="..\..\utils\reshaped_msbuild.fs">
<Link>Reflection\reshaped_msbuild.fs</Link>
</Compile>
<Compile Include="..\..\utils\sformat.fsi"> <Compile Include="..\..\utils\sformat.fsi">
<Link>ErrorText\sformat.fsi</Link> <Link>ErrorText\sformat.fsi</Link>
</Compile> </Compile>
...@@ -510,16 +521,14 @@ ...@@ -510,16 +521,14 @@
<Compile Include="..\vs\service.fs"> <Compile Include="..\vs\service.fs">
<Link>Service\service.fs</Link> <Link>Service\service.fs</Link>
</Compile> </Compile>
<!--
<Compile Include="..\vs\SimpleServices.fs">
<Link>SimpleServices.fs</Link>
</Compile>
-->
<Compile Include="InternalsVisibleTo.fs"> <Compile Include="InternalsVisibleTo.fs">
<Link>InternalsVisibleTo.fs</Link> <Link>InternalsVisibleTo.fs</Link>
</Compile> </Compile>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup Condition="'$(TargetFramework)' == 'coreclr'">
<None Include="project.json" />
</ItemGroup>
<ItemGroup Condition="'$(TargetFramework)' != 'coreclr'">
<Reference Include="mscorlib" /> <Reference Include="mscorlib" />
<Reference Include="System" /> <Reference Include="System" />
<Reference Include="System.Core" /> <Reference Include="System.Core" />
...@@ -533,6 +542,8 @@ ...@@ -533,6 +542,8 @@
<Reference Include="Microsoft.Build, Version=$(VisualStudioVersion).0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" /> <Reference Include="Microsoft.Build, Version=$(VisualStudioVersion).0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<Reference Include="Microsoft.Build.Utilities.$(MSBuildVersionSuffix)" /> <Reference Include="Microsoft.Build.Utilities.$(MSBuildVersionSuffix)" />
<Reference Include="Microsoft.Build.Tasks.$(MSBuildVersionSuffix)" /> <Reference Include="Microsoft.Build.Tasks.$(MSBuildVersionSuffix)" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Core\FSharp.Core.fsproj"> <ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Core\FSharp.Core.fsproj">
<Project>{DED3BBD7-53F4-428A-8C9F-27968E768605}</Project> <Project>{DED3BBD7-53F4-428A-8C9F-27968E768605}</Project>
<Name>FSharp.Core</Name> <Name>FSharp.Core</Name>
......
{
"dependencies": {
"Microsoft.NETCore.Runtime.CoreCLR-x86": "1.0.0-beta-*",
"Microsoft.NETCore.ConsoleHost-x86": "1.0.0-beta-*",
"Microsoft.NETCore.TestHost-x86": "1.0.0-beta-*",
"Microsoft.NETCore.Windows.ApiSets-x86": "1.0.0-beta-*",
"System.AppContext": "4.0.1-beta-*",
"System.Collections": "4.0.11-beta-*",
"System.Collections.Concurrent": "4.0.11-beta-*",
"System.Console": "4.0.0-beta-23225",
"System.Diagnostics.Debug": "4.0.11-beta-*",
"System.Diagnostics.Process": "4.0.0-beta-*",
"System.Diagnostics.Tools": "4.0.1-beta-*",
"System.IO": "4.0.11-beta-*",
"System.IO.FileSystem": "4.0.1-beta-23225",
"System.Linq": "4.0.1-beta-*",
"System.Linq.Expressions": "4.0.11-beta-*",
"System.Reflection": "4.1.0-beta-*",
"System.Reflection.Emit": "4.0.1-beta-*",
"System.Reflection.Emit.ILGeneration": "4.0.1-beta-*",
"System.Reflection.Extensions": "4.0.1-beta-*",
"System.Reflection.TypeExtensions": "4.0.0",
"System.Resources.ReaderWriter": "4.0.0-beta-*",
"System.Resources.ResourceManager": "4.0.1-beta-*",
"System.Runtime": "4.0.21-beta-*",
"System.Runtime.Extensions": "4.0.11-beta-*",
"System.Runtime.Numerics": "4.0.1-beta-*",
"System.Text.RegularExpressions": "4.0.11-beta-*",
"System.Security.Cryptography.Hashing.Algorithms": "4.0.0-beta-*",
"System.Threading.Thread": "4.0.0-beta-*",
}
}
此差异已折叠。
...@@ -113,6 +113,9 @@ ...@@ -113,6 +113,9 @@
<Compile Include="set.fs"> <Compile Include="set.fs">
<Link>Collections/set.fs</Link> <Link>Collections/set.fs</Link>
</Compile> </Compile>
<Compile Include="..\..\utils\reshaped_reflection.fs">
<Link>Reflection/reshaped_reflection.fs</Link>
</Compile>
<Compile Include="reflect.fsi"> <Compile Include="reflect.fsi">
<Link>Reflection/reflect.fsi</Link> <Link>Reflection/reflect.fsi</Link>
</Compile> </Compile>
......
...@@ -5,7 +5,8 @@ namespace Microsoft.FSharp.Core ...@@ -5,7 +5,8 @@ namespace Microsoft.FSharp.Core
module internal SR = module internal SR =
#if FX_RESHAPED_REFLECTION #if FX_RESHAPED_REFLECTION
open System.Reflection open System.Reflection
type TypeInThisAssembly(_dummy : obj) = class end type private TypeInThisAssembly (_dummy:obj) = class end
// can't use typeof here. Because intrinsics are not yet defined.
let private resources = new System.Resources.ResourceManager("FSCore", TypeInThisAssembly(null).GetType().GetTypeInfo().Assembly) let private resources = new System.Resources.ResourceManager("FSCore", TypeInThisAssembly(null).GetType().GetTypeInfo().Assembly)
#else #else
let private resources = new System.Resources.ResourceManager("FSCore", System.Reflection.Assembly.GetExecutingAssembly()) let private resources = new System.Resources.ResourceManager("FSCore", System.Reflection.Assembly.GetExecutingAssembly())
......
...@@ -1959,10 +1959,10 @@ namespace Microsoft.FSharp.Control ...@@ -1959,10 +1959,10 @@ namespace Microsoft.FSharp.Control
#if FX_ATLEAST_PORTABLE #if FX_ATLEAST_PORTABLE
let invokeMeth = (typeof<Closure<'T>>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) let invokeMeth = (typeof<Closure<'T>>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance)
System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate
#else #else
System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate
#endif #endif
// Start listening to events // Start listening to events
event.AddHandler(del) event.AddHandler(del)
......
...@@ -284,7 +284,7 @@ namespace Microsoft.FSharp.Core.CompilerServices ...@@ -284,7 +284,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
member this.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v member this.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v
member this.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName member this.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName
#if SILVERLIGHT_COMPILER_FSHARP_CORE #if FX_NO_CUSTOMATTRIBUTEDATA
type IProvidedCustomAttributeTypedArgument = type IProvidedCustomAttributeTypedArgument =
abstract ArgumentType: System.Type abstract ArgumentType: System.Type
abstract Value: System.Object abstract Value: System.Object
...@@ -292,6 +292,7 @@ namespace Microsoft.FSharp.Core.CompilerServices ...@@ -292,6 +292,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
type IProvidedCustomAttributeNamedArgument = type IProvidedCustomAttributeNamedArgument =
abstract ArgumentType: System.Type abstract ArgumentType: System.Type
abstract MemberInfo: System.Reflection.MemberInfo abstract MemberInfo: System.Reflection.MemberInfo
abstract MemberName: System.String
abstract TypedValue: IProvidedCustomAttributeTypedArgument abstract TypedValue: IProvidedCustomAttributeTypedArgument
type IProvidedCustomAttributeData = type IProvidedCustomAttributeData =
...@@ -318,7 +319,7 @@ namespace Microsoft.FSharp.Core.CompilerServices ...@@ -318,7 +319,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
abstract Invalidate : Microsoft.FSharp.Control.IEvent<System.EventHandler, System.EventArgs> abstract Invalidate : Microsoft.FSharp.Control.IEvent<System.EventHandler, System.EventArgs>
abstract GetGeneratedAssemblyContents : assembly:System.Reflection.Assembly -> byte[] abstract GetGeneratedAssemblyContents : assembly:System.Reflection.Assembly -> byte[]
#if SILVERLIGHT_COMPILER_FSHARP_CORE #if FX_NO_CUSTOMATTRIBUTEDATA
abstract GetMemberCustomAttributesData : assembly:System.Reflection.MemberInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData> abstract GetMemberCustomAttributesData : assembly:System.Reflection.MemberInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData>
abstract GetParameterCustomAttributesData : assembly:System.Reflection.ParameterInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData> abstract GetParameterCustomAttributesData : assembly:System.Reflection.ParameterInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData>
#endif #endif
......
...@@ -260,7 +260,7 @@ namespace Microsoft.FSharp.Core.CompilerServices ...@@ -260,7 +260,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
/// Checks if given type exists in target system runtime library /// Checks if given type exists in target system runtime library
member SystemRuntimeContainsType : string -> bool member SystemRuntimeContainsType : string -> bool
#if SILVERLIGHT_COMPILER_FSHARP_CORE #if FX_NO_CUSTOMATTRIBUTEDATA
type IProvidedCustomAttributeTypedArgument = type IProvidedCustomAttributeTypedArgument =
abstract ArgumentType: System.Type abstract ArgumentType: System.Type
abstract Value: System.Object abstract Value: System.Object
...@@ -268,6 +268,7 @@ namespace Microsoft.FSharp.Core.CompilerServices ...@@ -268,6 +268,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
type IProvidedCustomAttributeNamedArgument = type IProvidedCustomAttributeNamedArgument =
abstract ArgumentType: System.Type abstract ArgumentType: System.Type
abstract MemberInfo: System.Reflection.MemberInfo abstract MemberInfo: System.Reflection.MemberInfo
abstract MemberName: System.String
abstract TypedValue: IProvidedCustomAttributeTypedArgument abstract TypedValue: IProvidedCustomAttributeTypedArgument
type IProvidedCustomAttributeData = type IProvidedCustomAttributeData =
...@@ -348,7 +349,7 @@ namespace Microsoft.FSharp.Core.CompilerServices ...@@ -348,7 +349,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
/// </summary> /// </summary>
abstract GetGeneratedAssemblyContents : assembly:System.Reflection.Assembly -> byte[] abstract GetGeneratedAssemblyContents : assembly:System.Reflection.Assembly -> byte[]
#if SILVERLIGHT_COMPILER_FSHARP_CORE #if FX_NO_CUSTOMATTRIBUTEDATA
abstract GetMemberCustomAttributesData : assembly:System.Reflection.MemberInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData> abstract GetMemberCustomAttributesData : assembly:System.Reflection.MemberInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData>
abstract GetParameterCustomAttributesData : assembly:System.Reflection.ParameterInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData> abstract GetParameterCustomAttributesData : assembly:System.Reflection.ParameterInfo -> System.Collections.Generic.IList<IProvidedCustomAttributeData>
#endif #endif
......
...@@ -4123,7 +4123,6 @@ namespace Microsoft.FSharp.Core ...@@ -4123,7 +4123,6 @@ namespace Microsoft.FSharp.Core
let lastCons = PrivateListHelpers.appendToFreshConsTail res t let lastCons = PrivateListHelpers.appendToFreshConsTail res t
PrivateListHelpers.setFreshConsTail lastCons l2; PrivateListHelpers.setFreshConsTail lastCons l2;
res res
[<CompiledName("Increment")>] [<CompiledName("Increment")>]
let incr x = x.contents <- x.contents + 1 let incr x = x.contents <- x.contents + 1
......
{ {
"dependencies": { "dependencies": {
"System.Collections": "4.0.10-beta-*", "System.Collections": "4.0.11-beta-*",
"System.Collections.Concurrent": "4.0.10-beta-*", "System.Collections.Concurrent": "4.0.11-beta-*",
"System.Console": "4.0.0-beta-*", "System.Console": "4.0.0-beta-*",
"System.Diagnostics.Debug": "4.0.10-beta-*", "System.Diagnostics.Debug": "4.0.11-beta-*",
"System.Diagnostics.Tools": "4.0.0-beta-*", "System.Diagnostics.Tools": "4.0.1-beta-*",
"System.Globalization": "4.0.10-beta-*", "System.Globalization": "4.0.11-beta-*",
"System.IO": "4.0.10-beta-*", "System.IO": "4.0.11-beta-*",
"System.Linq": "4.0.0-beta-*", "System.Linq": "4.0.1-beta-*",
"System.Linq.Expressions": "4.0.0-beta-*", "System.Linq.Expressions": "4.0.11-beta-*",
"System.Linq.Queryable": "4.0.0-beta-*", "System.Linq.Queryable": "4.0.1-beta-*",
"System.Net.Requests": "4.0.0-beta-*", "System.Net.Requests": "4.0.11-beta-*",
"System.Reflection": "4.0.10-beta-*", "System.Reflection": "4.1.0-beta-*",
"System.Reflection.Emit": "4.0.0-beta-*", "System.Reflection.Emit": "4.0.1-beta-*",
"System.Reflection.Emit.ILGeneration": "4.0.0-beta-*", "System.Reflection.Emit.ILGeneration": "4.0.1-beta-*",
"System.Reflection.Extensions": "4.0.0-beta-*", "System.Reflection.Extensions": "4.0.1-beta-*",
"System.Resources.ResourceManager": "4.0.0-beta-*", "System.Reflection.TypeExtensions": "4.0.1-beta-*",
"System.Runtime": "4.0.20-beta-*", "System.Resources.ResourceManager": "4.0.1-beta-*",
"System.Runtime.Extensions": "4.0.10-beta-*", "System.Runtime": "4.0.21-beta-*",
"System.Runtime.InteropServices": "4.0.20-beta-*", "System.Runtime.Extensions": "4.0.11-beta-*",
"System.Runtime.Numerics": "4.0.0-beta-*", "System.Runtime.InteropServices": "4.0.21-beta-*",
"System.Text.Encoding": "4.0.10-beta-*", "System.Runtime.Numerics": "4.0.1-beta-*",
"System.Text.Encoding.Extensions": "4.0.10-beta-*", "System.Text.Encoding": "4.0.11-beta-*",
"System.Text.RegularExpressions": "4.0.10-beta-*", "System.Text.Encoding.Extensions": "4.0.11-beta-*",
"System.Threading": "4.0.0-beta-*", "System.Text.RegularExpressions": "4.0.11-beta-*",
"System.Threading.Tasks": "4.0.10-beta-*", "System.Threading": "4.0.11-beta-*",
"System.Threading.Tasks.Parallel": "4.0.0-beta-*", "System.Threading.Tasks": "4.0.11-beta-*",
"System.Threading.Tasks.Parallel": "4.0.1-beta-*",
"System.Threading.Thread": "4.0.0-beta-*", "System.Threading.Thread": "4.0.0-beta-*",
"System.Threading.ThreadPool": "4.0.10-beta-*", "System.Threading.ThreadPool": "4.0.10-beta-*",
"System.Threading.Timer": "4.0.0-beta-*" "System.Threading.Timer": "4.0.1-beta-*"
} }
} }
...@@ -3,208 +3,15 @@ ...@@ -3,208 +3,15 @@
// Reflection on F# values. Analyze an object to see if it the representation // Reflection on F# values. Analyze an object to see if it the representation
// of an F# value. // of an F# value.
#if FX_RESHAPED_REFLECTION
namespace Microsoft.FSharp.Core namespace Microsoft.FSharp.Core
open System open System
open System.Reflection open System.Reflection
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Collections open Microsoft.FSharp.Collections
open Microsoft.FSharp.Primitives.Basics
module ReflectionAdapters = namespace Microsoft.FSharp.Reflection
[<Flags>]
type BindingFlags =
| DeclaredOnly = 2
| Instance = 4
| Static = 8
| Public = 16
| NonPublic = 32
let inline hasFlag (flag : BindingFlags) f = (f &&& flag) = flag
let isDeclaredFlag f = hasFlag BindingFlags.DeclaredOnly f
let isPublicFlag f = hasFlag BindingFlags.Public f
let isStaticFlag f = hasFlag BindingFlags.Static f
let isInstanceFlag f = hasFlag BindingFlags.Instance f
let isNonPublicFlag f = hasFlag BindingFlags.NonPublic f
[<System.Flags>]
type TypeCode =
| Int32 = 0
| Int64 = 1
| Byte = 2
| SByte = 3
| Int16 = 4
| UInt16 = 5
| UInt32 = 6
| UInt64 = 7
| Single = 8
| Double = 9
| Decimal = 10
| Other = 11
let isAcceptable bindingFlags isStatic isPublic =
// 1. check if member kind (static\instance) was specified in flags
((isStaticFlag bindingFlags && isStatic) || (isInstanceFlag bindingFlags && not isStatic)) &&
// 2. check if member accessibility was specified in flags
((isPublicFlag bindingFlags && isPublic) || (isNonPublicFlag bindingFlags && not isPublic))
let publicFlags = BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static
let commit (results : _[]) =
match results with
| [||] -> null
| [| m |] -> m
| _ -> raise (AmbiguousMatchException())
let canUseAccessor (accessor : MethodInfo) nonPublic =
box accessor <> null && (accessor.IsPublic || nonPublic)
open PrimReflectionAdapters
type System.Type with
member this.GetNestedType (name, bindingFlags) =
// MSDN: http://msdn.microsoft.com/en-us/library/0dcb3ad5.aspx
// The following BindingFlags filter flags can be used to define which nested types to include in the search:
// You must specify either BindingFlags.Public or BindingFlags.NonPublic to get a return.
// Specify BindingFlags.Public to include public nested types in the search.
// Specify BindingFlags.NonPublic to include non-public nested types (that is, private, internal, and protected nested types) in the search.
// This method returns only the nested types of the current type. It does not search the base classes of the current type.
// To find types that are nested in base classes, you must walk the inheritance hierarchy, calling GetNestedType at each level.
let nestedTyOpt =
this.GetTypeInfo().DeclaredNestedTypes
|> Seq.tryFind (fun nestedTy ->
nestedTy.Name = name && (
(isPublicFlag bindingFlags && nestedTy.IsNestedPublic) ||
(isNonPublicFlag bindingFlags && (nestedTy.IsNestedPrivate || nestedTy.IsNestedFamily || nestedTy.IsNestedAssembly || nestedTy.IsNestedFamORAssem || nestedTy.IsNestedFamANDAssem))
)
)
|> Option.map (fun ti -> ti.AsType())
defaultArg nestedTyOpt null
// use different sources based on Declared flag
member this.GetMethods(bindingFlags) =
(if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredMethods else this.GetRuntimeMethods())
|> Seq.filter (fun m -> isAcceptable bindingFlags m.IsStatic m.IsPublic)
|> Seq.toArray
// use different sources based on Declared flag
member this.GetFields(bindingFlags) =
(if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredFields else this.GetRuntimeFields())
|> Seq.filter (fun f -> isAcceptable bindingFlags f.IsStatic f.IsPublic)
|> Seq.toArray
// use different sources based on Declared flag
member this.GetProperties(?bindingFlags) =
let bindingFlags = defaultArg bindingFlags publicFlags
(if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredProperties else this.GetRuntimeProperties())
|> Seq.filter (fun pi->
let mi = if pi.GetMethod <> null then pi.GetMethod else pi.SetMethod
assert (mi <> null)
isAcceptable bindingFlags mi.IsStatic mi.IsPublic
)
|> Seq.toArray
// use different sources based on Declared flag
member this.GetMethod(name, ?bindingFlags) =
let bindingFlags = defaultArg bindingFlags publicFlags
this.GetMethods(bindingFlags)
|> Array.filter(fun m -> m.Name = name)
|> commit
// use different sources based on Declared flag
member this.GetProperty(name, bindingFlags) =
this.GetProperties(bindingFlags)
|> Array.filter (fun pi -> pi.Name = name)
|> commit
member this.IsGenericTypeDefinition = this.GetTypeInfo().IsGenericTypeDefinition
member this.GetGenericArguments() =
if this.IsGenericTypeDefinition then this.GetTypeInfo().GenericTypeParameters
elif this.IsGenericType then this.GenericTypeArguments
else [||]
member this.BaseType = this.GetTypeInfo().BaseType
member this.GetConstructor(parameterTypes : Type[]) =
this.GetTypeInfo().DeclaredConstructors
|> Seq.filter (fun ci ->
not ci.IsStatic && //exclude type initializer
(
let parameters = ci.GetParameters()
(parameters.Length = parameterTypes.Length) &&
(parameterTypes, parameters) ||> Array.forall2 (fun ty pi -> pi.ParameterType.Equals ty)
)
)
|> Seq.toArray
|> commit
// MSDN: returns an array of Type objects representing all the interfaces implemented or inherited by the current Type.
member this.GetInterfaces() = this.GetTypeInfo().ImplementedInterfaces |> Seq.toArray
member this.GetConstructors(?bindingFlags) =
let bindingFlags = defaultArg bindingFlags publicFlags
// type initializer will also be included in resultset
this.GetTypeInfo().DeclaredConstructors
|> Seq.filter (fun ci -> isAcceptable bindingFlags ci.IsStatic ci.IsPublic)
|> Seq.toArray
member this.GetMethods() = this.GetMethods(publicFlags)
member this.Assembly = this.GetTypeInfo().Assembly
member this.IsSubclassOf(otherTy : Type) = this.GetTypeInfo().IsSubclassOf(otherTy)
member this.IsEnum = this.GetTypeInfo().IsEnum;
member this.GetField(name, bindingFlags) =
this.GetFields(bindingFlags)
|> Array.filter (fun fi -> fi.Name = name)
|> commit
member this.GetProperty(name, propertyType, parameterTypes : Type[]) =
this.GetProperties()
|> Array.filter (fun pi ->
pi.Name = name &&
pi.PropertyType = propertyType &&
(
let parameters = pi.GetIndexParameters()
(parameters.Length = parameterTypes.Length) &&
(parameterTypes, parameters) ||> Array.forall2 (fun ty pi -> pi.ParameterType.Equals ty)
)
)
|> commit
static member GetTypeCode(ty : Type) =
if typeof<System.Int32>.Equals ty then TypeCode.Int32
elif typeof<System.Int64>.Equals ty then TypeCode.Int64
elif typeof<System.Byte>.Equals ty then TypeCode.Byte
elif ty = typeof<System.SByte> then TypeCode.SByte
elif ty = typeof<System.Int16> then TypeCode.Int16
elif ty = typeof<System.UInt16> then TypeCode.UInt16
elif ty = typeof<System.UInt32> then TypeCode.UInt32
elif ty = typeof<System.UInt64> then TypeCode.UInt64
elif ty = typeof<System.Single> then TypeCode.Single
elif ty = typeof<System.Double> then TypeCode.Double
elif ty = typeof<System.Decimal> then TypeCode.Decimal
else TypeCode.Other
type System.Reflection.MemberInfo with
member this.GetCustomAttributes(attrTy, inherits) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this, attrTy, inherits) |> Seq.toArray)
type System.Reflection.MethodInfo with
member this.GetCustomAttributes(inherits : bool) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this, inherits) |> Seq.toArray)
type System.Reflection.PropertyInfo with
member this.GetGetMethod(nonPublic) =
let mi = this.GetMethod
if canUseAccessor mi nonPublic then mi
else null
member this.GetSetMethod(nonPublic) =
let mi = this.SetMethod
if canUseAccessor mi nonPublic then mi
else null
type System.Reflection.Assembly with
member this.GetTypes() =
this.DefinedTypes
|> Seq.map (fun ti -> ti.AsType())
|> Seq.toArray
type System.Delegate with
static member CreateDelegate(delegateType, methodInfo : MethodInfo) = methodInfo.CreateDelegate(delegateType)
static member CreateDelegate(delegateType, obj : obj, methodInfo : MethodInfo) = methodInfo.CreateDelegate(delegateType, obj)
#endif
namespace Microsoft.FSharp.Reflection
module internal ReflectionUtils = module internal ReflectionUtils =
...@@ -236,10 +43,8 @@ module internal Impl = ...@@ -236,10 +43,8 @@ module internal Impl =
let debug = false let debug = false
#if FX_RESHAPED_REFLECTION #if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters open PrimReflectionAdapters
open ReflectionAdapters open ReflectionAdapters
#endif #endif
let getBindingFlags allowAccess = ReflectionUtils.toBindingFlags (defaultArg allowAccess false) let getBindingFlags allowAccess = ReflectionUtils.toBindingFlags (defaultArg allowAccess false)
......
...@@ -515,84 +515,6 @@ module FSharpReflectionExtensions = ...@@ -515,84 +515,6 @@ module FSharpReflectionExtensions =
/// <returns>True if the type check is an F# exception.</returns> /// <returns>True if the type check is an F# exception.</returns>
static member IsExceptionRepresentation: exceptionType:Type * ?allowAccessToPrivateRepresentation : bool -> bool static member IsExceptionRepresentation: exceptionType:Type * ?allowAccessToPrivateRepresentation : bool -> bool
#if FX_RESHAPED_REFLECTION
namespace Microsoft.FSharp.Core
open System
open System.Reflection
module internal ReflectionAdapters =
[<System.Flags>]
type BindingFlags =
| DeclaredOnly = 2
| Instance = 4
| Static = 8
| Public = 16
| NonPublic = 32
val isDeclaredFlag : BindingFlags -> bool
val isPublicFlag : BindingFlags -> bool
val isStaticFlag : BindingFlags -> bool
val isInstanceFlag : BindingFlags -> bool
val isNonPublicFlag : BindingFlags -> bool
val isAcceptable : BindingFlags -> isStatic : bool -> isPublic : bool -> bool
[<System.Flags>]
type TypeCode =
| Int32 = 0
| Int64 = 1
| Byte = 2
| SByte = 3
| Int16 = 4
| UInt16 = 5
| UInt32 = 6
| UInt64 = 7
| Single = 8
| Double = 9
| Decimal = 10
| Other = 11
type System.Type with
member GetNestedType : name : string * bindingFlags : BindingFlags -> Type
member GetMethods : bindingFlags : BindingFlags -> MethodInfo[]
member GetFields : bindingFlags : BindingFlags -> FieldInfo[]
member GetProperties : ?bindingFlags : BindingFlags -> PropertyInfo[]
member GetMethod : name : string * ?bindingFlags : BindingFlags -> MethodInfo
member GetProperty : name : string * bindingFlags : BindingFlags -> PropertyInfo
member IsGenericTypeDefinition : bool
member GetGenericArguments : unit -> Type[]
member BaseType : Type
member GetConstructor : parameterTypes : Type[] -> ConstructorInfo
member GetInterfaces : unit -> Type[]
member GetConstructors : ?bindingFlags : BindingFlags -> ConstructorInfo[]
member GetMethods : unit -> MethodInfo[]
member Assembly : Assembly
member IsSubclassOf : Type -> bool
member IsEnum : bool
member GetField : string * BindingFlags -> FieldInfo
member GetProperty : string * Type * Type[] -> PropertyInfo
static member GetTypeCode : System.Type -> TypeCode
type System.Reflection.Assembly with
member GetTypes : unit -> Type[]
type System.Reflection.MemberInfo with
member GetCustomAttributes : attributeType : Type * inherits : bool -> obj[]
type System.Reflection.MethodInfo with
member GetCustomAttributes : inherits : bool -> obj[]
type System.Reflection.PropertyInfo with
member GetGetMethod : bool -> MethodInfo
member GetSetMethod : bool -> MethodInfo
type System.Delegate with
static member CreateDelegate : Type * MethodInfo -> System.Delegate
static member CreateDelegate : Type * obj * MethodInfo -> System.Delegate
#endif
namespace Microsoft.FSharp.Reflection namespace Microsoft.FSharp.Reflection
......
...@@ -18,9 +18,10 @@ ...@@ -18,9 +18,10 @@
<DefineConstants>EXTENSIBLE_DUMPER;$(DefineConstants)</DefineConstants> <DefineConstants>EXTENSIBLE_DUMPER;$(DefineConstants)</DefineConstants>
<DefineConstants>TYPE_PROVIDER_SECURITY;$(DefineConstants)</DefineConstants> <DefineConstants>TYPE_PROVIDER_SECURITY;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_COMPILER_BACKEND;$(DefineConstants)</DefineConstants> <DefineConstants>NO_COMPILER_BACKEND;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_PDB_READER;$(DefineConstants)</DefineConstants> <DefineConstants>FX_NO_PDB_READER;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_PDB_WRITER;$(DefineConstants)</DefineConstants> <DefineConstants>FX_NO_PDB_WRITER;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_INLINE_IL_PARSER;$(DefineConstants)</DefineConstants> <DefineConstants>NO_INLINE_IL_PARSER;$(DefineConstants)</DefineConstants>
<DefineConstants Condition=" '$(TargetFramework)'=='coreclr'">$(DefineConstants);PREFERRED_UI_LANG</DefineConstants>
<NoWarn>$(NoWarn);62;9;75</NoWarn> <NoWarn>$(NoWarn);62;9;75</NoWarn>
<ProjectGuid>{a437a6ec-5323-47c2-8f86-e2cac54ff152}</ProjectGuid> <ProjectGuid>{a437a6ec-5323-47c2-8f86-e2cac54ff152}</ProjectGuid>
<AllowCrossTargeting>true</AllowCrossTargeting> <AllowCrossTargeting>true</AllowCrossTargeting>
...@@ -33,6 +34,9 @@ ...@@ -33,6 +34,9 @@
<EmbeddedResource Include="..\FSStrings.resx"> <EmbeddedResource Include="..\FSStrings.resx">
<Link>FSStrings.resx</Link> <Link>FSStrings.resx</Link>
</EmbeddedResource> </EmbeddedResource>
<Compile Include="..\..\utils\reshaped_reflection.fs">
<Link>Reflection\reshaped_reflection.fs</Link>
</Compile>
<Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.dll.fs"> <Compile Include="..\..\assemblyinfo\assemblyinfo.FSharp.Compiler.dll.fs">
<Link>assemblyinfo.FSharp.Compiler.dll.fs</Link> <Link>assemblyinfo.FSharp.Compiler.dll.fs</Link>
</Compile> </Compile>
......
...@@ -17,9 +17,11 @@ ...@@ -17,9 +17,11 @@
<NoWarn>$(NoWarn);62</NoWarn> <NoWarn>$(NoWarn);62</NoWarn>
<AssemblyName>fsc</AssemblyName> <AssemblyName>fsc</AssemblyName>
<DefineConstants>EXTENSIONTYPING;COMPILER;$(DefineConstants)</DefineConstants> <DefineConstants>EXTENSIONTYPING;COMPILER;$(DefineConstants)</DefineConstants>
<DefineConstants Condition=" '$(TargetFramework)'=='coreclr'">$(DefineConstants);PREFERRED_UI_LANG</DefineConstants>
<AllowCrossTargeting>true</AllowCrossTargeting> <AllowCrossTargeting>true</AllowCrossTargeting>
<TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v2.0</TargetFrameworkVersion> <TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v2.0</TargetFrameworkVersion>
<OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags> <OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags>
<OtherFlags Condition=" '$(TargetFramework)'=='coreclr'">$(OtherFlags) --targetprofile:netcore</OtherFlags>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="InternalsVisibleTo.fs" /> <Compile Include="InternalsVisibleTo.fs" />
...@@ -33,12 +35,21 @@ ...@@ -33,12 +35,21 @@
<Link>fsc.exe.config</Link> <Link>fsc.exe.config</Link>
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory> <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</None> </None>
<None Include="..\..\windows\default.win32manifest">
<Link>default.win32manifest</Link>
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</None>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup Condition="'$(TargetFramework)' == 'coreclr'">
<None Include="project.json" />
</ItemGroup>
<ItemGroup Condition="'$(TargetFramework)' != 'coreclr'">
<Reference Include="mscorlib" /> <Reference Include="mscorlib" />
<Reference Include="System" /> <Reference Include="System" />
<Reference Include="System.Windows.Forms" /> <Reference Include="System.Windows.Forms" />
<Reference Include="System.Runtime.Remoting" /> <Reference Include="System.Runtime.Remoting" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\FSharp.Compiler\FSharp.Compiler.fsproj"> <ProjectReference Include="..\FSharp.Compiler\FSharp.Compiler.fsproj">
<Project>{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}</Project> <Project>{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}</Project>
<Name>FSharp.Compiler</Name> <Name>FSharp.Compiler</Name>
......
{
"dependencies": {
"System.Collections": "4.0.11-beta-*",
"System.Console": "4.0.0-beta-*",
"System.Diagnostics.Debug": "4.0.11-beta-*",
"System.IO": "4.0.11-beta-*",
"System.Linq.Expressions": "4.0.11-beta-*",
"System.Runtime": "4.0.21-beta-*",
"System.Reflection": "4.1.0-beta-*"
}
}
此差异已折叠。
...@@ -4,7 +4,6 @@ ...@@ -4,7 +4,6 @@
// Some general F# utilities for mangling / unmangling / manipulating names. // Some general F# utilities for mangling / unmangling / manipulating names.
//-------------------------------------------------------------------------- //--------------------------------------------------------------------------
/// Anything to do with special names of identifiers and other lexical rules /// Anything to do with special names of identifiers and other lexical rules
module internal Microsoft.FSharp.Compiler.PrettyNaming module internal Microsoft.FSharp.Compiler.PrettyNaming
open Internal.Utilities open Internal.Utilities
...@@ -17,6 +16,10 @@ module internal Microsoft.FSharp.Compiler.PrettyNaming ...@@ -17,6 +16,10 @@ module internal Microsoft.FSharp.Compiler.PrettyNaming
open System.Globalization open System.Globalization
open System.Collections.Generic open System.Collections.Generic
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
//------------------------------------------------------------------------ //------------------------------------------------------------------------
// Operator name compilation // Operator name compilation
//----------------------------------------------------------------------- //-----------------------------------------------------------------------
......
...@@ -14,6 +14,14 @@ namespace Microsoft.FSharp.Compiler ...@@ -14,6 +14,14 @@ namespace Microsoft.FSharp.Compiler
module internal MSBuildResolver = module internal MSBuildResolver =
#if FX_RESHAPED_REFLECTION
open Microsoft.FSharp.Core.ReflectionAdapters
#endif
#if RESHAPED_MSBUILD
open Microsoft.FSharp.Compiler.MsBuildAdapters
open Microsoft.FSharp.Compiler.ToolLocationHelper
#endif
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
exception ResolutionFailure exception ResolutionFailure
...@@ -25,10 +33,12 @@ module internal MSBuildResolver = ...@@ -25,10 +33,12 @@ module internal MSBuildResolver =
| GlobalAssemblyCache | GlobalAssemblyCache
| Path of string | Path of string
| Unknown | Unknown
type ResolutionEnvironment = CompileTimeLike | RuntimeLike | DesigntimeLike
#if FX_MSBUILDRESOLVER_RUNTIMELIKE
type ResolutionEnvironment = CompileTimeLike | RuntimeLike | DesigntimeLike
#else
type ResolutionEnvironment = CompileTimeLike | DesigntimeLike
#endif
open System open System
open Microsoft.Build.Tasks open Microsoft.Build.Tasks
open Microsoft.Build.Utilities open Microsoft.Build.Utilities
...@@ -134,7 +144,7 @@ module internal MSBuildResolver = ...@@ -134,7 +144,7 @@ module internal MSBuildResolver =
match ToolLocationHelper.GetPathToDotNetFrameworkReferenceAssemblies v with match ToolLocationHelper.GetPathToDotNetFrameworkReferenceAssemblies v with
| null -> [] | null -> []
| x -> [x] | x -> [x]
| None -> [] | None -> []
#else #else
// FX_ATLEAST_45 is not defined for step when we build compiler with proto compiler. // FX_ATLEAST_45 is not defined for step when we build compiler with proto compiler.
ignore version ignore version
...@@ -249,15 +259,21 @@ module internal MSBuildResolver = ...@@ -249,15 +259,21 @@ module internal MSBuildResolver =
logerror code message logerror code message
with e -> with e ->
backgroundException := Some(e) backgroundException := Some(e)
foregrounded := ForegroundedError(code,message) :: !foregrounded foregrounded := ForegroundedError(code,message) :: !foregrounded
let engine = { new IBuildEngine with let engine = { new IBuildEngine with
member be.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true member be.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true
#if RESHAPED_MSBUILD
member be.LogCustomEvent(e) = logmessage ((e.GetPropertyValue("Message")) :?> string)
member be.LogErrorEvent(e) = logerror ((e.GetPropertyValue("Code")) :?> string) ((e.GetPropertyValue("Message")) :?> string)
member be.LogMessageEvent(e) = logmessage ((e.GetPropertyValue("Message")) :?> string)
member be.LogWarningEvent(e) = logwarning ((e.GetPropertyValue("Code")) :?> string) ((e.GetPropertyValue("Message")) :?> string)
#else
member be.LogCustomEvent(e) = logmessage e.Message member be.LogCustomEvent(e) = logmessage e.Message
member be.LogErrorEvent(e) = logerror e.Code e.Message member be.LogErrorEvent(e) = logerror e.Code e.Message
member be.LogMessageEvent(e) = logmessage e.Message member be.LogMessageEvent(e) = logmessage e.Message
member be.LogWarningEvent(e) = logwarning e.Code e.Message member be.LogWarningEvent(e) = logwarning e.Code e.Message
#endif
member be.ColumnNumberOfTaskNode with get() = 1 member be.ColumnNumberOfTaskNode with get() = 1
member be.LineNumberOfTaskNode with get() = 1 member be.LineNumberOfTaskNode with get() = 1
member be.ContinueOnError with get() = true member be.ContinueOnError with get() = true
...@@ -283,20 +299,23 @@ module internal MSBuildResolver = ...@@ -283,20 +299,23 @@ module internal MSBuildResolver =
rar.FindSerializationAssemblies <- false rar.FindSerializationAssemblies <- false
#if BUILDING_WITH_LKG #if BUILDING_WITH_LKG
ignore targetProcessorArchitecture ignore targetProcessorArchitecture
#else #else
#if I_DONT_KNOW_HOW_TO_DO_THIS_YET
rar.TargetedRuntimeVersion <- typeof<obj>.Assembly.ImageRuntimeVersion rar.TargetedRuntimeVersion <- typeof<obj>.Assembly.ImageRuntimeVersion
#endif
rar.TargetProcessorArchitecture <- targetProcessorArchitecture rar.TargetProcessorArchitecture <- targetProcessorArchitecture
rar.CopyLocalDependenciesWhenParentReferenceInGac <- true rar.CopyLocalDependenciesWhenParentReferenceInGac <- true
#endif #endif
rar.Assemblies <- [|for (referenceName,baggage) in references -> rar.Assemblies <- [|for (referenceName,baggage) in references ->
let item = new Microsoft.Build.Utilities.TaskItem(referenceName) let item = new Microsoft.Build.Utilities.TaskItem(referenceName) :> ITaskItem
item.SetMetadata("Baggage", baggage) item.SetMetadata("Baggage", baggage)
item:>ITaskItem|] item|]
let rawFileNamePath = if allowRawFileName then ["{RawFileName}"] else [] let rawFileNamePath = if allowRawFileName then ["{RawFileName}"] else []
let searchPaths = let searchPaths =
match resolutionEnvironment with match resolutionEnvironment with
| DesigntimeLike | DesigntimeLike
#if FX_MSBUILDRESOLVER_RUNTIMELIKE
| RuntimeLike -> | RuntimeLike ->
logmessage("Using scripting resolution precedence.") logmessage("Using scripting resolution precedence.")
// These are search paths for runtime-like or scripting resolution. GAC searching is present. // These are search paths for runtime-like or scripting resolution. GAC searching is present.
...@@ -308,6 +327,7 @@ module internal MSBuildResolver = ...@@ -308,6 +327,7 @@ module internal MSBuildResolver =
[sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @ [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @
["{AssemblyFolders}"] @ ["{AssemblyFolders}"] @
["{GAC}"] ["{GAC}"]
#endif
| CompileTimeLike -> | CompileTimeLike ->
logmessage("Using compilation resolution precedence.") logmessage("Using compilation resolution precedence.")
// These are search paths for compile-like resolution. GAC searching is not present. // These are search paths for compile-like resolution. GAC searching is not present.
...@@ -321,13 +341,13 @@ module internal MSBuildResolver = ...@@ -321,13 +341,13 @@ module internal MSBuildResolver =
[outputDirectory] @ [outputDirectory] @
["{GAC}"] @ ["{GAC}"] @
GetPathToDotNetFramework targetFrameworkVersion // use path to implementation assemblies as the last resort GetPathToDotNetFramework targetFrameworkVersion // use path to implementation assemblies as the last resort
rar.SearchPaths <- searchPaths |> Array.ofList rar.SearchPaths <- searchPaths |> Array.ofList
rar.AllowedAssemblyExtensions <- [| ".dll" ; ".exe" |] rar.AllowedAssemblyExtensions <- [| ".dll" ; ".exe" |]
let succeeded = rar.Execute() let succeeded = rar.Execute()
// Unroll any foregrounded messages // Unroll any foregrounded messages
match !backgroundException with match !backgroundException with
| Some(backGroundException) -> | Some(backGroundException) ->
......
...@@ -6,12 +6,12 @@ open System.Collections.Generic ...@@ -6,12 +6,12 @@ open System.Collections.Generic
open Internal.Utilities open Internal.Utilities
open Internal.Utilities.Text.Lexing open Internal.Utilities.Text.Lexing
open Internal.Utilities.Text.Parsing open Internal.Utilities.Text.Parsing
open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.UnicodeLexing open Microsoft.FSharp.Compiler.UnicodeLexing
open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.ErrorLogger
open Microsoft.FSharp.Compiler.PrettyNaming open Microsoft.FSharp.Compiler.PrettyNaming
open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
...@@ -77,7 +77,6 @@ type XmlDocCollector() = ...@@ -77,7 +77,6 @@ type XmlDocCollector() =
//printfn "#lines = %d, firstLineIndexAfterPrevGrabPoint = %d, firstLineIndexAfterGrabPoint = %d" lines.Length firstLineIndexAfterPrevGrabPoint firstLineIndexAfterGrabPoint //printfn "#lines = %d, firstLineIndexAfterPrevGrabPoint = %d, firstLineIndexAfterGrabPoint = %d" lines.Length firstLineIndexAfterPrevGrabPoint firstLineIndexAfterGrabPoint
lines.[firstLineIndexAfterPrevGrabPoint..firstLineIndexAfterGrabPoint-1] |> Array.map fst lines.[firstLineIndexAfterPrevGrabPoint..firstLineIndexAfterGrabPoint-1] |> Array.map fst
type XmlDoc = type XmlDoc =
| XmlDoc of string[] | XmlDoc of string[]
static member Empty = XmlDocStatics.Empty static member Empty = XmlDocStatics.Empty
...@@ -92,7 +91,7 @@ type XmlDoc = ...@@ -92,7 +91,7 @@ type XmlDoc =
if lineAT = "" then processLines rest if lineAT = "" then processLines rest
else if String.hasPrefix lineAT "<" then lines else if String.hasPrefix lineAT "<" then lines
else ["<summary>"] @ else ["<summary>"] @
(lines |> List.map (fun line -> System.Security.SecurityElement.Escape(line))) @ (lines |> List.map (fun line -> Microsoft.FSharp.Core.XmlAdapters.escape(line))) @
["</summary>"] ["</summary>"]
let lines = processLines (Array.toList lines) let lines = processLines (Array.toList lines)
......
此差异已折叠。
...@@ -295,7 +295,7 @@ type TcConfigBuilder = ...@@ -295,7 +295,7 @@ type TcConfigBuilder =
mutable maxErrors : int mutable maxErrors : int
mutable abortOnError : bool mutable abortOnError : bool
mutable baseAddress : int32 option mutable baseAddress : int32 option
#if DEBUG #if DEBUG
mutable writeGeneratedILFiles : bool (* write il files? *) mutable writeGeneratedILFiles : bool (* write il files? *)
mutable showOptimizationData : bool mutable showOptimizationData : bool
#endif #endif
...@@ -307,7 +307,11 @@ type TcConfigBuilder = ...@@ -307,7 +307,11 @@ type TcConfigBuilder =
mutable optsOn : bool mutable optsOn : bool
mutable optSettings : Opt.OptimizationSettings mutable optSettings : Opt.OptimizationSettings
mutable emitTailcalls : bool mutable emitTailcalls : bool
#if PREFERRED_UI_LANG
mutable preferredUiLang: string option
#else
mutable lcid : int option mutable lcid : int option
#endif
mutable productNameForBannerText : string mutable productNameForBannerText : string
mutable showBanner : bool mutable showBanner : bool
mutable showTimes : bool mutable showTimes : bool
...@@ -328,8 +332,10 @@ type TcConfigBuilder = ...@@ -328,8 +332,10 @@ type TcConfigBuilder =
mutable sqmNumOfSourceFiles : int mutable sqmNumOfSourceFiles : int
sqmSessionStartedTime : int64 sqmSessionStartedTime : int64
mutable emitDebugInfoInQuotations : bool mutable emitDebugInfoInQuotations : bool
mutable shadowCopyReferences : bool } #if SHADOW_COPY_REFERENCES
mutable shadowCopyReferences : bool
#endif
}
static member CreateNew : static member CreateNew :
defaultFSharpBinariesDir: string * defaultFSharpBinariesDir: string *
...@@ -451,7 +457,11 @@ type TcConfig = ...@@ -451,7 +457,11 @@ type TcConfig =
member doFinalSimplify : bool member doFinalSimplify : bool
member optSettings : Opt.OptimizationSettings member optSettings : Opt.OptimizationSettings
member emitTailcalls : bool member emitTailcalls : bool
member lcid : int option #if PREFERRED_UI_LANG
member preferredUiLang: string option
#else
member lcid : int option
#endif
member optsOn : bool member optsOn : bool
member productNameForBannerText : string member productNameForBannerText : string
member showBanner : bool member showBanner : bool
...@@ -487,8 +497,9 @@ type TcConfig = ...@@ -487,8 +497,9 @@ type TcConfig =
member sqmSessionGuid : System.Guid option member sqmSessionGuid : System.Guid option
member sqmNumOfSourceFiles : int member sqmNumOfSourceFiles : int
member sqmSessionStartedTime : int64 member sqmSessionStartedTime : int64
#if SHADOW_COPY_REFERENCES
member shadowCopyReferences : bool member shadowCopyReferences : bool
#endif
static member Create : TcConfigBuilder * validate: bool -> TcConfig static member Create : TcConfigBuilder * validate: bool -> TcConfig
...@@ -566,7 +577,11 @@ type TcImports = ...@@ -566,7 +577,11 @@ type TcImports =
member SystemRuntimeContainsType : string -> bool member SystemRuntimeContainsType : string -> bool
static member BuildFrameworkTcImports : TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> TcGlobals * TcImports static member BuildFrameworkTcImports : TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> TcGlobals * TcImports
#if TYPE_PROVIDER_SECURITY
static member BuildNonFrameworkTcImports : (string->unit) option * TcConfigProvider * TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list -> TcImports static member BuildNonFrameworkTcImports : (string->unit) option * TcConfigProvider * TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list -> TcImports
#else
static member BuildNonFrameworkTcImports : TcConfigProvider * TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list -> TcImports
#endif
static member BuildTcImports : TcConfigProvider -> TcGlobals * TcImports static member BuildTcImports : TcConfigProvider -> TcGlobals * TcImports
//---------------------------------------------------------------------------- //----------------------------------------------------------------------------
......
此差异已折叠。
...@@ -71,12 +71,13 @@ module internal ExtensionTyping = ...@@ -71,12 +71,13 @@ module internal ExtensionTyping =
/// Find and instantiate the set of ITypeProvider components for the given assembly reference /// Find and instantiate the set of ITypeProvider components for the given assembly reference
val GetTypeProvidersOfAssembly : val GetTypeProvidersOfAssembly :
#if TYPE_PROVIDER_SECURITY
displayPSTypeProviderSecurityDialogBlockingUI : (string->unit) option displayPSTypeProviderSecurityDialogBlockingUI : (string->unit) option
* validateTypeProviders: bool * validateTypeProviders: bool
#if TYPE_PROVIDER_SECURITY
* ApprovalIO.TypeProviderApprovalStatus list * ApprovalIO.TypeProviderApprovalStatus list
*
#endif #endif
* runtimeAssemblyFilename: string runtimeAssemblyFilename: string
* ilScopeRefOfRuntimeAssembly:ILScopeRef * ilScopeRefOfRuntimeAssembly:ILScopeRef
* designerAssemblyName: string * designerAssemblyName: string
* ResolutionEnvironment * ResolutionEnvironment
...@@ -217,7 +218,10 @@ module internal ExtensionTyping = ...@@ -217,7 +218,10 @@ module internal ExtensionTyping =
ProvidedMethodInfo = ProvidedMethodInfo =
inherit ProvidedMethodBase inherit ProvidedMethodBase
member ReturnType : ProvidedType member ReturnType : ProvidedType
#if FX_NO_REFLECTION_METADATA_TOKENS
#else
member MetadataToken : int member MetadataToken : int
#endif
and [<AllowNullLiteral; Sealed; Class>] and [<AllowNullLiteral; Sealed; Class>]
ProvidedParameterInfo = ProvidedParameterInfo =
......
此差异已折叠。
此差异已折叠。
此差异已折叠。
...@@ -18,6 +18,7 @@ ...@@ -18,6 +18,7 @@
<AssemblyName>fsi</AssemblyName> <AssemblyName>fsi</AssemblyName>
<BaseAddress>0x0A000000</BaseAddress> <BaseAddress>0x0A000000</BaseAddress>
<DefineConstants>EXTENSIONTYPING;COMPILER;$(DefineConstants)</DefineConstants> <DefineConstants>EXTENSIONTYPING;COMPILER;$(DefineConstants)</DefineConstants>
<DefineConstants Condition=" '$(TargetFramework)'=='coreclr'">$(DefineConstants);PREFERRED_UI_LANG</DefineConstants>
<TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v3.5</TargetFrameworkVersion> <TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v3.5</TargetFrameworkVersion>
<AllowCrossTargeting>true</AllowCrossTargeting> <AllowCrossTargeting>true</AllowCrossTargeting>
<OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags> <OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags>
......
此差异已折叠。
...@@ -14,6 +14,7 @@ ...@@ -14,6 +14,7 @@
<AssemblyName>FsiAnyCPU</AssemblyName> <AssemblyName>FsiAnyCPU</AssemblyName>
<BaseAddress>0x0A000000</BaseAddress> <BaseAddress>0x0A000000</BaseAddress>
<DefineConstants>EXTENSIONTYPING;COMPILER;$(DefineConstants)</DefineConstants> <DefineConstants>EXTENSIONTYPING;COMPILER;$(DefineConstants)</DefineConstants>
<DefineConstants Condition=" '$(TargetFramework)'=='coreclr'">$(DefineConstants);PREFERRED_UI_LANG</DefineConstants>
<TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v3.5</TargetFrameworkVersion> <TargetFrameworkVersion Condition="'$(TargetFramework)'=='net20'">v3.5</TargetFrameworkVersion>
<AllowCrossTargeting>true</AllowCrossTargeting> <AllowCrossTargeting>true</AllowCrossTargeting>
<OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags> <OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags>
......
# FS Server.Shared resource strings
\ No newline at end of file
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
此差异已折叠。
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册