Improve compiler designtime probing (#4250)

Author: KevinRansom

src/fsharp/ExtensionTyping.fs

@@ -38,6 +38,7 @@ module internal ExtensionTyping =
 
     // Specify the tooling-compatible fragments of a path such as:
     //     typeproviders/fsharp41/net461/MyProvider.DesignTime.dll
+    //     tools/fsharp41/net461/MyProvider.DesignTime.dll
     // See https://github.com/Microsoft/visualfsharp/issues/3736
 
     // Represents the FF#-compiler <-> type provider protocol.
@@ -55,16 +56,12 @@ module internal ExtensionTyping =
             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
+            for netRuntime in toolingCompatibleVersions() do 
+                yield Path.Combine("typeproviders", protocol, netRuntime)
+                yield Path.Combine("tools", protocol, netRuntime)
         ]
 
     /// Load a the design-time part of a type-provider into the host process, and look for types

tests/FSharp.Compiler.UnitTests/ProductVersion.fs

@@ -111,18 +111,16 @@ 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
+        let expected =
+          [ @"typeproviders\fsharp41\net461"
+            @"tools\fsharp41\net461"
             @"typeproviders\fsharp41\net452"
-            @"typeproviders\fsharp41\net451\" + arch
+            @"tools\fsharp41\net452"
             @"typeproviders\fsharp41\net451"
-            @"typeproviders\fsharp41\net45\" + arch
+            @"tools\fsharp41\net451"
             @"typeproviders\fsharp41\net45"
-            @"typeproviders\fsharp41\netstandard2.0\" + arch 
+            @"tools\fsharp41\net45"
             @"typeproviders\fsharp41\netstandard2.0"
-          ]        
+            @"tools\fsharp41\netstandard2.0" ]
         let actual = Microsoft.FSharp.Compiler.ExtensionTyping.toolingCompatiblePaths()
         Assert.areEqual expected actual

tests/fsharp/TypeProviderTests.fs

@@ -248,15 +248,16 @@ let ``negative type provider tests`` (name:string) =
 
         SingleTest.singleNegTest cfg name
 
-[<Test>]
-let splitAssembly () = 
+let splitAssembly subdir project =
 
-    let cfg = testConfig "typeProviders/splitAssembly"
+    let cfg = testConfig project
 
     let clean() = 
         rm cfg "providerDesigner.dll"
         rmdir cfg "typeproviders"
+        rmdir cfg "tools"
         rmdir cfg (".." ++ "typeproviders")
+        rmdir cfg (".." ++ "tools")
 
     clean()
 
@@ -276,20 +277,11 @@ let splitAssembly () =
 
     // check a few load locations
     let someLoadPaths = 
-        [ "typeproviders" ++ "fsharp41" ++ "net461" ++ "x86"
-          "typeproviders" ++ "fsharp41" ++ "net461"
-          "typeproviders" ++ "fsharp41" ++ "net45"
+        [ subdir ++ "fsharp41" ++ "net461"
+          subdir ++ "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"  ]
-
+          ".." ++ subdir ++ "fsharp41" ++ "net45"
+          subdir ++ "fsharp41" ++ "netstandard2.0" ]
 
     for dir in someLoadPaths do
 
@@ -311,31 +303,13 @@ let splitAssembly () =
 
         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"]
+    clean()
 
-        // 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 -> ()
+[<Test>]
+let splitAssemblyTools () = splitAssembly "tools" "typeProviders/splitAssemblyTools"
 
-    clean()
+[<Test>]
+let splitAssemblyTypeProviders () = splitAssembly "typeproviders" "typeProviders/splitAssemblyTypeproviders"
 
 [<Test>]
 let wedgeAssembly () = 

tests/fsharp/typeProviders/splitAssembly/provider.fs renamed to tests/fsharp/typeProviders/splitAssemblyTools/provider.fs

@@ -0,0 +1,17 @@
+namespace Microsoft.FSharp.Core.CompilerServices
+
+type TypeProviderAssemblyAttribute(assemblyName) =
+    inherit System.Attribute()
+
+    new() = TypeProviderAssemblyAttribute(null)
+    member this.AssemblyName 
+        with get () = assemblyName 
+
+[<assembly:TypeProviderAssembly("providerDesigner")>]
+do()
+
+
+namespace My
+    type Runtime =
+        static member Id x = x
+

tests/fsharp/typeProviders/splitAssembly/providerDesigner.fsx renamed to tests/fsharp/typeProviders/splitAssemblyTools/providerDesigner.fsx

@@ -0,0 +1,51 @@
+namespace Provider
+#load @"..\helloWorld\TypeMagic.fs"
+open Microsoft.FSharp.Core.CompilerServices
+open System.Collections.Generic
+open System.IO
+open System
+open System.Reflection
+open System.Linq.Expressions
+open FSharp.TypeMagic
+
+[<TypeProvider>]
+type public Provider(config : TypeProviderConfig) =
+    let runtimeAssembly = Assembly.ReflectionOnlyLoadFrom(config.RuntimeAssembly)
+    let modul = runtimeAssembly.GetModules().[0]
+
+    let ``My.Runtime`` = runtimeAssembly.GetType("My.Runtime")
+    let rootNamespace = "FSharp.SplitAssembly"
+    let invalidation = new Event<System.EventHandler,_>()
+
+    let theType = 
+        let rec members =
+            lazy
+                [|  let p = TypeBuilder.CreateSyntheticProperty(theType,"Foo",typeof<int>,isStatic=true) 
+                    yield! TypeBuilder.JoinPropertiesIntoMemberInfos [p]
+                |]
+        and theType =                
+            TypeBuilder.CreateSimpleType(TypeContainer.Namespace(modul,rootNamespace),"TheType", members = members)
+        theType
+
+    interface IProvidedNamespace with
+        member this.NamespaceName = rootNamespace
+        member this.GetNestedNamespaces() = [||]
+        member this.ResolveTypeName typeName =
+            match typeName with
+            |   "TheType" -> theType
+            |   _ -> null
+        member this.GetTypes() = [| theType |] 
+
+    interface IDisposable with
+        member __.Dispose() = ()
+    interface ITypeProvider with
+        member this.ApplyStaticArguments (st,_,_) = st
+        member this.GetInvokerExpression(mb,p) = 
+            let mi = ``My.Runtime``.GetMethod("Id").MakeGenericMethod([|typeof<int>|])
+            Quotations.Expr.Call(mi, [ Quotations.Expr.Value(42) ])
+        member this.GetNamespaces() = [| this |]
+        member this.GetStaticParameters st = [||]
+        [<CLIEvent>]
+        member this.Invalidate = invalidation.Publish
+        member this.GetGeneratedAssemblyContents(assembly) = failwith "GetGeneratedAssemblyContents - only erased types were provided!!"
+

tests/fsharp/typeProviders/splitAssembly/test.fsx renamed to tests/fsharp/typeProviders/splitAssemblyTools/test.fsx

@@ -0,0 +1,32 @@
+#r "provider.dll"
+
+let mutable failures = []
+let reportFailure s = 
+  stdout.WriteLine "\n................TEST FAILED...............\n"; failures <- failures @ [s]
+
+let check s e r = 
+  if r = e then  stdout.WriteLine (s+": YES") 
+  else (stdout.WriteLine ("\n***** "+s+": FAIL\n"); reportFailure s)
+
+let test s b = 
+  if b then ( (* stdout.WriteLine ("passed: " + s) *) ) 
+  else (stderr.WriteLine ("failure: " + s); 
+        reportFailure s)
+(*========================================================================*)
+
+check "fgdjkwefg"
+    FSharp.SplitAssembly.TheType.Foo
+    42
+
+(*---------------------------------------------------------------------------
+!* wrap up
+ *--------------------------------------------------------------------------- *)
+
+let _ = 
+  if not failures.IsEmpty then (printfn "Test Failed, failures = %A" failures; exit 1) 
+
+do (stdout.WriteLine "Test Passed"; 
+    System.IO.File.WriteAllText("test.ok","ok"); 
+    exit 0)
+
+