Bugfix :: Nullness in signature file is not considered by implementation and vice versa

.fantomasignore

@@ -121,6 +121,9 @@ src/Compiler/SyntaxTree/LexerStore.fs
 src/Compiler/Driver/GraphChecking/Graph.fsi
 src/Compiler/Driver/GraphChecking/Graph.fs
 
+src/Compiler/DependencyManager/NativeDllResolveHandler.fsi
+src/Compiler/DependencyManager/AssemblyResolveHandler.fsi
+
 # Fantomas limitations on implementation files  (to investigate)
 
 src/Compiler/AbstractIL/ilwrite.fs

src/Compiler/AbstractIL/ilreflect.fs

@@ -2548,7 +2548,7 @@ let EmitDynamicAssemblyFragment
             ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [||]))
             None
         with :? TargetInvocationException as exn ->
-            Some exn.InnerException
+            Option.ofObj exn.InnerException
 
     let emEnv, entryPts = envPopEntryPts emEnv
     let execs = List.map execEntryPtFun entryPts

src/Compiler/Checking/AttributeChecking.fsi

@@ -21,8 +21,8 @@ type AttribInfo =
     | FSAttribInfo of TcGlobals * Attrib
     | ILAttribInfo of TcGlobals * Import.ImportMap * ILScopeRef * ILAttribute * range
 
-    member ConstructorArguments: (TType * obj) list
-    member NamedArguments: (TType * string * bool * obj) list
+    member ConstructorArguments: (TType * objnull) list
+    member NamedArguments: (TType * string * bool * objnull) list
     member Range: range
     member TyconRef: TyconRef
 

src/Compiler/Checking/CheckDeclarations.fs

@@ -3060,7 +3060,7 @@ module EstablishTypeDefinitionCores =
 
             if not isRootGenerated then 
                 let desig = theRootTypeWithRemapping.TypeProviderDesignation
-                let nm = theRootTypeWithRemapping.PUntaint((fun st -> st.FullName), m)
+                let nm = theRootTypeWithRemapping.PUntaint((fun st -> string st.FullName), m)
                 error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig, nm), m))
 
             cenv.createsGeneratedProvidedTypes <- true
@@ -3101,7 +3101,7 @@ module EstablishTypeDefinitionCores =
 
                 if not isGenerated then 
                     let desig = st.TypeProviderDesignation
-                    let nm = st.PUntaint((fun st -> st.FullName), m)
+                    let nm = st.PUntaint((fun st -> string st.FullName), m)
                     error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig, nm), m))
 
                 // Embed the type into the module we're compiling
@@ -4251,7 +4251,7 @@ module TcDeclarations =
                 // For historical reasons we only give a warning for incorrect type parameters on intrinsic extensions
                 if nReqTypars <> synTypars.Length then 
                     errorR(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
-                if not (typarsAEquiv g TypeEquivEnv.Empty reqTypars declaredTypars) then 
+                if not (typarsAEquiv g (TypeEquivEnv.EmptyWithNullChecks g) reqTypars declaredTypars) then 
                     warning(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
                 // Note we return 'reqTypars' for intrinsic extensions since we may only have given warnings
                 IntrinsicExtensionBinding, reqTypars
@@ -4260,7 +4260,7 @@ module TcDeclarations =
                     errorR(Error(FSComp.SR.tcMembersThatExtendInterfaceMustBePlacedInSeparateModule(), tcref.Range))
                 if nReqTypars <> synTypars.Length then 
                     error(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
-                if not (typarsAEquiv g TypeEquivEnv.Empty reqTypars declaredTypars) then 
+                if not (typarsAEquiv g (TypeEquivEnv.EmptyWithNullChecks g) reqTypars declaredTypars) then 
                     errorR(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
                 ExtrinsicExtensionBinding, declaredTypars
 
@@ -5702,7 +5702,7 @@ let CheckModuleSignature g (cenv: cenv) m denvAtEnd rootSigOpt implFileTypePrior
                 |]
 
         // We want to show imperative type variables in any types in error messages at this late point 
-        let denv = { denvAtEnd with showInferenceTyparAnnotations=true }
+        let denv = { denvAtEnd with showInferenceTyparAnnotations=true;showNullnessAnnotations=Some g.checkNullness }
         try 
 
             // As typechecked the signature and implementation use different tycons etc. 
@@ -5714,7 +5714,7 @@ let CheckModuleSignature g (cenv: cenv) m denvAtEnd rootSigOpt implFileTypePrior
             // Compute the remapping from implementation to signature
             let remapInfo, _ = ComputeRemappingFromInferredSignatureToExplicitSignature g implFileTypePriorToSig sigFileType
 
-            let aenv = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.RepackagedEntities }
+            let aenv = { TypeEquivEnv.EmptyWithNullChecks g with EquivTycons = TyconRefMap.OfList remapInfo.RepackagedEntities }
 
             if not (SignatureConformance.Checker(g, cenv.amap, denv, remapInfo, true).CheckSignature aenv cenv.infoReader (mkLocalModuleRef implFileSpecPriorToSig) sigFileType) then
                 // We can just raise 'ReportedError' since CheckModuleOrNamespace raises its own error 

src/Compiler/Checking/ConstraintSolver.fs

@@ -345,7 +345,7 @@ let MakeConstraintSolverEnv contextInfo css m denv =
       eContextInfo = contextInfo
       MatchingOnly = false
       ErrorOnFailedMemberConstraintResolution = false
-      EquivEnv = TypeEquivEnv.Empty 
+      EquivEnv = TypeEquivEnv.EmptyIgnoreNulls
       DisplayEnv = denv
       IsSpeculativeForMethodOverloading = false
       IsSupportsNullFlex = false

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -12687,7 +12687,7 @@ and FixupLetrecBind (cenv: cenv) denv generalizedTyparsForRecursiveBlock (bind:
     | Some _ ->
        match PartitionValTyparsForApparentEnclosingType g vspec with
        | Some(parentTypars, memberParentTypars, _, _, _) ->
-          ignore(SignatureConformance.Checker(g, cenv.amap, denv, SignatureRepackageInfo.Empty, false).CheckTypars vspec.Range TypeEquivEnv.Empty memberParentTypars parentTypars)
+          ignore(SignatureConformance.Checker(g, cenv.amap, denv, SignatureRepackageInfo.Empty, false).CheckTypars vspec.Range TypeEquivEnv.EmptyIgnoreNulls memberParentTypars parentTypars)
        | None ->
           errorR(Error(FSComp.SR.tcMemberIsNotSufficientlyGeneric(), vspec.Range))
     | _ -> ()

src/Compiler/Checking/MethodCalls.fs

@@ -1815,14 +1815,14 @@ module ProvidedMethodCalls =
         let rec loop (st: Tainted<ProvidedType>) = 
             if st.PUntaint((fun st -> st.IsGenericParameter), m) then st
             elif st.PUntaint((fun st -> st.IsArray), m) then 
-                let et = st.PApply((fun st -> st.GetElementType()), m)
+                let et = st.PApply((fun st -> !! st.GetElementType()), m)
                 let rank = st.PUntaint((fun st -> st.GetArrayRank()), m)
                 (loop et).PApply((fun st -> if rank = 1 then st.MakeArrayType() else st.MakeArrayType(rank)), m)
             elif st.PUntaint((fun st -> st.IsByRef), m) then 
-                let et = st.PApply((fun st -> st.GetElementType()), m)
+                let et = st.PApply((fun st -> !! st.GetElementType()), m)
                 (loop et).PApply((fun st -> st.MakeByRefType()), m)
             elif st.PUntaint((fun st -> st.IsPointer), m) then 
-                let et = st.PApply((fun st -> st.GetElementType()), m)
+                let et = st.PApply((fun st -> !! st.GetElementType()), m)
                 (loop et).PApply((fun st -> st.MakePointerType()), m)
             else
                 let isGeneric = st.PUntaint((fun st -> st.IsGenericType), m)
@@ -2115,7 +2115,7 @@ module ProvidedMethodCalls =
             methInfoOpt, expr, exprTy
         with
             | :? TypeProviderError as tpe ->
-                let typeName = mi.PUntaint((fun mb -> (nonNull<ProvidedType> mb.DeclaringType).FullName), m)
+                let typeName = mi.PUntaint((fun mb -> (nonNull<ProvidedType> mb.DeclaringType).FullName |> string), m)
                 let methName = mi.PUntaint((fun mb -> mb.Name), m)
                 raise( tpe.WithContext(typeName, methName) )  // loses original stack trace
 #endif

src/Compiler/Checking/MethodOverrides.fs

@@ -269,7 +269,7 @@ module DispatchSlotChecking =
         // Compare the types. CompiledSigOfMeth, GetObjectExprOverrideInfo and GetTypeMemberOverrideInfo have already 
         // applied all relevant substitutions except the renamings from fvtmps <-> methTypars 
 
-        let aenv = TypeEquivEnv.FromEquivTypars fvmethTypars methTypars 
+        let aenv = (TypeEquivEnv.EmptyIgnoreNulls).FromEquivTypars fvmethTypars methTypars 
 
         List.forall2 (List.lengthsEqAndForall2 (typeAEquiv g aenv)) vargTys argTys &&
         returnTypesAEquiv g aenv vrty retTy &&
@@ -305,7 +305,7 @@ module DispatchSlotChecking =
                 ComposeTyparInsts ttpinst (ReverseTyparRenaming g memberToParentInst)
 
         // Compare under the composed substitutions 
-        let aenv = TypeEquivEnv.FromTyparInst ttpinst 
+        let aenv = (TypeEquivEnv.EmptyIgnoreNulls).FromTyparInst ttpinst 
 
         typarsAEquiv g aenv fvmethTypars methTypars
 

src/Compiler/Checking/NameResolution.fs

@@ -991,7 +991,7 @@ let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespac
             //if staticResInfo.NumStaticArgs > 0 then
             //    error(Error(FSComp.SR.etNestedProvidedTypesDoNotTakeStaticArgumentsOrGenericParameters(), m))
             []
-        | nestedSty ->
+        | Tainted.NonNull nestedSty ->
             [AddEntityForProvidedType (amap, modref, resolutionEnvironment, nestedSty, m) ]
     | _ -> []
 #endif

src/Compiler/Checking/NicePrint.fs

@@ -764,7 +764,7 @@ module PrintTypes =
             |> ListSet.setify (fun (_, cx1) (_, cx2) ->
                 match cx1, cx2 with 
                 | TyparConstraint.MayResolveMember(traitInfo1, _),
-                  TyparConstraint.MayResolveMember(traitInfo2, _) -> traitsAEquiv denv.g TypeEquivEnv.Empty traitInfo1 traitInfo2
+                  TyparConstraint.MayResolveMember(traitInfo2, _) -> traitsAEquiv denv.g (TypeEquivEnv.EmptyWithNullChecks denv.g) traitInfo1 traitInfo2
                 | _ -> false)
 
         let cxsL = List.collect (layoutConstraintWithInfo denv env) cxs
@@ -2930,7 +2930,7 @@ let minimalStringsOfTwoTypes denv ty1 ty2 =
         let denv = denv.SetOpenPaths []
         let denv = { denv with includeStaticParametersInTypeNames=true }
         let makeName t =
-            let assemblyName = PrintTypes.layoutAssemblyName denv t |> function Null | NonNull "" -> "" | NonNull name -> sprintf " (%s)" name
+            let assemblyName = PrintTypes.layoutAssemblyName denv t |> function | "" -> "" | name -> sprintf " (%s)" name
             sprintf "%s%s" (stringOfTy denv t) assemblyName
 
         (makeName ty1, makeName ty2, stringOfTyparConstraints denv tpcs)

src/Compiler/Checking/SignatureConformance.fs

@@ -25,15 +25,17 @@ open FSharp.Compiler.TypeHierarchy
 open FSharp.Compiler.TypeProviders
 #endif
 
+type TypeMismatchSource = NullnessOnlyMismatch | RegularMismatch
+
 exception RequiredButNotSpecified of DisplayEnv * ModuleOrNamespaceRef * string * (StringBuilder -> unit) * range
 
-exception ValueNotContained of DisplayEnv * InfoReader * ModuleOrNamespaceRef * Val * Val * (string * string * string -> string)
+exception ValueNotContained of kind:TypeMismatchSource * DisplayEnv * InfoReader * ModuleOrNamespaceRef * Val * Val * (string * string * string -> string)
 
 exception UnionCaseNotContained of DisplayEnv * InfoReader * Tycon * UnionCase * UnionCase * (string * string -> string)
 
 exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (string * string -> string)
 
-exception FieldNotContained of DisplayEnv * InfoReader * Tycon * Tycon * RecdField * RecdField * (string * string -> string)
+exception FieldNotContained of kind:TypeMismatchSource * DisplayEnv * InfoReader * Tycon * Tycon * RecdField * RecdField * (string * string -> string)
 
 exception InterfaceNotRevealed of DisplayEnv * TType * range
 
@@ -338,8 +340,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
             implVal.SetOtherRange (sigVal.Range, false)
             implVal.SetOtherXmlDoc(sigVal.XmlDoc)
 
-            let mk_err denv f = ValueNotContained(denv, infoReader, implModRef, implVal, sigVal, f)
-            let err denv f = errorR(mk_err denv f); false
+            let mk_err kind denv f = ValueNotContained(kind,denv, infoReader, implModRef, implVal, sigVal, f)
+            let err denv f = errorR(mk_err RegularMismatch denv f); false
             let m = implVal.Range
             if implVal.IsMutable <> sigVal.IsMutable then (err denv FSComp.SR.ValueNotContainedMutabilityAttributesDiffer)
             elif implVal.LogicalName <> sigVal.LogicalName then (err denv FSComp.SR.ValueNotContainedMutabilityNamesDiffer)
@@ -352,14 +354,22 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
             else 
                 let implTypars, implValTy = implVal.GeneralizedType
                 let sigTypars, sigValTy = sigVal.GeneralizedType
-                if implTypars.Length <> sigTypars.Length then (err {denv with showTyparBinding=true} FSComp.SR.ValueNotContainedMutabilityParameterCountsDiffer) else
-                let aenv = aenv.BindEquivTypars implTypars sigTypars 
-                checkTypars m aenv implTypars sigTypars &&
-                if not (typeAEquiv g aenv implValTy sigValTy) then err denv FSComp.SR.ValueNotContainedMutabilityTypesDiffer
-                elif not (checkValInfo aenv (err denv) implVal sigVal) then false
-                elif implVal.IsExtensionMember <> sigVal.IsExtensionMember then err denv FSComp.SR.ValueNotContainedMutabilityExtensionsDiffer
-                elif not (checkMemberDatasConform (err denv) (implVal.Attribs, implVal, implVal.MemberInfo) (sigVal.Attribs, sigVal, sigVal.MemberInfo)) then false
-                else checkAttribs aenv implVal.Attribs sigVal.Attribs (fun attribs -> implVal.SetAttribs attribs)              
+                if implTypars.Length <> sigTypars.Length then (err {denv with showTyparBinding=true} FSComp.SR.ValueNotContainedMutabilityParameterCountsDiffer) 
+                else
+                    let aenv = aenv.BindEquivTypars implTypars sigTypars 
+                    checkTypars m aenv implTypars sigTypars &&
+                        let strictTyEquals = typeAEquiv g aenv implValTy sigValTy
+                        let onlyDiffersInNullness = not(strictTyEquals) && g.checkNullness && typeAEquiv g {aenv with NullnessMustEqual = false} implValTy sigValTy
+
+                        // The types would be equal if we did not have nullness checks => lets just generate a warning, not an error
+                        if onlyDiffersInNullness then
+                            warning(mk_err NullnessOnlyMismatch denv FSComp.SR.ValueNotContainedMutabilityTypesDifferNullness)
+
+                        if not strictTyEquals && not onlyDiffersInNullness then err denv FSComp.SR.ValueNotContainedMutabilityTypesDiffer                          
+                        elif not (checkValInfo aenv (err denv) implVal sigVal) then false
+                        elif implVal.IsExtensionMember <> sigVal.IsExtensionMember then err denv FSComp.SR.ValueNotContainedMutabilityExtensionsDiffer
+                        elif not (checkMemberDatasConform (err denv) (implVal.Attribs, implVal, implVal.MemberInfo) (sigVal.Attribs, sigVal, sigVal.MemberInfo)) then false
+                        else checkAttribs aenv implVal.Attribs sigVal.Attribs (fun attribs -> implVal.SetAttribs attribs)              
 
 
         and checkExnInfo err aenv (infoReader: InfoReader) (enclosingImplTycon: Tycon) (enclosingSigTycon: Tycon) implTypeRepr sigTypeRepr =
@@ -394,15 +404,29 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
         and checkField aenv infoReader (enclosingImplTycon: Tycon) (enclosingSigTycon: Tycon) implField sigField =
             implField.SetOtherXmlDoc(sigField.XmlDoc)
 
-            let err f = errorR(FieldNotContained(denv, infoReader, enclosingImplTycon, enclosingSigTycon, implField, sigField, f)); false
+            let diag kind f = FieldNotContained(kind,denv, infoReader, enclosingImplTycon, enclosingSigTycon, implField, sigField, f)
+            let err f = errorR(diag RegularMismatch f); false
+
+            let areTypesDifferent() =
+                let strictTyEquals = typeAEquiv g aenv implField.FormalType sigField.FormalType
+                let onlyDiffersInNullness = not(strictTyEquals) && g.checkNullness &&  typeAEquiv g {aenv with NullnessMustEqual = false} implField.FormalType sigField.FormalType
+
+                // The types would be equal if we did not have nullness checks => lets just generate a warning, not an error
+                if onlyDiffersInNullness then
+                    warning(diag NullnessOnlyMismatch FSComp.SR.FieldNotContainedTypesDifferNullness)
+                    false
+                else
+                    not strictTyEquals  
+
+
             sigField.rfield_other_range <- Some (implField.Range, true)
             implField.rfield_other_range <- Some (sigField.Range, false)
             if implField.rfield_id.idText <> sigField.rfield_id.idText then err FSComp.SR.FieldNotContainedNamesDiffer
             elif isLessAccessible implField.Accessibility sigField.Accessibility then err FSComp.SR.FieldNotContainedAccessibilitiesDiffer
             elif implField.IsStatic <> sigField.IsStatic then err FSComp.SR.FieldNotContainedStaticsDiffer
             elif implField.IsMutable <> sigField.IsMutable then err FSComp.SR.FieldNotContainedMutablesDiffer
             elif implField.LiteralValue <> sigField.LiteralValue then err FSComp.SR.FieldNotContainedLiteralsDiffer
-            elif not (typeAEquiv g aenv implField.FormalType sigField.FormalType) then err FSComp.SR.FieldNotContainedTypesDiffer
+            elif areTypesDifferent() then err FSComp.SR.FieldNotContainedTypesDiffer
             else 
                 checkAttribs aenv implField.FieldAttribs sigField.FieldAttribs (fun attribs -> implField.rfield_fattribs <- attribs) &&
                 checkAttribs aenv implField.PropertyAttribs sigField.PropertyAttribs (fun attribs -> implField.rfield_pattribs <- attribs)

src/Compiler/Checking/SignatureConformance.fsi

@@ -13,9 +13,14 @@ open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.InfoReader
 
+type TypeMismatchSource =
+    | NullnessOnlyMismatch
+    | RegularMismatch
+
 exception RequiredButNotSpecified of DisplayEnv * ModuleOrNamespaceRef * string * (StringBuilder -> unit) * range
 
 exception ValueNotContained of
+    kind: TypeMismatchSource *
     DisplayEnv *
     InfoReader *
     ModuleOrNamespaceRef *
@@ -28,6 +33,7 @@ exception UnionCaseNotContained of DisplayEnv * InfoReader * Tycon * UnionCase *
 exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (string * string -> string)
 
 exception FieldNotContained of
+    kind: TypeMismatchSource *
     DisplayEnv *
     InfoReader *
     Tycon *