Type provider design time component loading suitable for .NET Core tooling (#3864)

* type provider design time component loading

* fix build

* fix build

* tests

* add tests

src/FSharpSource.Profiles.targets

@@ -9,6 +9,9 @@
     <DefineConstants>$(DefineConstants);FX_LCIDFROMCODEPAGE</DefineConstants>
   </PropertyGroup>
 
+  <!-- Note: The TargetDotnetProfile value 'coreclr' currently covers all of netstandard1.6, netstandard2.0 and netcoreapp2.0 in a confused way -->
+  <!-- These should be distinguished in the future -->
+
   <PropertyGroup Condition="'$(TargetDotnetProfile)'=='coreclr'">
     <DefineConstants>$(DefineConstants);FX_PORTABLE_OR_NETSTANDARD</DefineConstants>
     <DefineConstants>$(DefineConstants);NETSTANDARD1_6</DefineConstants>

src/fsharp/CompileOps.fs

@@ -4281,14 +4281,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 = 
@@ -4316,10 +4318,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.

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<obj>.Assembly.GetName().Name = "mscorlib" then 
+            [ "net461"; "net452"; "net451"; "net45"; "netstandard2.0"]
+        elif typeof<obj>.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<nativeint> = 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 _, _ ->

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 =
       {

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))
 
-    [<TestCaseSource("validValues")>] 
-    let ``should use values if valid major.minor.revision.build version format`` (v, expected) =
-        v |> productVersionToILVersionInfo |> Assert.areEqual expected
+    [<Test>]
+    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))
 
-    [<TestCaseSource("invalidValues")>]
-    let ``should zero starting from first invalid version part`` (v, expected) = 
-        v |> productVersionToILVersionInfo |> Assert.areEqual expected
+    [<Test>]
+    let ``should zero starting from first invalid version part`` () = 
+        for (v, expected) in  invalidValues() do
+            v |> productVersionToILVersionInfo |> Assert.areEqual expected
+
+module TypeProviderDesignTimeComponentLoading =
+
+
+    [<Test>]
+    let ``check tooling paths for type provider design time component loading`` () =
+        let arch = if sizeof<nativeint> = 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

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
 
 [<Test>]
@@ -248,14 +250,93 @@ let ``negative type provider tests`` (name:string) =
 
 [<Test>]
 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()
+
 [<Test>]
 let wedgeAssembly () = 
     let cfg = testConfig "typeProviders/wedgeAssembly"

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")

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
@@ -113,6 +121,7 @@ type TestConfig =
       FSCBinPath : string
       FSCOREDLLPATH : string
       FSI : string
+      FSIANYCPU : string
       FSI_FOR_SCRIPTS : string
       fsi_flags : string
       ILDASM : string
@@ -167,10 +176,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
@@ -191,6 +202,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 
@@ -211,6 +223,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 "PEVERIFY            =%s" cfg.PEVERIFY
@@ -418,6 +431,7 @@ let ildasm cfg arg = Printf.ksprintf (Commands.ildasm (exec cfg) cfg.ILDASM) arg
 let peverify cfg = Commands.peverify (exec cfg) cfg.PEVERIFY "/nologo"
 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)
@@ -427,6 +441,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