diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index 6b9aa8d1cb5..5b99f1253b8 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -23,13 +23,14 @@ * Enforce AttributeTargets on implicit constructors. ([PR #16845](https://github.com/dotnet/fsharp/pull/16845/)) * Enforce AttributeTargets on structs and classes ([PR #16790](https://github.com/dotnet/fsharp/pull/16790)) * Parser: fix pattern range for idents with trivia ([PR #16824](https://github.com/dotnet/fsharp/pull/16824)) -* Fix broken code completion after a record type declaration ([PR #16813](https://github.com/dotnet/fsharp/pull/16813)) +* Fix broken code completion after a record type declaration ([PR #16813](https://github.com/dotnet/fsharp/pull/16813))* Enforce AttributeTargets on enums ([PR #16887](https://github.com/dotnet/fsharp/pull/16887)) * Enforce AttributeTargets on enums ([PR #16887](https://github.com/dotnet/fsharp/pull/16887)) * Completion: fix for unfinished record field decl ([PR #16893](https://github.com/dotnet/fsharp/pull/16893)) * Enforce AttributeTargets on delegates ([PR #16891](https://github.com/dotnet/fsharp/pull/16891)) * Completion: fix completion in empty dot lambda prefix ([#16829](https://github.com/dotnet/fsharp/pull/16829)) * Fix StackOverflow when checking non-recursive bindings in module or namespace in `fscAnyCpu`/`fsiAnyCpu`. ([PR #16908](https://github.com/dotnet/fsharp/pull/16908)) + ### Added * Support for nullable reference types ([PR #15181](https://github.com/dotnet/fsharp/pull/15181)) diff --git a/docs/release-notes/.FSharp.Core/8.0.300.md b/docs/release-notes/.FSharp.Core/8.0.300.md index be97542e410..5888f5562f3 100644 --- a/docs/release-notes/.FSharp.Core/8.0.300.md +++ b/docs/release-notes/.FSharp.Core/8.0.300.md @@ -11,3 +11,4 @@ * Enforce AttributeTargets on structs and classes. Also update `RequireQualifiedAccessAttribute` and `AutoOpenAttribute` to use `AttributeTargets.Struct` ([PR #16790](https://github.com/dotnet/fsharp/pull/16790)) * Enforce AttributeTargets on enums. Also update `RequireQualifiedAccessAttribute` to use `AttributeTargets.Enum` ([PR #16887](https://github.com/dotnet/fsharp/pull/16887)) * Enforce AttributeTargets on delegates. Also update `ReflectedDefinitionAttribute` to use `AttributeTargets.Delegate` ([PR #16891](https://github.com/dotnet/fsharp/pull/16891)) + diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 79dc9402014..d550aaccba4 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -540,7 +540,7 @@ let IsSecurityAttribute (g: TcGlobals) amap (casmap : IDictionary) match casmap.TryGetValue tcs with | true, c -> c | _ -> - let exists = ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkAppTy attr.TyconRef [])) g amap m AllowMultiIntfInstantiations.Yes (mkAppTy tcref []) + let exists = ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkWoNullAppTy attr.TyconRef [])) g amap m AllowMultiIntfInstantiations.Yes (mkWoNullAppTy tcref []) casmap[tcs] <- exists exists | ValueNone -> false diff --git a/src/Compiler/Checking/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index d3e9fb1d42d..cfaece0bfb4 100644 --- a/src/Compiler/Checking/AugmentWithHashCompare.fs +++ b/src/Compiler/Checking/AugmentWithHashCompare.fs @@ -20,7 +20,7 @@ let mkIComparableCompareToSlotSig (g: TcGlobals) = let mkGenericIComparableCompareToSlotSig (g: TcGlobals) ty = TSlotSig( "CompareTo", - (mkAppTy g.system_GenericIComparable_tcref [ ty ]), + (mkWoNullAppTy g.system_GenericIComparable_tcref [ ty ]), [], [], [ [ TSlotParam(Some("obj"), ty, false, false, false, []) ] ], @@ -44,7 +44,7 @@ let mkIStructuralComparableCompareToSlotSig (g: TcGlobals) = let mkGenericIEquatableEqualsSlotSig (g: TcGlobals) ty = TSlotSig( "Equals", - (mkAppTy g.system_GenericIEquatable_tcref [ ty ]), + (mkWoNullAppTy g.system_GenericIEquatable_tcref [ ty ]), [], [], [ [ TSlotParam(Some("obj"), ty, false, false, false, []) ] ], @@ -414,7 +414,7 @@ let mkExnEquality (g: TcGlobals) exnref (exnc: Tycon) = let cases = [ - mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []), mbuilder.AddResultTarget(expr)) + mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkWoNullAppTy exnref []), mbuilder.AddResultTarget(expr)) ] let dflt = Some(mbuilder.AddResultTarget(mkFalse g m)) @@ -445,7 +445,7 @@ let mkExnEqualityWithComparer g exnref (exnc: Tycon) (_thisv, thise) thatobje (t let cases = [ - mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []), mbuilder.AddResultTarget(expr)) + mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkWoNullAppTy exnref []), mbuilder.AddResultTarget(expr)) ] let dflt = mbuilder.AddResultTarget(mkFalse g m) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index bcd29bac526..504a574b0cc 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -776,7 +776,7 @@ module AddAugmentationDeclarations = let tcaug = tycon.TypeContents let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range - let genericIComparableTy = mkAppTy g.system_GenericIComparable_tcref [ty] + let genericIComparableTy = mkWoNullAppTy g.system_GenericIComparable_tcref [ty] let hasExplicitIComparable = tycon.HasInterface g g.mk_IComparable_ty @@ -874,7 +874,7 @@ module AddAugmentationDeclarations = let vspec1, vspec2 = AugmentTypeDefinitions.MakeValsForEqualsAugmentation g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) if not tycon.IsFSharpException then - PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy g.system_GenericIEquatable_tcref [ty]) + PublishInterface cenv env.DisplayEnv tcref m true (mkWoNullAppTy g.system_GenericIEquatable_tcref [ty]) PublishValueDefn cenv env ModuleOrMemberBinding vspec1 PublishValueDefn cenv env ModuleOrMemberBinding vspec2 AugmentTypeDefinitions.MakeBindingsForEqualsAugmentation g tycon @@ -1992,8 +1992,8 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env if (generatedCompareToValues && typeEquiv g intfTyR g.mk_IComparable_ty) || (generatedCompareToWithComparerValues && typeEquiv g intfTyR g.mk_IStructuralComparable_ty) || - (generatedCompareToValues && typeEquiv g intfTyR (mkAppTy g.system_GenericIComparable_tcref [ty])) || - (generatedHashAndEqualsWithComparerValues && typeEquiv g intfTyR (mkAppTy g.system_GenericIEquatable_tcref [ty])) || + (generatedCompareToValues && typeEquiv g intfTyR (mkWoNullAppTy g.system_GenericIComparable_tcref [ty])) || + (generatedHashAndEqualsWithComparerValues && typeEquiv g intfTyR (mkWoNullAppTy g.system_GenericIEquatable_tcref [ty])) || (generatedHashAndEqualsWithComparerValues && typeEquiv g intfTyR g.mk_IStructuralEquatable_ty) then errorR(Error(FSComp.SR.tcDefaultImplementationForInterfaceHasAlreadyBeenAdded(), intfTy.Range)) @@ -3328,7 +3328,7 @@ module EstablishTypeDefinitionCores = super |> Option.map (fun ty -> if isFunTy g ty then let a,b = destFunTy g ty - mkAppTy g.fastFunc_tcr [a; b] + mkWoNullAppTy g.fastFunc_tcr [a; b] else ty) // Publish the super type @@ -3727,7 +3727,7 @@ module EstablishTypeDefinitionCores = // validate ConditionalAttribute, should it be applied (it's only valid on a type if the type is an attribute type) match attrs |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ConditionalAttribute) with | Some _ -> - if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkAppTy g.tcref_System_Attribute [])) g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then + if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkWoNullAppTy g.tcref_System_Attribute [])) g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then errorR(Error(FSComp.SR.tcConditionalAttributeUsage(), m)) | _ -> () diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index b7b89d4e2a8..00137c9bd86 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -830,10 +830,10 @@ let TcConst (cenv: cenv) (overallTy: TType) m env synConst = let measureTy = match synConst with | SynConst.Measure(synMeasure = SynMeasure.Anon _) -> - (mkAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then TyparStaticReq.None else TyparStaticReq.HeadType), TyparDynamicReq.No)))]) + (mkWoNullAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then TyparStaticReq.None else TyparStaticReq.HeadType), TyparDynamicReq.No)))]) - | SynConst.Measure(synMeasure = ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)] - | _ -> mkAppTy tcr [TType_measure Measure.One] + | SynConst.Measure(synMeasure = ms) -> mkWoNullAppTy tcr [TType_measure (tcMeasure ms)] + | _ -> mkWoNullAppTy tcr [TType_measure Measure.One] unif measureTy let expandedMeasurablesEnabled = @@ -853,7 +853,7 @@ let TcConst (cenv: cenv) (overallTy: TType) m env synConst = unif g.float_ty Const.Double f | SynConst.Decimal f -> - unif (mkAppTy g.decimal_tcr []) + unif (mkWoNullAppTy g.decimal_tcr []) Const.Decimal f | SynConst.SByte i -> unif g.sbyte_ty @@ -1041,6 +1041,11 @@ let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC + if not g.compilingFSharpCore && isTyparTy g innerTyC then + // A typar might be later infered into a type not supporting `| null|, like tuple or anon. + // Repeat the check in post inference + AddCxTypeCanCarryNullnessInfo env.DisplayEnv cenv.css m innerTyC nullness + innerTyCWithNull else @@ -3419,7 +3424,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr match probe exprTyAsSeq with | Some res -> res | None -> - let ienumerable = mkAppTy g.tcref_System_Collections_IEnumerable [] + let ienumerable = mkWoNullAppTy g.tcref_System_Collections_IEnumerable [] match probe ienumerable with | Some res -> res | None -> @@ -5025,7 +5030,7 @@ and TcProvidedTypeApp (cenv: cenv) env tpenv tcref args m = // We put the type name check after the 'isDirectReferenceToGenerated' check because we need the 'isDirectReferenceToGenerated' error to be shown for generated types checkTypeName() if hasNoArgs then - mkAppTy tcref [], tpenv + mkWoNullAppTy tcref [], tpenv else let ty = Import.ImportProvidedType cenv.amap m providedTypeAfterStaticArguments ty, tpenv @@ -7646,7 +7651,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m | None -> [] | Some(tinst, tcref, _, fldsList) -> - let gtyp = mkAppTy tcref tinst + let gtyp = mkWoNullAppTy tcref tinst UnifyTypes cenv env mWholeExpr overallTy gtyp [ for n, v in fldsList do @@ -12114,7 +12119,7 @@ and TcLetrecBinding | None -> let reqdThisValTy = if isByrefTy g reqdThisValTy then destByrefTy g reqdThisValTy else reqdThisValTy let enclosingTyconRef = tcrefOfAppTy g reqdThisValTy - reqdThisValTy, (mkAppTy enclosingTyconRef (List.map mkTyparTy enclosingDeclaredTypars)), vspec.Range + reqdThisValTy, (mkWoNullAppTy enclosingTyconRef (List.map mkTyparTy enclosingDeclaredTypars)), vspec.Range | Some thisVal -> reqdThisValTy, thisVal.Type, thisVal.Range if not (AddCxTypeEqualsTypeUndoIfFailed envRec.DisplayEnv cenv.css rangeForCheck actualThisValTy reqdThisValTy) then diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 79758a01327..d2a6b566ab2 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -446,7 +446,7 @@ and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m = | None -> (fun _ -> TPat_error m), patEnv | Some(tinst, tcref, fldsmap, _fldsList) -> - let gtyp = mkAppTy tcref tinst + let gtyp = mkWoNullAppTy tcref tinst let inst = List.zip (tcref.Typars m) tinst UnifyTypes cenv env m ty gtyp diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index e8c63814bbd..c3903d1b75c 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1545,7 +1545,7 @@ and DepthCheck ndeep m = and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty = match getMeasureOfType csenv.g ty with | Some (tcref, _) -> - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkAppTy tcref [TType_measure Measure.One]) + SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkWoNullAppTy tcref [TType_measure Measure.One]) | None -> CompleteD @@ -1650,8 +1650,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload match getMeasureOfType g argTy1 with | Some (tcref, ms1) -> let ms2 = freshMeasure () - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkAppTy tcref [TType_measure ms2]) - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkWoNullAppTy tcref [TType_measure ms2]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) return TTraitBuiltIn | _ -> @@ -1659,8 +1659,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload match getMeasureOfType g argTy2 with | Some (tcref, ms2) -> let ms1 = freshMeasure () - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkAppTy tcref [TType_measure ms1]) - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure ms1]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) return TTraitBuiltIn | _ -> @@ -1794,8 +1794,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload match getMeasureOfType g argTy1 with | Some (tcref, _) -> let ms1 = freshMeasure () - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))]) - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure ms1]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure ms1]) return TTraitBuiltIn | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 @@ -1847,7 +1847,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 match getMeasureOfType g argTy1 with | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure Measure.One]) + | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure Measure.One]) return TTraitBuiltIn | _ -> @@ -2623,6 +2623,18 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2)) } +and SolveTypeCanCarryNullness (csenv: ConstraintSolverEnv) ty nullness = + trackErrors { + let g = csenv.g + let m = csenv.m + let strippedTy = stripTyEqnsA g true ty + match tryAddNullnessToTy nullness strippedTy with + | Some _ -> () + | None -> + let tyString = NicePrint.minimalStringOfType csenv.DisplayEnv strippedTy + return! ErrorD(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) + } + and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty = let g = csenv.g let m = csenv.m @@ -3885,6 +3897,12 @@ let AddCxTypeUseSupportsNull denv css m trace ty = (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult +let AddCxTypeCanCarryNullnessInfo denv css m ty nullness = + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let canCarryNullnessCheck() = SolveTypeCanCarryNullness csenv ty nullness |> RaiseOperationResult + csenv.SolverState.PushPostInferenceCheck (preDefaults=false, check = canCarryNullnessCheck) + + let AddCxTypeMustSupportComparison denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv PostponeOnFailedMemberConstraintResolution csenv trace diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index 13b484356e9..4c29d684c31 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -291,6 +291,8 @@ val AddCxTypeDefnNotSupportsNull: DisplayEnv -> ConstraintSolverState -> range - val AddCxTypeUseSupportsNull: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit +val AddCxTypeCanCarryNullnessInfo: DisplayEnv -> ConstraintSolverState -> range -> TType -> Nullness -> unit + val AddCxTypeMustSupportComparison: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit val AddCxTypeMustSupportEquality: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 6c85319ddc2..f6ca36614a6 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1107,7 +1107,7 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: TyconRef) = let tps = match tcrefNested.Typars m with [] -> [] | l -> List.skip tinst.Length l let tinstNested = ncenv.InstantiationGenerator m tps - mkAppTy tcrefNested (tinst @ tinstNested) + mkWoNullAppTy tcrefNested (tinst @ tinstNested) /// Get all the accessible nested types of an existing type. let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = @@ -3400,7 +3400,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa | tcref :: _ when tcref.IsUnionTycon -> let res = ResolutionInfo.Empty.AddEntity (id.idRange, tcref) ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.Pattern, ad, res, ResultTyparChecker(fun () -> true)) - Item.Types (id.idText, [ mkAppTy tcref [] ]) + Item.Types (id.idText, [ mkWoNullAppTy tcref [] ]) | _ -> match ResolveLongIdentAsModuleOrNamespace sink ncenv.amap id.idRange true fullyQualified nenv ad id [] false ShouldNotifySink.Yes with | Result ((_, mref, _) :: _) -> diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 4e8ced8fadb..ed786b941a5 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -611,7 +611,7 @@ let getDiscrimOfPattern (g: TcGlobals) tpinst t = | TPat_isinst (srcTy, tgtTy, _, _m) -> Some(DecisionTreeTest.IsInst (instType tpinst srcTy, instType tpinst tgtTy)) | TPat_exnconstr(tcref, _, _m) -> - Some(DecisionTreeTest.IsInst (g.exn_ty, mkAppTy tcref [])) + Some(DecisionTreeTest.IsInst (g.exn_ty, mkWoNullAppTy tcref [])) | TPat_const (c, _m) -> Some(DecisionTreeTest.Const c) | TPat_unioncase (c, tyargs', _, _m) -> @@ -1520,7 +1520,7 @@ let CompilePatternBasic | TPat_exnconstr (ecref, argpats, _) -> let srcTy1 = g.exn_ty - let tgtTy1 = mkAppTy ecref [] + let tgtTy1 = mkWoNullAppTy ecref [] if taken |> List.exists (discrimsEq g (DecisionTreeTest.IsInst (srcTy1, tgtTy1))) then [] else match discrim with diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index 8173c13755f..9c814c1da97 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -584,7 +584,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.ExnConstr tcref, _, args -> let _rgtypR = ConvTyconRef cenv tcref m - let _typ = mkAppTy tcref [] + let _typ = mkWoNullAppTy tcref [] let parentTyconR = ConvTyconRef cenv tcref m let argTys = tcref |> recdFieldsOfExnDefRef |> List.map (fun rfld -> rfld.FormalType) let methArgTypesR = ConvTypes cenv env m argTys diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index a19d3c4d3b5..ea0d9e93970 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -201,10 +201,10 @@ and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIComparable_tcref [ty] + mkWoNullAppTy g.system_GenericIComparable_tcref [ty] //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIEquatable_tcref [ty] + mkWoNullAppTy g.system_GenericIEquatable_tcref [ty] ] // Check for any System.Numerics type in the interface hierarchy diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 17ca9570bfb..56bb9b85ad5 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1382,7 +1382,7 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = if isCtor || cctor then ILType.Void else ilRetTy let ilTy = - GenType cenv m tyenvUnderTypars (mkAppTy parentTcref (List.map mkTyparTy ctps)) + GenType cenv m tyenvUnderTypars (mkWoNullAppTy parentTcref (List.map mkTyparTy ctps)) let nm = vref.CompiledName g.CompilerGlobalState @@ -2195,9 +2195,9 @@ type AnonTypeGenerationTable() = [ (g.mk_IStructuralComparable_ty, true, m) (g.mk_IComparable_ty, true, m) - (mkAppTy g.system_GenericIComparable_tcref [ ty ], true, m) + (mkWoNullAppTy g.system_GenericIComparable_tcref [ ty ], true, m) (g.mk_IStructuralEquatable_ty, true, m) - (mkAppTy g.system_GenericIEquatable_tcref [ ty ], true, m) + (mkWoNullAppTy g.system_GenericIEquatable_tcref [ ty ], true, m) ] let vspec1, vspec2 = AugmentTypeDefinitions.MakeValsForEqualsAugmentation g tcref @@ -5451,7 +5451,7 @@ and CommitCallSequel cenv eenv m cloc cgbuf mustGenerateUnitAfterCall sequel = and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = let g = cenv.g - let ety = mkAppTy (g.FindSysTyconRef [ "System" ] "NotSupportedException") [] + let ety = mkWoNullAppTy (g.FindSysTyconRef [ "System" ] "NotSupportedException") [] let ilTy = GenType cenv m eenv.tyenv ety let mref = mkILCtorMethSpecForTy(ilTy, [ g.ilg.typ_String ]).MethodRef Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [ ety ]), [], [ argExpr ], m) diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index fafb8184600..5af43b07801 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -2245,7 +2245,7 @@ let TryDetectQueryQuoteAndRun cenv (expr: Expr) = | QuerySelect g (qTy, _, resultElemTy, _, _) | QueryYield g (qTy, resultElemTy, _) | QueryYieldFrom g (qTy, resultElemTy, _) - when typeEquiv g qTy (mkAppTy g.tcref_System_Collections_IEnumerable []) -> + when typeEquiv g qTy (mkWoNullAppTy g.tcref_System_Collections_IEnumerable []) -> match tryRewriteToSeqCombinators g e with | Some newSource -> diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index dfdfb782e46..15b1bb2a3f6 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -327,7 +327,7 @@ module FSharpExprConvert = let ConvILTypeRefApp (cenv: SymbolEnv) m tref tyargs = let tcref = Import.ImportILTypeRef cenv.amap m tref - ConvType cenv (mkAppTy tcref tyargs) + ConvType cenv (mkWoNullAppTy tcref tyargs) let ConvUnionCaseRef cenv (ucref: UnionCaseRef) = FSharpUnionCase(cenv, ucref) @@ -378,7 +378,7 @@ module FSharpExprConvert = // Large lists | Expr.Op (TOp.UnionCase ucref, tyargs, [e1;e2], _) -> let mkR = ConvUnionCaseRef cenv ucref - let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy ucref.TyconRef tyargs) let e1R = ConvExpr cenv env e1 // tail recursive ConvExprLinear cenv env e2 (contF << (fun e2R -> E.NewUnionCase(typR, mkR, [e1R; e2R]) )) @@ -622,7 +622,7 @@ module FSharpExprConvert = match op, tyargs, args with | TOp.UnionCase ucref, _, _ -> let mkR = ConvUnionCaseRef cenv ucref - let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy ucref.TyconRef tyargs) let argsR = ConvExprs cenv env args E.NewUnionCase(typR, mkR, argsR) @@ -637,13 +637,13 @@ module FSharpExprConvert = E.NewTuple(tyR, argsR) | TOp.Recd (_, tcref), _, _ -> - let typR = ConvType cenv (mkAppTy tcref tyargs) + let typR = ConvType cenv (mkWoNullAppTy tcref tyargs) let argsR = ConvExprs cenv env args E.NewRecord(typR, argsR) | TOp.UnionCaseFieldGet (ucref, n), tyargs, [e1] -> let mkR = ConvUnionCaseRef cenv ucref - let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy ucref.TyconRef tyargs) let projR = FSharpField(cenv, ucref, n) E.UnionCaseGet(ConvExpr cenv env e1, typR, mkR, projR) @@ -653,7 +653,7 @@ module FSharpExprConvert = | TOp.UnionCaseFieldSet (ucref, n), tyargs, [e1;e2] -> let mkR = ConvUnionCaseRef cenv ucref - let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy ucref.TyconRef tyargs) let projR = FSharpField(cenv, ucref, n) E.UnionCaseSet(ConvExpr cenv env e1, typR, mkR, projR, ConvExpr cenv env e2) @@ -665,13 +665,13 @@ module FSharpExprConvert = | TOp.ValFieldGet rfref, tyargs, [] -> let projR = ConvRecdFieldRef cenv rfref - let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy rfref.TyconRef tyargs) E.FSharpFieldGet(None, typR, projR) | TOp.ValFieldGet rfref, tyargs, [obj] -> let objR = ConvLValueExpr cenv env obj let projR = ConvRecdFieldRef cenv rfref - let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy rfref.TyconRef tyargs) E.FSharpFieldGet(Some objR, typR, projR) | TOp.TupleFieldGet (tupInfo, n), tyargs, [e] -> @@ -775,7 +775,7 @@ module FSharpExprConvert = let argTy2 = tyOfExpr g arg2 let resTy = match getMeasureOfType g argTy1, getMeasureOfType g argTy2 with - | Some (tcref, ms1), Some (_tcref2, ms2) -> mkAppTy tcref [TType_measure (Measure.Prod(ms1, if isMul then ms2 else Measure.Inv ms2))] + | Some (tcref, ms1), Some (_tcref2, ms2) -> mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if isMul then ms2 else Measure.Inv ms2))] | Some _, None -> argTy1 | None, Some _ -> argTy2 | None, None -> argTy1 @@ -805,18 +805,18 @@ module FSharpExprConvert = E.ILAsm(sprintf "%+A" instrs, ConvTypes cenv tyargs, ConvExprs cenv env args) | TOp.ExnConstr tcref, tyargs, args -> - E.NewRecord(ConvType cenv (mkAppTy tcref tyargs), ConvExprs cenv env args) + E.NewRecord(ConvType cenv (mkWoNullAppTy tcref tyargs), ConvExprs cenv env args) | TOp.ValFieldSet rfref, _tinst, [obj;arg] -> let objR = ConvLValueExpr cenv env obj let argR = ConvExpr cenv env arg - let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy rfref.TyconRef tyargs) let projR = ConvRecdFieldRef cenv rfref E.FSharpFieldSet(Some objR, typR, projR, argR) | TOp.ValFieldSet rfref, _tinst, [arg] -> let argR = ConvExpr cenv env arg - let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + let typR = ConvType cenv (mkWoNullAppTy rfref.TyconRef tyargs) let projR = ConvRecdFieldRef cenv rfref E.FSharpFieldSet(None, typR, projR, argR) @@ -824,16 +824,16 @@ module FSharpExprConvert = let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList[i] let fref = mkRecdFieldRef tcref fspec.LogicalName - let typR = ConvType cenv (mkAppTy tcref tyargs) - let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, g.exn_ty)) + let typR = ConvType cenv (mkWoNullAppTy tcref tyargs) + let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkWoNullAppTy tcref [], m, g.exn_ty)) E.FSharpFieldGet(Some objR, typR, ConvRecdFieldRef cenv fref) | TOp.ExnFieldSet (tcref, i), [], [obj;e2] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList[i] let fref = mkRecdFieldRef tcref fspec.LogicalName - let typR = ConvType cenv (mkAppTy tcref tyargs) - let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, g.exn_ty)) + let typR = ConvType cenv (mkWoNullAppTy tcref tyargs) + let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkWoNullAppTy tcref [], m, g.exn_ty)) E.FSharpFieldSet(Some objR, typR, ConvRecdFieldRef cenv fref, ConvExpr cenv env e2) | TOp.Coerce, [tgtTy;srcTy], [x] -> @@ -896,7 +896,7 @@ module FSharpExprConvert = | TOp.UnionCaseProof _, _, [e] -> ConvExprPrim cenv env e // Note: we erase the union case proof conversions when converting to quotations | TOp.UnionCaseTagGet tycr, tyargs, [arg1] -> - let typR = ConvType cenv (mkAppTy tycr tyargs) + let typR = ConvType cenv (mkWoNullAppTy tycr tyargs) E.UnionCaseTag(ConvExpr cenv env arg1, typR) | TOp.TraitCall traitInfo, _, _ -> @@ -1019,7 +1019,7 @@ module FSharpExprConvert = | [v] -> makeFSCall isMember v | [] -> - let typR = ConvType cenv (mkAppTy tcref enclTypeArgs) + let typR = ConvType cenv (mkWoNullAppTy tcref enclTypeArgs) if enclosingEntity.IsModuleOrNamespace then let findModuleMemberByName = enclosingEntity.ModuleOrNamespaceType.AllValsAndMembers @@ -1295,7 +1295,7 @@ module FSharpExprConvert = | DecisionTreeTest.UnionCase (ucref, tyargs) -> let objR = ConvExpr cenv env inpExpr let ucR = ConvUnionCaseRef cenv ucref - let utypR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let utypR = ConvType cenv (mkWoNullAppTy ucref.TyconRef tyargs) E.IfThenElse (E.UnionCaseTest (objR, utypR, ucR) |> Mk cenv m g.bool_ty, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) | DecisionTreeTest.Const (Const.Bool true) -> let e1R = ConvExpr cenv env inpExpr diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 12b1f5e361d..aa6671e96d2 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -463,6 +463,7 @@ type TcGlobals( let mkByrefTy ty = TType_app(v_byref_tcr, [ty], v_knownWithoutNull) let mkNativePtrTy ty = TType_app(v_nativeptr_tcr, [ty], v_knownWithoutNull) let mkFunTy d r = TType_fun (d, r, v_knownWithoutNull) + let mkFunTyWithNullness d r nullness = TType_fun (d, r, nullness) let (-->) d r = mkFunTy d r let mkIteratedFunTy dl r = List.foldBack mkFunTy dl r let mkSmallRefTupledTy l = match l with [] -> v_unit_ty | [h] -> h | tys -> mkRawRefTupleTy tys @@ -991,8 +992,7 @@ type TcGlobals( let decompileTyconEntries = [| - // TODO: nullness here - "FSharpFunc`2" , v_fastFunc_tcr , (fun tinst _nullness -> mkFunTy (List.item 0 tinst) (List.item 1 tinst)) + "FSharpFunc`2" , v_fastFunc_tcr , (fun tinst -> mkFunTyWithNullness (List.item 0 tinst) (List.item 1 tinst)) "Tuple`2" , v_ref_tuple2_tcr , decodeTupleTyAndNullness tupInfoRef "Tuple`3" , v_ref_tuple3_tcr , decodeTupleTyAndNullness tupInfoRef "Tuple`4" , v_ref_tuple4_tcr , decodeTupleTyAndNullness tupInfoRef diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 1c2ad533bb5..dcd41add400 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -863,7 +863,7 @@ let isMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure _ -> true let isProvenUnionCaseTy ty = match ty with TType_ucase _ -> true | _ -> false -let mkAppTy tcref tyargs = TType_app(tcref, tyargs, KnownWithoutNull) // TODO NULLNESS - check various callers +let mkWoNullAppTy tcref tyargs = TType_app(tcref, tyargs, KnownWithoutNull) let mkProvenUnionCaseTy ucref tyargs = TType_ucase(ucref, tyargs) @@ -923,7 +923,7 @@ let convertToTypeWithMetadataIfPossible g ty = mkOuterCompiledTupleTy g (evalTupInfoIsStruct tupInfo) tupElemTys elif isFunTy g ty then let a,b = destFunTy g ty - mkAppTy g.fastFunc_tcr [a; b] + mkWoNullAppTy g.fastFunc_tcr [a; b] else ty //--------------------------------------------------------------------------- @@ -6649,7 +6649,7 @@ let rec tyOfExpr g expr = | TOp.ILCall (_, _, _, _, _, _, _, _, _, _, retTypes) | TOp.ILAsm (_, retTypes) -> (match retTypes with [h] -> h | _ -> g.unit_ty) | TOp.UnionCase uc -> actualResultTyOfUnionCase tinst uc | TOp.UnionCaseProof uc -> mkProvenUnionCaseTy uc tinst - | TOp.Recd (_, tcref) -> mkAppTy tcref tinst + | TOp.Recd (_, tcref) -> mkWoNullAppTy tcref tinst | TOp.ExnConstr _ -> g.exn_ty | TOp.Bytes _ -> mkByteArrayTy g | TOp.UInt16s _ -> mkArrayType g g.uint16_ty @@ -7641,7 +7641,7 @@ let permuteExprList (sigma: int[]) (exprs: Expr list) (ty: TType list) (names: s /// We still need to sort by index. let mkRecordExpr g (lnk, tcref, tinst, unsortedRecdFields: RecdFieldRef list, unsortedFieldExprs, m) = // Remove any abbreviations - let tcref, tinst = destAppTy g (mkAppTy tcref tinst) + let tcref, tinst = destAppTy g (mkWoNullAppTy tcref tinst) let sortedRecdFields = unsortedRecdFields |> List.indexed |> Array.ofList |> Array.sortBy (fun (_, r) -> r.Index) let sigma = Array.create sortedRecdFields.Length -1 @@ -7926,9 +7926,9 @@ let TryEliminateDesugaredConstants g m c = | _ -> None -let mkSeqTy (g: TcGlobals) ty = mkAppTy g.seq_tcr [ty] +let mkSeqTy (g: TcGlobals) ty = mkWoNullAppTy g.seq_tcr [ty] -let mkIEnumeratorTy (g: TcGlobals) ty = mkAppTy g.tcref_System_Collections_Generic_IEnumerator [ty] +let mkIEnumeratorTy (g: TcGlobals) ty = mkWoNullAppTy g.tcref_System_Collections_Generic_IEnumerator [ty] let mkCallSeqCollect g m alphaTy betaTy arg1 arg2 = let enumty2 = try rangeOfFunTy g (tyOfExpr g arg1) with _ -> (* defensive programming *) (mkSeqTy g betaTy) @@ -9405,7 +9405,7 @@ let mkChoiceTy (g: TcGlobals) m tinst = match List.length tinst with | 0 -> g.unit_ty | 1 -> List.head tinst - | length -> mkAppTy (mkChoiceTyconRef g m length) tinst + | length -> mkWoNullAppTy (mkChoiceTyconRef g m length) tinst let mkChoiceCaseRef g m n i = mkUnionCaseRef (mkChoiceTyconRef g m n) ("Choice"+string (i+1)+"Of"+string n) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 66fae0692fd..f52e620150a 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -686,7 +686,7 @@ val tryAnyParTyOption: TcGlobals -> TType -> Typar option val isMeasureTy: TcGlobals -> TType -> bool -val mkAppTy: TyconRef -> TypeInst -> TType +val mkWoNullAppTy: TyconRef -> TypeInst -> TType val mkProvenUnionCaseTy: UnionCaseRef -> TypeInst -> TType diff --git a/src/Compiler/xlf/FSStrings.de.xlf b/src/Compiler/xlf/FSStrings.de.xlf index e5eec7c30e3..2b23796249e 100644 --- a/src/Compiler/xlf/FSStrings.de.xlf +++ b/src/Compiler/xlf/FSStrings.de.xlf @@ -10,7 +10,7 @@ The {0} definitions for type '{1}' in the signature and implementation are not compatible because the abbreviations differ:\n {2}\nversus\n {3} The {0} definitions for type '{1}' in the signature and implementation are not compatible because the abbreviations differ:\n {2}\nversus\n {3} - + Nullness warning: {0}. diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index ad60ab47147..7f9ee1b1c8c 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -167,6 +167,7 @@ namespace Microsoft.FSharp.Core AttributeTargets.Parameter ||| AttributeTargets.Method ||| AttributeTargets.Property ||| AttributeTargets.Constructor ||| AttributeTargets.Delegate, AllowMultiple=false)>] + [] type ReflectedDefinitionAttribute(includeValue: bool) = inherit Attribute() diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 71cc1266dd4..6ba4b580529 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -555,8 +555,8 @@ module CustomAttributes_AttributeUsage = (Error 842, Line 20, Col 3, Line 20, Col 14, "This attribute is not valid for use on this language element") (Error 842, Line 21, Col 3, Line 21, Col 18, "This attribute is not valid for use on this language element") (Error 842, Line 22, Col 3, Line 22, Col 17, "This attribute is not valid for use on this language element") - ] - + ] + // SOURCE=AttributeTargetsIsDelegate01.fs # AttributeTargetsIsDelegate01.fs [] let ``AttributeTargetsIsDelegate01_fs`` compilation = diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 296d057ee74..1227fc44f47 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -8,6 +8,7 @@ let typeCheckWithStrictNullness cu = |> withLangVersionPreview |> withCheckNulls |> withWarnOn 3261 + |> withWarnOn 3262 |> withOptions ["--warnaserror+"] |> compile @@ -184,8 +185,131 @@ let myFunction (input1 : string | null) (input2 : string | null): (string*string |> typeCheckWithStrictNullness |> shouldFail |> withErrorCode 3261 + +[] +let ``WithNull used on anon type`` () = + FSharp """module MyLibrary + +let maybeAnon : _ | null = {|Hello="there"|} +let maybeAnon2 : {|Hello:string|} | null = null +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3260, Line 4, Col 18, Line 4, Col 41, "The type '{| Hello: string |}' does not support a nullness qualitification." + Error 3261, Line 4, Col 44, Line 4, Col 48, "Nullness warning: The type '{| Hello: string |}' does not support 'null'."] + + +[] +let ``WithNull on a DU`` () = + FSharp """module MyLibrary + +type MyDu = A | B + + +let strictFunc(arg: 'x when 'x : not null) = + printfn "%A" arg + arg + +let looseFunc(arg: _ | null) = arg + +strictFunc(A) |> ignore +looseFunc(A) |> ignore + +let maybeDu : _ | null = MyDu.A +let maybeDu2 : _ | null = null + +strictFunc(maybeDu) |> ignore +strictFunc(maybeDu2) |> ignore + +looseFunc(maybeDu2) |> ignore +looseFunc(maybeDu2) |> ignore + +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics [ + Error 3261, Line 18, Col 12, Line 18, Col 19, "Nullness warning: The type 'MyDu | null' supports 'null' but a non-null type is expected." + Error 3261, Line 19, Col 12, Line 19, Col 20, "Nullness warning: The type ''a | null' supports 'null' but a non-null type is expected."] + +[] +let ``Regression strict func`` () = + FSharp """module MyLibrary +let strictFunc(arg: 'x when 'x : not null) = printfn "%s" (arg.ToString()) + +strictFunc({|Anon=5|}) |> ignore +strictFunc("hi") |> ignore +strictFunc(null) |> ignore +strictFunc(null:(string|null)) |> ignore +strictFunc(null:obj) |> ignore + + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3261, Line 7, Col 12, Line 7, Col 30, "Nullness warning: The type 'string | null' supports 'null' but a non-null type is expected." ] + + +[] +let ``Nullnesss support for F# types`` () = + FSharp """module MyLibrary +type MyDu = A | B +type MyRecord = {X:int;Y:string} + +let strictFunc(arg: 'x when 'x : not null) = + printfn "%A" arg + arg + +let looseFunc(arg: _ | null) = arg + +strictFunc(A) |> ignore +strictFunc({X=1;Y="a"}) |> ignore +strictFunc({|ZZ=15;YZ="a"|}) |> ignore +strictFunc((1,2,3)) |> ignore + +looseFunc(A) |> ignore +looseFunc({X=1;Y="a"}) |> ignore +looseFunc({|ZZ=15;YZ="a"|}) |> ignore +looseFunc((1,2,3)) |> ignore +strictFunc(null) |> ignore +looseFunc(null) |> ignore +let maybeDu : _ | null = MyDu.A +let maybeRecd : MyRecord | null = {X=1;Y="a"} +let maybeAnon : _ | null = {|Hello="there"|} +let maybeTuple : (int*int) | null = null + +strictFunc(maybeDu) |> ignore +strictFunc(maybeRecd) |> ignore +strictFunc(maybeAnon) |> ignore +strictFunc(maybeTuple) |> ignore + +looseFunc(maybeDu) |> ignore +looseFunc(maybeRecd) |> ignore +looseFunc(maybeAnon) |> ignore +looseFunc(maybeTuple) |> ignore + +type Maybe<'T> = 'T | null +let maybeTuple2 : Maybe = null +strictFunc(maybeTuple2) |> ignore +looseFunc(maybeTuple2) |> ignore + + +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3260, Line 27, Col 18, Line 27, Col 34, "The type '(int * int)' does not support a nullness qualitification." + Error 3261, Line 27, Col 37, Line 27, Col 41, "Nullness warning: The type '(int * int)' does not support 'null'." + Error 3261, Line 29, Col 12, Line 29, Col 19, "Nullness warning: The type 'MyDu | null' supports 'null' but a non-null type is expected." + Error 3261, Line 30, Col 12, Line 30, Col 21, "Nullness warning: The type 'MyRecord | null' supports 'null' but a non-null type is expected." + Error 3261, Line 40, Col 36, Line 40, Col 40, "Nullness warning: The type 'Maybe' does not support 'null'."] + [] let ``Static member on Record with null arg`` () = FSharp """module MyLibrary @@ -197,7 +321,6 @@ let thisWorks = MyRecord.Create("xx") let thisShouldWarn = MyRecord.Create(null) let maybeNull : string | null = "abc" let thisShouldAlsoWarn = MyRecord.Create(maybeNull) - """ |> asLibrary |> typeCheckWithStrictNullness @@ -210,7 +333,6 @@ let thisShouldAlsoWarn = MyRecord.Create(maybeNull) [] let ``Option ofObj should remove nullness when used in a function`` () = FSharp """module MyLibrary - let processOpt2 (s: string | null) : string option = Option.ofObj s""" |> asLibrary |> typeCheckWithStrictNullness @@ -222,7 +344,6 @@ let ``Option ofObj should remove nullness when piping`` () = let processOpt (s: string | null) : string option = let stringOpt = Option.ofObj s stringOpt - let processOpt3 (s: string | null) : string option = s |> Option.ofObj """ |> asLibrary @@ -252,7 +373,6 @@ let processOpt3 (s: string) : string option = [] let ``Option ofObj called on a string literal`` () = FSharp """module MyLibrary - let whatIsThis = Option.ofObj "abc123" """ |> asLibrary @@ -283,7 +403,6 @@ let clearlyNotNull = "42" let mappedVal = nonNull clearlyNotNull let maybeNull : string | null = null let mappedMaybe = nonNull maybeNull - """ |> asLibrary |> typeCheckWithStrictNullness @@ -310,5 +429,4 @@ let mapped2 = |> withDiagnostics [ Error 3262, Line 6, Col 7, Line 6, Col 24, "Value known to be without null passed to a function meant for nullables: You can remove this |NonNullQuick| pattern usage." Error 3262, Line 10, Col 6, Line 10, Col 10, "Value known to be without null passed to a function meant for nullables: You can remove this |Null|NonNull| pattern usage." - Error 3262, Line 11, Col 6, Line 11, Col 15, "Value known to be without null passed to a function meant for nullables: You can remove this |Null|NonNull| pattern usage."] - \ No newline at end of file + Error 3262, Line 11, Col 6, Line 11, Col 15, "Value known to be without null passed to a function meant for nullables: You can remove this |Null|NonNull| pattern usage."] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs index e92ef88592c..1b524fe445a 100644 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs @@ -78,11 +78,11 @@ let ``auto-widen-minimal``() = [] let ``auto-widen-version-preview-warns-on``() = - singleVersionedNegTestAux "core/auto-widen/preview" ["--warnon:3388";"--warnon:3389";"--warnon:3395";"--warnaserror+";"--define:NEGATIVE"] LangVersion.Preview "test" + singleVersionedNegTestAux "core/auto-widen/preview" ["--warnon:3388";"--warnon:3389";"--warnon:3395";"--warnaserror+";"--define:NEGATIVE"] LangVersion.V80 "test" [] let ``auto-widen-version-preview-default-warns``() = - singleVersionedNegTestAux "core/auto-widen/preview-default-warns" ["--warnaserror+";"--define:NEGATIVE"] LangVersion.Preview "test" + singleVersionedNegTestAux "core/auto-widen/preview-default-warns" ["--warnaserror+";"--define:NEGATIVE"] LangVersion.V80 "test" [] let ``comprehensions-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions" FSC_DEBUG