diff --git a/src/FSharpSource.Profiles.targets b/src/FSharpSource.Profiles.targets index adafba0eae..422e72420a 100644 --- a/src/FSharpSource.Profiles.targets +++ b/src/FSharpSource.Profiles.targets @@ -10,6 +10,9 @@ $(DefineConstants);FX_LCIDFROMCODEPAGE + + + $(DefineConstants);FX_PORTABLE_OR_NETSTANDARD $(DefineConstants);NETSTANDARD1_6 diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index adb43bcef7..5144b34a06 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -4274,14 +4274,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Find assembly level TypeProviderAssemblyAttributes. These will point to the assemblies that // have class which implement ITypeProvider and which have TypeProviderAttribute on them. - let providerAssemblies = + let designTimeAssemblyNames = runtimeAssemblyAttributes |> List.choose (TryDecodeTypeProviderAssemblyAttr (defaultArg ilGlobalsOpt EcmaMscorlibILGlobals)) // If no design-time assembly is specified, use the runtime assembly - |> List.map (function null -> Path.GetFileNameWithoutExtension fileNameOfRuntimeAssembly | s -> s) - |> Set.ofList + |> List.map (function null -> fileNameOfRuntimeAssembly | s -> s) + // For each simple name of a design-time assembly, we take the first matching one in the order they are + // specified in the attributes + |> List.distinctBy (fun s -> try Path.GetFileNameWithoutExtension(s) with _ -> s) - if providerAssemblies.Count > 0 then + if designTimeAssemblyNames.Length > 0 then // Find the SystemRuntimeAssemblyVersion value to report in the TypeProviderConfig. let primaryAssemblyVersion = @@ -4309,10 +4311,9 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti fun arg -> systemRuntimeContainsTypeRef.Value arg let providers = - [ for assemblyName in providerAssemblies do - yield ExtensionTyping.GetTypeProvidersOfAssembly(fileNameOfRuntimeAssembly, ilScopeRefOfRuntimeAssembly, assemblyName, typeProviderEnvironment, - tcConfig.isInvalidationSupported, tcConfig.isInteractive, systemRuntimeContainsType, primaryAssemblyVersion, m) ] - let providers = providers |> List.concat + [ for designTimeAssemblyName in designTimeAssemblyNames do + yield! ExtensionTyping.GetTypeProvidersOfAssembly(fileNameOfRuntimeAssembly, ilScopeRefOfRuntimeAssembly, designTimeAssemblyName, typeProviderEnvironment, + tcConfig.isInvalidationSupported, tcConfig.isInteractive, systemRuntimeContainsType, primaryAssemblyVersion, m) ] // Note, type providers are disposable objects. The TcImports owns the provider objects - when/if it is disposed, the providers are disposed. // We ignore all exceptions from provider disposal. diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index dade9c9650..d348e13c58 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -36,6 +36,37 @@ module internal ExtensionTyping = temporaryFolder : string } + // Specify the tooling-compatible fragments of a path such as: + // typeproviders/fsharp41/net461/MyProvider.DesignTime.dll + // See https://github.com/Microsoft/visualfsharp/issues/3736 + + // Represents the FF#-compiler <-> type provider protocol. + // When the API or protocol updates, add a new version moniker to the front of the list here. + let toolingCompatibleTypeProviderProtocolMonikers() = + [ "fsharp41" ] + + // Detect the host tooling context + let toolingCompatibleVersions() = + if typeof.Assembly.GetName().Name = "mscorlib" then + [ "net461"; "net452"; "net451"; "net45"; "netstandard2.0"] + elif typeof.Assembly.GetName().Name = "System.Private.CoreLib" then + [ "netcoreapp2.0"; "netstandard2.0"] + else + System.Diagnostics.Debug.Assert(false, "Couldn't determine runtime tooling context, assuming it supports at least .NET Standard 2.0") + [ "netstandard2.0"] + + // When significant new processor types appear add a new moniker here. Note that use of this qualifier will be very rare + // and we don't expect different design-time assemblies will be needed for different architectures very often. Some + // exceptions may be design-time components for type providers for systems such as Python or R. + let toolingCompatibleArch() = if sizeof = 8 then "x64" else "x86" + let toolingCompatiblePaths() = + [ for protocol in toolingCompatibleTypeProviderProtocolMonikers() do + for netRuntime in toolingCompatibleVersions() do + let dir = Path.Combine("typeproviders", protocol, netRuntime) + yield Path.Combine(dir, toolingCompatibleArch()) + yield dir + ] + /// Load a the design-time part of a type-provider into the host process, and look for types /// marked with the TypeProviderAttribute attribute. let GetTypeProviderImplementationTypes (runTimeAssemblyFileName, designTimeAssemblyNameString, m:range) = @@ -46,32 +77,58 @@ module internal ExtensionTyping = // Find and load the designer assembly for the type provider component. // - // If the assembly name ends with .dll, or is just a simple name, we look in the directory next to runtime assembly. - // Else we only look in the GAC. - let designTimeAssemblyOpt = - let loadFromDir fileName = + // We look in the directories stepping up from the location of the runtime assembly. + + let loadFromLocation designTimeAssemblyPath = + try + Some (FileSystem.AssemblyLoadFrom designTimeAssemblyPath) + with e -> + raiseError e + + let rec searchParentDirChain dir designTimeAssemblyName = + seq { + for subdir in toolingCompatiblePaths() do + let designTimeAssemblyPath = Path.Combine (dir, subdir, designTimeAssemblyName) + if FileSystem.SafeExists designTimeAssemblyPath then + yield loadFromLocation designTimeAssemblyPath + match Path.GetDirectoryName(dir) with + | s when s = "" || s = null || Path.GetFileName(dir) = "packages" || s = dir -> () + | parentDir -> yield! searchParentDirChain parentDir designTimeAssemblyName + } + + let loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeAssemblyName = + let runTimeAssemblyPath = Path.GetDirectoryName runTimeAssemblyFileName + searchParentDirChain runTimeAssemblyPath designTimeAssemblyName + |> Seq.tryHead + |> function + | Some res -> res + | None -> + // The search failed, just load from the first location and report an error let runTimeAssemblyPath = Path.GetDirectoryName runTimeAssemblyFileName - let designTimeAssemblyPath = Path.Combine (runTimeAssemblyPath, fileName) - try - Some (FileSystem.AssemblyLoadFrom designTimeAssemblyPath) - with e -> - raiseError e - let loadFromGac() = - try - let asmName = System.Reflection.AssemblyName designTimeAssemblyNameString - Some (FileSystem.AssemblyLoad (asmName)) - with e -> - raiseError e + loadFromLocation (Path.Combine (runTimeAssemblyPath, designTimeAssemblyName)) + + let designTimeAssemblyOpt = if designTimeAssemblyNameString.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then - loadFromDir designTimeAssemblyNameString + loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeAssemblyNameString else - let name = System.Reflection.AssemblyName designTimeAssemblyNameString + // Cover the case where the ".dll" extension has been left off and no version etc. has been used in the assembly + // string specification. The Name=FullName comparison is particularly strange, and was there to support + // design-time DLLs specified using "x.DesignTIme, Version= ..." long assembly names and GAC loads. + // These kind of design-time assembly specifications are no longer used to our knowledge so that comparison is basically legacy + // and will always succeed. + let name = System.Reflection.AssemblyName (Path.GetFileNameWithoutExtension designTimeAssemblyNameString) if name.Name.Equals(name.FullName, StringComparison.OrdinalIgnoreCase) then - let fileName = designTimeAssemblyNameString+".dll" - loadFromDir fileName + let designTimeAssemblyName = designTimeAssemblyNameString+".dll" + loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeAssemblyName else - loadFromGac() + // Load from the GAC using Assembly.Load. This is legacy since type provider design-time components are + // never in the GAC these days and "x.DesignTIme, Version= ..." specifications are never used. + try + let asmName = System.Reflection.AssemblyName designTimeAssemblyNameString + Some (FileSystem.AssemblyLoad (asmName)) + with e -> + raiseError e // If we've find a design-time assembly, look for the public types with TypeProviderAttribute match designTimeAssemblyOpt with @@ -152,12 +209,17 @@ module internal ExtensionTyping = try let designTimeAssemblyName = try - Some (System.Reflection.AssemblyName designTimeAssemblyNameString) + if designTimeAssemblyNameString.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then + Some (System.Reflection.AssemblyName (Path.GetFileNameWithoutExtension designTimeAssemblyNameString)) + else + Some (System.Reflection.AssemblyName designTimeAssemblyNameString) with :? ArgumentException -> errorR(Error(FSComp.SR.etInvalidTypeProviderAssemblyName(runTimeAssemblyFileName, designTimeAssemblyNameString), m)) None [ match designTimeAssemblyName, resolutionEnvironment.outputFile with + // Check if the attribute is pointing to the file being compiled, in which case ignore it + // This checks seems like legacy but is included for compat. | Some designTimeAssemblyName, Some path when String.Compare(designTimeAssemblyName.Name, Path.GetFileNameWithoutExtension path, StringComparison.OrdinalIgnoreCase) = 0 -> () | Some _, _ -> diff --git a/src/fsharp/ExtensionTyping.fsi b/src/fsharp/ExtensionTyping.fsi index f796881c35..a16788e2bb 100755 --- a/src/fsharp/ExtensionTyping.fsi +++ b/src/fsharp/ExtensionTyping.fsi @@ -24,6 +24,9 @@ module internal ExtensionTyping = /// Raised when an type provider has thrown an exception. exception ProvidedTypeResolutionNoRange of exn + /// Get the list of relative paths searched for type provider design-time components + val toolingCompatiblePaths: unit -> string list + /// Carries information about the type provider resolution environment. type ResolutionEnvironment = { diff --git a/src/fsharp/FSharp.Compiler.Unittests/ProductVersion.fs b/src/fsharp/FSharp.Compiler.Unittests/ProductVersion.fs index 74c4da0c2f..977ac63ada 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/ProductVersion.fs +++ b/src/fsharp/FSharp.Compiler.Unittests/ProductVersion.fs @@ -82,11 +82,11 @@ module ProductVersionTest = "0.0.0.0", (0us,0us,0us,0us) "3213.57843.32382.59493", (3213us,57843us,32382us,59493us) (sprintf "%d.%d.%d.%d" max max max max), (max,max,max,max) ] - |> List.map (fun (s,e) -> TestCaseData(s, e)) - [] - let ``should use values if valid major.minor.revision.build version format`` (v, expected) = - v |> productVersionToILVersionInfo |> Assert.areEqual expected + [] + let ``should use values if valid major.minor.revision.build version format`` () = + for (v, expected) in validValues() do + v |> productVersionToILVersionInfo |> Assert.areEqual expected let invalidValues () = [ "1.2.3.4", (1us,2us,3us,4us) @@ -100,8 +100,29 @@ module ProductVersionTest = "", (0us,0us,0us,0us) "70000.80000.90000.100000", (0us,0us,0us,0us) (sprintf "%d.70000.80000.90000" System.UInt16.MaxValue), (System.UInt16.MaxValue,0us,0us,0us) ] - |> List.map (fun (s,e) -> TestCaseData(s, e)) - [] - let ``should zero starting from first invalid version part`` (v, expected) = - v |> productVersionToILVersionInfo |> Assert.areEqual expected + [] + let ``should zero starting from first invalid version part`` () = + for (v, expected) in invalidValues() do + v |> productVersionToILVersionInfo |> Assert.areEqual expected + +module TypeProviderDesignTimeComponentLoading = + + + [] + let ``check tooling paths for type provider design time component loading`` () = + let arch = if sizeof = 8 then "x64" else "x86" + let expected = + [ @"typeproviders\fsharp41\net461\" + arch + @"typeproviders\fsharp41\net461" + @"typeproviders\fsharp41\net452\" + arch + @"typeproviders\fsharp41\net452" + @"typeproviders\fsharp41\net451\" + arch + @"typeproviders\fsharp41\net451" + @"typeproviders\fsharp41\net45\" + arch + @"typeproviders\fsharp41\net45" + @"typeproviders\fsharp41\netstandard2.0\" + arch + @"typeproviders\fsharp41\netstandard2.0" + ] + let actual = Microsoft.FSharp.Compiler.ExtensionTyping.toolingCompatiblePaths() + Assert.areEqual expected actual diff --git a/tests/fsharp/TypeProviderTests.fs b/tests/fsharp/TypeProviderTests.fs index 3a0f0443b2..edfd0ec742 100644 --- a/tests/fsharp/TypeProviderTests.fs +++ b/tests/fsharp/TypeProviderTests.fs @@ -23,9 +23,11 @@ open SingleTest // Use these lines if you want to test CoreCLR let FSC_BASIC = FSC_CORECLR let FSI_BASIC = FSI_CORECLR +let FSIANYCPU_BASIC = FSI_CORECLR #else let FSC_BASIC = FSC_OPT_PLUS_DEBUG let FSI_BASIC = FSI_FILE +let FSIANYCPU_BASIC = FSIANYCPU_FILE #endif [] @@ -248,14 +250,93 @@ let ``negative type provider tests`` (name:string) = [] let splitAssembly () = + let cfg = testConfig "typeProviders/splitAssembly" + let clean() = + rm cfg "providerDesigner.dll" + rmdir cfg "typeproviders" + rmdir cfg (".." ++ "typeproviders") + + clean() + fsc cfg "--out:provider.dll -a" ["provider.fs"] fsc cfg "--out:providerDesigner.dll -a" ["providerDesigner.fsx"] SingleTest.singleTestBuildAndRunAux cfg FSC_BASIC - + + SingleTest.singleTestBuildAndRunAux cfg FSI_BASIC + + SingleTest.singleTestBuildAndRunAux cfg FSIANYCPU_BASIC + + // Do the same thing with different load locations for the type provider design-time component + + clean() + + // check a few load locations + let someLoadPaths = + [ "typeproviders" ++ "fsharp41" ++ "net461" ++ "x86" + "typeproviders" ++ "fsharp41" ++ "net461" + "typeproviders" ++ "fsharp41" ++ "net45" + // include up one directory + ".." ++ "typeproviders" ++ "fsharp41" ++ "net45" + "typeproviders" ++ "fsharp41" ++ "netstandard2.0" ] + + let someLoadPaths64 = + [ "typeproviders" ++ "fsharp41" ++ "net461" ++ "x64" + "typeproviders" ++ "fsharp41" ++ "net461" ] + + let someNegativeLoadPaths64 = + [ "typeproviders" ++ "fsharp41" ++ "net461" ++ "x86" ] + + + for dir in someLoadPaths do + + clean() + + // put providerDesigner.dll into a different place + mkdir cfg dir + fsc cfg "--out:%s/providerDesigner.dll -a" dir ["providerDesigner.fsx"] + + SingleTest.singleTestBuildAndRunAux cfg FSC_BASIC + + for dir in someLoadPaths do + + clean() + + // put providerDesigner.dll into a different place + mkdir cfg dir + fsc cfg "--out:%s/providerDesigner.dll -a" dir ["providerDesigner.fsx"] + + SingleTest.singleTestBuildAndRunAux cfg FSI_BASIC + + for dir in someLoadPaths64 do + + clean() + + // put providerDesigner.dll into a different place + mkdir cfg dir + fsc cfg "--out:%s/providerDesigner.dll -a" dir ["providerDesigner.fsx"] + + SingleTest.singleTestBuildAndRunAux cfg FSIANYCPU_BASIC + + for dir in someNegativeLoadPaths64 do + + clean() + + // put providerDesigner.dll into a different place + mkdir cfg dir + fsc cfg "--out:%s/providerDesigner.dll -a" dir ["providerDesigner.fsx"] + + // We expect a failure here - an error correctly gets printed on the console + try + SingleTest.singleTestBuildAndRunAux cfg FSIANYCPU_BASIC |> ignore + failwith "expected an AssertionException" + with :? NUnit.Framework.AssertionException -> () + + clean() + [] let wedgeAssembly () = let cfg = testConfig "typeProviders/wedgeAssembly" diff --git a/tests/fsharp/single-test.fs b/tests/fsharp/single-test.fs index 38bce9a806..e8c050cb8c 100644 --- a/tests/fsharp/single-test.fs +++ b/tests/fsharp/single-test.fs @@ -12,6 +12,7 @@ type Permutation = | FSI_CORECLR #if !FSHARP_SUITE_DRIVES_CORECLR_TESTS | FSI_FILE + | FSIANYCPU_FILE | FSI_STDIN | GENERATED_SIGNATURE | FSC_OPT_MINUS_DEBUG @@ -94,6 +95,14 @@ let singleTestBuildAndRunCore cfg (copyFiles:string) p = testOkFile.CheckExists() + | FSIANYCPU_FILE -> + use cleanup = (cleanUpFSharpCore cfg) + use testOkFile = new FileGuard (getfullpath cfg "test.ok") + + fsiAnyCpu cfg "%s" cfg.fsi_flags sources + + testOkFile.CheckExists() + | FSI_STDIN -> use cleanup = (cleanUpFSharpCore cfg) use testOkFile = new FileGuard (getfullpath cfg "test.ok") diff --git a/tests/fsharp/test-framework.fs b/tests/fsharp/test-framework.fs index 6b9a795ca6..5c320318c1 100644 --- a/tests/fsharp/test-framework.fs +++ b/tests/fsharp/test-framework.fs @@ -40,6 +40,14 @@ module Commands = else (log "not found: %s p") |> ignore + let rmdir dir path = + let p = path |> getfullpath dir + if Directory.Exists(p) then + (log "rmdir /sy %s" p) |> ignore + Directory.Delete(p, true) + else + (log "not found: %s p") |> ignore + let pathAddBackslash (p: FilePath) = if String.IsNullOrWhiteSpace (p) then p else @@ -115,6 +123,7 @@ type TestConfig = FSCBinPath : string FSCOREDLLPATH : string FSI : string + FSIANYCPU : string FSI_FOR_SCRIPTS : string fsi_flags : string ILDASM : string @@ -196,10 +205,12 @@ let config configurationName envVars = #if !FSHARP_SUITE_DRIVES_CORECLR_TESTS let FSI = requireFile (FSCBinPath ++ "fsi.exe") + let FSIANYCPU = requireFile (FSCBinPath ++ "fsiAnyCpu.exe") let FSC = requireFile (FSCBinPath ++ "fsc.exe") let FSCOREDLLPATH = requireFile (FSCBinPath ++ "FSharp.Core.dll") #else let FSI = SCRIPT_ROOT ++ ".." ++ ".." ++ "tests" ++ "testbin" ++ configurationName ++ "coreclr" ++ "FSC" ++ "fsi.exe" + let FSIANYCPU = SCRIPT_ROOT ++ ".." ++ ".." ++ "tests" ++ "testbin" ++ configurationName ++ "coreclr" ++ "FSC" ++ "fsiAnyCpu.exe" let FSC = SCRIPT_ROOT ++ ".." ++ ".." ++ "tests" ++ "testbin" ++ configurationName ++ "coreclr" ++ "FSC" ++ "fsc.exe" let FSCOREDLLPATH = "" #endif @@ -224,6 +235,7 @@ let config configurationName envVars = BUILD_CONFIG = configurationName FSC = FSC FSI = FSI + FSIANYCPU = FSIANYCPU FSI_FOR_SCRIPTS = FSI_FOR_SCRIPTS csc_flags = csc_flags fsc_flags = fsc_flags @@ -246,6 +258,7 @@ let logConfig (cfg: TestConfig) = log "FSCBINPATH =%s" cfg.FSCBinPath log "FSCOREDLLPATH =%s" cfg.FSCOREDLLPATH log "FSI =%s" cfg.FSI + log "FSIANYCPU =%s" cfg.FSIANYCPU log "fsi_flags =%s" cfg.fsi_flags log "ILDASM =%s" cfg.ILDASM log "NGEN =%s" cfg.NGEN @@ -455,6 +468,7 @@ let peverify cfg = Commands.peverify (exec cfg) cfg.PEVERIFY "/nologo" let sn cfg outfile arg = execAppendOutIgnoreExitCode cfg cfg.Directory outfile cfg.SN arg let peverifyWithArgs cfg args = Commands.peverify (exec cfg) cfg.PEVERIFY args let fsi cfg = Printf.ksprintf (Commands.fsi (exec cfg) cfg.FSI) +let fsiAnyCpu cfg = Printf.ksprintf (Commands.fsi (exec cfg) cfg.FSIANYCPU) let fsi_script cfg = Printf.ksprintf (Commands.fsi (exec cfg) cfg.FSI_FOR_SCRIPTS) let fsiExpectFail cfg = Printf.ksprintf (Commands.fsi (execExpectFail cfg) cfg.FSI) let fsiAppendIgnoreExitCode cfg stdoutPath stderrPath = Printf.ksprintf (Commands.fsi (execAppendIgnoreExitCode cfg stdoutPath stderrPath) cfg.FSI) @@ -464,6 +478,7 @@ let fileExists cfg = Commands.fileExists cfg.Directory >> Option.isSome let fsiStdin cfg stdinPath = Printf.ksprintf (Commands.fsi (execStdin cfg stdinPath) cfg.FSI) let fsiStdinAppendBothIgnoreExitCode cfg stdoutPath stderrPath stdinPath = Printf.ksprintf (Commands.fsi (execStdinAppendBothIgnoreExitCode cfg stdoutPath stderrPath stdinPath) cfg.FSI) let rm cfg x = Commands.rm cfg.Directory x +let rmdir cfg x = Commands.rmdir cfg.Directory x let mkdir cfg = Commands.mkdir_p cfg.Directory let copy_y cfg f = Commands.copy_y cfg.Directory f >> checkResult