Fix bug in assembly resolution in FSI (#2887)

* fix resolution to always prefer unification once an assembly has been referenced

* improve diagnostics

* fix proto

* fix unintended change

src/absil/il.fsi

@@ -261,23 +261,31 @@ type ILGenericVariance =
 /// Type refs, i.e. references to types in some .NET assembly
 [<Sealed>]
 type ILTypeRef =
+
     /// Create a ILTypeRef.
     static member Create : scope: ILScopeRef * enclosing: string list * name: string -> ILTypeRef
 
     /// Where is the type, i.e. is it in this module, in another module in this assembly or in another assembly? 
     member Scope: ILScopeRef
+
     /// The list of enclosing type names for a nested type. If non-nil then the first of these also contains the namespace.
     member Enclosing: string list
+
     /// The name of the type. This also contains the namespace if Enclosing is empty.
     member Name: string
+
     /// The name of the type in the assembly using the '.' notation for nested types.
     member FullName: string
+
     /// The name of the type in the assembly using the '+' notation for nested types.
     member BasicQualifiedName : string
+
     member QualifiedName: string
+
 #if EXTENSIONTYPING
     member QualifiedNameWithNoShortPrimaryAssembly: string
 #endif
+
     interface System.IComparable
     
 /// Type specs and types.  
@@ -295,6 +303,7 @@ type ILTypeSpec =
 
     /// Which type is being referred to?
     member TypeRef: ILTypeRef
+
     /// The type instantiation if the type is generic, otherwise empty
     member GenericArgs: ILGenericArgs
     member Scope: ILScopeRef

src/absil/ilreflect.fs

@@ -16,6 +16,8 @@ open Microsoft.FSharp.Compiler.AbstractIL.Extensions
 open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX
 open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types
 open Microsoft.FSharp.Compiler.AbstractIL.IL
+open Microsoft.FSharp.Compiler.ErrorLogger
+open Microsoft.FSharp.Compiler.Range
 
 open Microsoft.FSharp.Core.Printf
 
@@ -359,11 +361,15 @@ let convTypeRefAux (cenv:cenv) (tref:ILTypeRef) =
                 let asmName    = convAssemblyRef asmref
                 FileSystem.AssemblyLoad(asmName)
         let typT = assembly.GetType(qualifiedName)
-        typT |> nonNull "convTypeRefAux" 
+        match typT with 
+        | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, asmref.QualifiedName), range0))
+        | res -> res
     | ILScopeRef.Module _ 
     | ILScopeRef.Local _ ->
         let typT = Type.GetType(qualifiedName) 
-        typT |> nonNull "convTypeRefAux" 
+        match typT with 
+        | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, "<emitted>"), range0))
+        | res -> res
 
 
 
@@ -431,11 +437,15 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) =
         emEnv
 
 let convTypeRef cenv emEnv preferCreated (tref:ILTypeRef) = 
-    match Zmap.tryFind tref emEnv.emTypMap with
-    | Some (_typT,_typB,_typeDef,Some createdTyp) when preferCreated -> createdTyp |> nonNull "convTypeRef: null create type table?"
-    | Some (typT,_typB,_typeDef,_)                                  -> typT       |> nonNull "convTypeRef: null type table?"
-    | None                                                        -> convTypeRefAux cenv tref 
-
+    let res = 
+        match Zmap.tryFind tref emEnv.emTypMap with
+        | Some (_typT,_typB,_typeDef,Some createdTyp) when preferCreated -> createdTyp 
+        | Some (typT,_typB,_typeDef,_)                                  -> typT       
+        | None                                                        -> convTypeRefAux cenv tref 
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tref.QualifiedName, tref.Scope.QualifiedName), range0))
+    | _ -> res
+  
 let envBindConsRef emEnv (mref:ILMethodRef) consB = 
     {emEnv with emConsMap = Zmap.add mref consB emEnv.emConsMap}
 
@@ -484,11 +494,12 @@ let envPopTyvars  emEnv      =  {emEnv with emTyvars = List.tail emEnv.emTyvars}
 let envGetTyvar   emEnv u16  =  
     match emEnv.emTyvars with
     | []     -> failwith "envGetTyvar: not scope of type vars"
-    | tvs::_ -> let i = int32 u16 
-                if i<0 || i>= Array.length tvs then
-                    failwith (sprintf "want tyvar #%d, but only had %d tyvars" i (Array.length tvs))
-                else
-                    tvs.[i]
+    | tvs::_ -> 
+        let i = int32 u16 
+        if i<0 || i>= Array.length tvs then
+            failwith (sprintf "want tyvar #%d, but only had %d tyvars" i (Array.length tvs))
+        else
+            tvs.[i]
 
 let isEmittedTypeRef emEnv tref = Zmap.mem tref emEnv.emTypMap
 
@@ -519,16 +530,20 @@ let convCallConv (Callconv (hasThis,basic)) =
 let rec convTypeSpec cenv emEnv preferCreated (tspec:ILTypeSpec) =
     let typT   = convTypeRef cenv emEnv preferCreated tspec.TypeRef 
     let tyargs = List.map (convTypeAux cenv emEnv preferCreated) tspec.GenericArgs
-    match isNil tyargs,typT.IsGenericType with
-    | _   ,true  -> typT.MakeGenericType(List.toArray tyargs)   |> nonNull "convTypeSpec: generic" 
-    | true,false -> typT                                          |> nonNull "convTypeSpec: non generic" 
-    | _   ,false -> failwithf "- convTypeSpec: non-generic type '%O' has type instance of length %d?" typT tyargs.Length 
+    let res = 
+        match isNil tyargs,typT.IsGenericType with
+        | _   ,true  -> typT.MakeGenericType(List.toArray tyargs)   
+        | true,false -> typT                                          
+        | _   ,false -> null
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0))
+    | _ -> res
       
 and convTypeAux cenv emEnv preferCreated typ =
     match typ with
     | ILType.Void               -> Type.GetType("System.Void")
     | ILType.Array (shape,eltType) -> 
-        let baseT = convTypeAux cenv emEnv preferCreated eltType |> nonNull "convType: array base"
+        let baseT = convTypeAux cenv emEnv preferCreated eltType 
         let nDims = shape.Rank
         // MakeArrayType()  returns "eltType[]"
         // MakeArrayType(1) returns "eltType[*]"
@@ -538,15 +553,18 @@ and convTypeAux cenv emEnv preferCreated typ =
         if nDims=1
         then baseT.MakeArrayType() 
         else baseT.MakeArrayType shape.Rank
-    | ILType.Value tspec        -> convTypeSpec cenv emEnv preferCreated tspec              |> nonNull "convType: value"
-    | ILType.Boxed tspec        -> convTypeSpec cenv emEnv preferCreated tspec             |> nonNull "convType: boxed"
-    | ILType.Ptr eltType        -> let baseT = convTypeAux cenv emEnv preferCreated eltType  |> nonNull "convType: ptr eltType"
-                                   baseT.MakePointerType()                             |> nonNull "convType: ptr" 
-    | ILType.Byref eltType      -> let baseT = convTypeAux cenv emEnv preferCreated eltType |> nonNull "convType: byref eltType"
-                                   baseT.MakeByRefType()                               |> nonNull "convType: byref" 
-    | ILType.TypeVar tv         -> envGetTyvar emEnv tv                                |> nonNull "convType: tyvar" 
+    | ILType.Value tspec        -> convTypeSpec cenv emEnv preferCreated tspec
+    | ILType.Boxed tspec        -> convTypeSpec cenv emEnv preferCreated tspec
+    | ILType.Ptr eltType        -> 
+        let baseT = convTypeAux cenv emEnv preferCreated eltType
+        baseT.MakePointerType()
+    | ILType.Byref eltType      -> 
+        let baseT = convTypeAux cenv emEnv preferCreated eltType
+        baseT.MakeByRefType()
+    | ILType.TypeVar tv         -> envGetTyvar emEnv tv
     // Consider completing the following cases:                                                      
-    | ILType.Modified (false, _, modifiedTy)  -> convTypeAux cenv emEnv preferCreated modifiedTy
+    | ILType.Modified (false, _, modifiedTy)  -> 
+        convTypeAux cenv emEnv preferCreated modifiedTy
     | ILType.Modified (true, _, _) -> failwith "convType: modreq"
     | ILType.FunctionPointer _callsig -> failwith "convType: fptr"
 
@@ -639,11 +657,18 @@ let typeIsNotQueryable (typ : Type) =
 //----------------------------------------------------------------------------
 
 let queryableTypeGetField _emEnv (parentT:Type) (fref: ILFieldRef)  =
-    parentT.GetField(fref.Name, BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance ||| BindingFlags.Static )  
-        |> nonNull "queryableTypeGetField"
+    let res = parentT.GetField(fref.Name, BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance ||| BindingFlags.Static )  
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("field", fref.Name, fref.EnclosingTypeRef.FullName, fref.EnclosingTypeRef.Scope.QualifiedName), range0))
+    | _ -> res
     
 let nonQueryableTypeGetField (parentTI:Type) (fieldInfo : FieldInfo) : FieldInfo = 
-    if parentTI.IsGenericType then TypeBuilder.GetField(parentTI,fieldInfo) else fieldInfo
+    let res = 
+        if parentTI.IsGenericType then TypeBuilder.GetField(parentTI,fieldInfo) 
+        else fieldInfo
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("field", fieldInfo.Name, parentTI.AssemblyQualifiedName, parentTI.Assembly.FullName), range0))
+    | _ -> res
 
 
 let convFieldSpec cenv emEnv fspec =
@@ -735,10 +760,9 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref:ILMethodRef) =
         match List.tryFind select methInfos with
         | None          -> failwith "convMethodRef: could not bind to method"
         | Some methInfo -> methInfo (* return MethodInfo for (generic) type's (generic) method *)
-                           |> nonNull "convMethodRef"
           
 let queryableTypeGetMethod cenv emEnv parentT (mref:ILMethodRef) =
-    assert(not (typeIsNotQueryable(parentT)));
+    assert(not (typeIsNotQueryable(parentT)))
     if mref.GenericArity = 0 then 
         let tyargTs = getGenericArgumentsOfType parentT      
         let argTs,resT = 
@@ -775,20 +799,23 @@ let nonQueryableTypeGetMethod (parentTI:Type) (methInfo : MethodInfo) : MethodIn
 
 let convMethodRef cenv emEnv (parentTI:Type) (mref:ILMethodRef) =
     let parent = mref.EnclosingTypeRef
-    if isEmittedTypeRef emEnv parent then
-        // NOTE: if "convType becomes convCreatedType", then handle queryable types here too. [bug 4063]      
-        // Emitted type, can get fully generic MethodBuilder from env.
-        let methB = envGetMethB emEnv mref
-        nonQueryableTypeGetMethod parentTI methB
-        |> nonNull "convMethodRef (emitted)"
-    else
-        // Prior type.
-        if typeIsNotQueryable parentTI then 
-            let parentT = getTypeConstructor parentTI
-            let methInfo = queryableTypeGetMethod cenv emEnv parentT mref 
-            nonQueryableTypeGetMethod parentTI methInfo
-        else 
-            queryableTypeGetMethod cenv emEnv parentTI mref 
+    let res = 
+        if isEmittedTypeRef emEnv parent then
+            // NOTE: if "convType becomes convCreatedType", then handle queryable types here too. [bug 4063]      
+            // Emitted type, can get fully generic MethodBuilder from env.
+            let methB = envGetMethB emEnv mref
+            nonQueryableTypeGetMethod parentTI methB
+        else
+            // Prior type.
+            if typeIsNotQueryable parentTI then 
+                let parentT = getTypeConstructor parentTI
+                let methInfo = queryableTypeGetMethod cenv emEnv parentT mref 
+                nonQueryableTypeGetMethod parentTI methInfo
+            else 
+                queryableTypeGetMethod cenv emEnv parentTI mref 
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("method", mref.Name, parentTI.FullName, parentTI.Assembly.FullName), range0))
+    | _ -> res
 
 //----------------------------------------------------------------------------
 // convMethodSpec
@@ -804,7 +831,7 @@ let convMethodSpec cenv emEnv (mspec:ILMethodSpec) =
             let minstTs  = convTypesToArray cenv emEnv mspec.GenericArgs
             let methInfo = methInfo.MakeGenericMethod minstTs // instantiate method 
             methInfo
-    methInfo |> nonNull "convMethodSpec"
+    methInfo 
 
 //----------------------------------------------------------------------------
 // - QueryableTypeGetConstructors: get a constructor on a non-TypeBuilder type
@@ -815,7 +842,11 @@ let queryableTypeGetConstructor cenv emEnv (parentT:Type) (mref:ILMethodRef)  =
     let reqArgTs  = 
         let emEnv = envPushTyvars emEnv tyargTs
         convTypesToArray cenv emEnv mref.ArgTypes
-    parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance,null, reqArgTs,null)  
+    let res = parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance,null, reqArgTs,null)  
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", mref.Name, parentT.FullName, parentT.Assembly.FullName), range0))
+    | _ -> res
+
 
 let nonQueryableTypeGetConstructor (parentTI:Type) (consInfo : ConstructorInfo) : ConstructorInfo = 
     if parentTI.IsGenericType then TypeBuilder.GetConstructor(parentTI,consInfo) else consInfo
@@ -827,18 +858,21 @@ let nonQueryableTypeGetConstructor (parentTI:Type) (consInfo : ConstructorInfo)
 let convConstructorSpec cenv emEnv (mspec:ILMethodSpec) =
     let mref   = mspec.MethodRef
     let parentTI = convType cenv emEnv mspec.EnclosingType
-    if isEmittedTypeRef emEnv mref.EnclosingTypeRef then
-        // NOTE: if "convType becomes convCreatedType", then handle queryable types here too. [bug 4063]
-        let consB = envGetConsB emEnv mref
-        nonQueryableTypeGetConstructor parentTI consB |> nonNull "convConstructorSpec: (emitted)"
-    else
-        // Prior type.
-        if typeIsNotQueryable parentTI then 
-            let parentT  = getTypeConstructor parentTI       
-            let ctorG = queryableTypeGetConstructor cenv emEnv parentT mref 
-            nonQueryableTypeGetConstructor parentTI ctorG
+    let res = 
+        if isEmittedTypeRef emEnv mref.EnclosingTypeRef then
+            let consB = envGetConsB emEnv mref 
+            nonQueryableTypeGetConstructor parentTI consB 
         else
-            queryableTypeGetConstructor cenv emEnv parentTI mref 
+            // Prior type.
+            if typeIsNotQueryable parentTI then 
+                let parentT  = getTypeConstructor parentTI       
+                let ctorG = queryableTypeGetConstructor cenv emEnv parentT mref 
+                nonQueryableTypeGetConstructor parentTI ctorG
+            else
+                queryableTypeGetConstructor cenv emEnv parentTI mref 
+    match res with 
+    | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", "", parentTI.FullName, parentTI.Assembly.FullName), range0))
+    | _ -> res
 
 //----------------------------------------------------------------------------
 // emitLabelMark
@@ -1746,7 +1780,6 @@ let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nestin
 
     // TypeBuilder from TypeAttributes.
     let typB : TypeBuilder = rootTypeBuilder  (tdef.Name,attrsType)
-    let typB = typB |> nonNull "buildTypeDefPass1 cenv: typB is null!"
     cattrsLayout |> Option.iter typB.SetCustomAttributeAndLog;
 
     buildGenParamsPass1 emEnv typB.DefineGenericParametersAndLog tdef.GenericParams; 

src/fsharp/CompileOps.fs

@@ -3499,6 +3499,12 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres
             let r = ar.GetILAssemblyRef(ctok) |> Cancellable.runWithoutCancellation 
             r = assref)
 
+    /// This doesn't need to be cancellable, it is only used by F# Interactive
+    member tcResolution.TryFindBySimpleAssemblyName (ctok, simpleAssemName) = 
+        results |> List.tryFind (fun ar->
+            let r = ar.GetILAssemblyRef(ctok) |> Cancellable.runWithoutCancellation 
+            r.Name = simpleAssemName)
+
     member tcResolutions.TryFindByResolvedPath nm = resolvedPathToResolution.TryFind nm
     member tcResolutions.TryFindByOriginalReferenceText nm = originalReferenceToResolution.TryFind nm
         
@@ -4467,10 +4473,12 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti
 #endif
 
     /// This doesn't need to be cancellable, it is only used by F# Interactive
-    member tcImports.TryFindExistingFullyQualifiedPathFromAssemblyRef(ctok, assref:ILAssemblyRef) :  string option = 
-        match resolutions.TryFindByExactILAssemblyRef (ctok, assref) with 
-        | Some r -> Some r.resolvedPath
-        | None -> None
+    member tcImports.TryFindExistingFullyQualifiedPathBySimpleAssemblyName (ctok, simpleAssemName) :  string option = 
+        resolutions.TryFindBySimpleAssemblyName (ctok, simpleAssemName) |> Option.map (fun r -> r.resolvedPath)
+
+    /// This doesn't need to be cancellable, it is only used by F# Interactive
+    member tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef(ctok, assref:ILAssemblyRef) :  string option = 
+        resolutions.TryFindByExactILAssemblyRef (ctok, assref)  |> Option.map (fun r -> r.resolvedPath)
 
     member tcImports.TryResolveAssemblyReference(ctok, assemblyReference:AssemblyReference, mode:ResolveAssemblyReferenceMode) : OperationResult<AssemblyResolution list> = 
         let tcConfig = tcConfigP.Get(ctok)

src/fsharp/CompileOps.fsi

@@ -621,8 +621,14 @@ type TcImports =
 
     /// Resolve a referenced assembly and report an error if the resolution fails.
     member ResolveAssemblyReference : CompilationThreadToken * AssemblyReference * ResolveAssemblyReferenceMode -> AssemblyResolution list
+
+    /// Try to find the given assembly reference by simple name.  Used in magic assembly resolution.  Effectively does implicit
+    /// unification of assemblies by simple assembly name.
+    member TryFindExistingFullyQualifiedPathBySimpleAssemblyName : CompilationThreadToken * string -> string option
+
     /// Try to find the given assembly reference.
-    member TryFindExistingFullyQualifiedPathFromAssemblyRef : CompilationThreadToken * ILAssemblyRef -> string option
+    member TryFindExistingFullyQualifiedPathByExactAssemblyRef : CompilationThreadToken * ILAssemblyRef -> string option
+
 #if EXTENSIONTYPING
     /// Try to find a provider-generated assembly
     member TryFindProviderGeneratedAssemblyByName : CompilationThreadToken * assemblyName:string -> System.Reflection.Assembly option

src/fsharp/FSComp.txt

@@ -1404,3 +1404,5 @@ keywordDescriptionCast,"Converts a type to type that is higher in the hierarchy.
 keywordDescriptionDynamicCast,"Converts a type to a type that is lower in the hierarchy."
 keywordDescriptionTypedQuotation,"Delimits a typed code quotation."
 keywordDescriptionUntypedQuotation,"Delimits a untyped code quotation."
+3216,itemNotFoundDuringDynamicCodeGen,"%s '%s' not found in assembly '%s'. A possible cause may be a version incompatibility. You may need to explicitly reference the correct version of this assembly to allow all referenced components to use the correct version."
+3216,itemNotFoundInTypeDuringDynamicCodeGen,"%s '%s' not found in type '%s' from assembly '%s'. A possible cause may be a version incompatibility. You may need to explicitly reference the correct version of this assembly to allow all referenced components to use the correct version."
\ No newline at end of file

src/fsharp/fsi/fsi.fs

@@ -1609,6 +1609,15 @@ module internal MagicAssemblyResolution =
                let assemblyReferenceTextDll = (simpleAssemName + ".dll") 
                let assemblyReferenceTextExe = (simpleAssemName + ".exe") 
                let overallSearchResult =           
+
+                   // OK, try to resolve as an existing DLL in the resolved reference set.  This does unification by assembly name
+                   // once an assembly has been referenced.
+                   let searchResult = tcImports.TryFindExistingFullyQualifiedPathBySimpleAssemblyName (ctok, simpleAssemName)
+
+                   match searchResult with
+                   | Some r -> OkResult ([], Choice1Of2 r)
+                   | _ -> 
+
                    // OK, try to resolve as a .dll
                    let searchResult = tcImports.TryResolveAssemblyReference (ctok, AssemblyReference (m, assemblyReferenceTextDll, None), ResolveAssemblyReferenceMode.Speculative)
 
@@ -1645,7 +1654,7 @@ module internal MagicAssemblyResolution =
 #endif
                    
                    // As a last resort, try to find the reference without an extension
-                   match tcImports.TryFindExistingFullyQualifiedPathFromAssemblyRef(ctok, ILAssemblyRef.Create(simpleAssemName,None,None,false,None,None)) with
+                   match tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef(ctok, ILAssemblyRef.Create(simpleAssemName,None,None,false,None,None)) with
                    | Some(resolvedPath) -> 
                        OkResult([],Choice1Of2 resolvedPath)
                    | None -> 
@@ -2609,7 +2618,7 @@ type internal FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:st
         | Some assembly -> Some (Choice2Of2 assembly)
         | None -> 
 #endif
-        match tcImports.TryFindExistingFullyQualifiedPathFromAssemblyRef (ctok, aref) with
+        match tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef (ctok, aref) with
         | Some resolvedPath -> Some (Choice1Of2 resolvedPath)
         | None -> None
           

tests/fsharp/tests.fs

@@ -499,6 +499,10 @@ module CoreTests =
                 
 
 
+    // Debug with 
+    //     ..\..\..\..\debug\net40\bin\fsi.exe --nologo < test.fsx >a.out 2>a.err
+    // then 
+    ///    windiff z.output.test.default.stdout.bsl a.out
     let printing flag diffFileOut expectedFileOut diffFileErr expectedFileErr = 
        let cfg = testConfig "core/printing"