From 4ba648bdabf334eef698c19cbc512041a76be511 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 14 Mar 2024 13:19:52 +0100 Subject: [PATCH 01/14] mkAppTy resolved --- src/Compiler/Checking/AttributeChecking.fs | 2 +- .../Checking/AugmentWithHashCompare.fs | 8 ++-- src/Compiler/Checking/CheckDeclarations.fs | 12 +++--- src/Compiler/Checking/CheckExpressions.fs | 16 ++++---- src/Compiler/Checking/CheckPatterns.fs | 2 +- src/Compiler/Checking/ConstraintSolver.fs | 16 ++++---- src/Compiler/Checking/NameResolution.fs | 4 +- .../Checking/PatternMatchCompilation.fs | 4 +- src/Compiler/Checking/QuotationTranslator.fs | 2 +- src/Compiler/Checking/TypeHierarchy.fs | 4 +- src/Compiler/CodeGen/IlxGen.fs | 8 ++-- src/Compiler/Optimize/Optimizer.fs | 2 +- src/Compiler/Symbols/Exprs.fs | 38 +++++++++---------- src/Compiler/TypedTree/TypedTreeOps.fs | 14 +++---- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 +- 15 files changed, 67 insertions(+), 67 deletions(-) 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 a1e3ce8262b..8b61b5609c1 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -775,7 +775,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 @@ -873,7 +873,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 @@ -1991,8 +1991,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)) @@ -3316,7 +3316,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 @@ -3715,7 +3715,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 62625ac5f18..d6f39a7eda1 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 @@ -3419,7 +3419,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 +5025,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 @@ -7642,7 +7642,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 @@ -12105,7 +12105,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 896df82f844..fbf48dcdf2d 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -442,7 +442,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 cfae752df80..72530a44de4 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1536,7 +1536,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 @@ -1641,8 +1641,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 | _ -> @@ -1650,8 +1650,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 | _ -> @@ -1785,8 +1785,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 @@ -1838,7 +1838,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 | _ -> 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 92caba2e9a1..a29ff2f7357 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 @@ -5450,7 +5450,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/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index f57e00d0158..da6977c1dd4 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 //--------------------------------------------------------------------------- @@ -6636,7 +6636,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 @@ -7628,7 +7628,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 @@ -7913,9 +7913,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) @@ -9392,7 +9392,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 4b617dc1965..f5860214113 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 From 1429960f9891792e860fe6bc931ddbae97530c9b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 14 Mar 2024 13:42:47 +0100 Subject: [PATCH 02/14] mkFunTyWithNullness --- src/Compiler/TypedTree/TcGlobals.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 895a821fbb6..9f5f1d91239 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 From 664416c4e5474ce376e9fb09b0538621af36c665 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 18 Mar 2024 16:17:51 +0100 Subject: [PATCH 03/14] adding failing tests for fsharp types --- .../Language/NullableReferenceTypesTests.fs | 106 +++++++++++++++++- 1 file changed, 104 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 9dca34495c5..c0d0cfd158d 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -9,7 +9,7 @@ let typeCheckWithStrictNullness cu = |> withCheckNulls |> withWarnOn 3261 |> withOptions ["--warnaserror+"] - |> compile + |> typecheck [] @@ -183,4 +183,106 @@ let myFunction (input1 : string | null) (input2 : string | null): (string*string |> asLibrary |> typeCheckWithStrictNullness |> shouldFail - |> withErrorCode 3261 \ No newline at end of file + |> withErrorCode 3261 + +[] +let ``WithNull used on anon type`` () = + FSharp """module MyLibrary + +let strictFunc(arg: 'x when 'x : not null) = arg.ToString() +let looseFunc(arg: _ | null) = arg + +strictFunc({|ZZ=15;YZ="a"|}) |> ignore +looseFunc({|ZZ=15;YZ="a"|}) |> ignore + +let maybeAnon : _ | null = {|Hello="there"|} +let maybeAnon2 : _ | null = null + +strictFunc(maybeAnon) |> ignore +looseFunc(maybeAnon) |> ignore + +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + + +[] +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 + |> shouldSucceed + +[] +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 + |> shouldSucceed \ No newline at end of file From 5247050920354f46f203422068170f4807d85bee Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 20 Mar 2024 15:11:07 +0100 Subject: [PATCH 04/14] delayed checks of post-infered values for nullness-carrying capabilities --- src/Compiler/Checking/CheckExpressions.fs | 5 ++++ src/Compiler/Checking/ConstraintSolver.fs | 18 +++++++++++++ src/Compiler/Checking/ConstraintSolver.fsi | 2 ++ src/Compiler/xlf/FSStrings.cs.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.de.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.es.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.fr.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.it.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.ja.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.ko.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.pl.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.pt-BR.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.ru.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.tr.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.zh-Hans.xlf | 25 +++++++++++++++++++ src/Compiler/xlf/FSStrings.zh-Hant.xlf | 25 +++++++++++++++++++ .../Language/NullableReferenceTypesTests.fs | 23 ++++++----------- 17 files changed, 358 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 6a2fa281af4..f5f650af5ad 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -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 diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 72530a44de4..1e3dde449f8 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2614,6 +2614,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 @@ -3876,6 +3888,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 371fa31e598..c8169051be4 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -267,6 +267,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/xlf/FSStrings.cs.xlf b/src/Compiler/xlf/FSStrings.cs.xlf index 6a3e83c532a..9d0a6111f0c 100644 --- a/src/Compiler/xlf/FSStrings.cs.xlf +++ b/src/Compiler/xlf/FSStrings.cs.xlf @@ -7,6 +7,26 @@ Názvy argumentů v signatuře {0} a implementaci {1} si neodpovídají. Použije se název argumentu ze souboru signatury. To může způsobit problémy při ladění nebo profilování. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Očekává se statický člen. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' symbol ..^ diff --git a/src/Compiler/xlf/FSStrings.de.xlf b/src/Compiler/xlf/FSStrings.de.xlf index 8777c4ab388..ca238a47c3e 100644 --- a/src/Compiler/xlf/FSStrings.de.xlf +++ b/src/Compiler/xlf/FSStrings.de.xlf @@ -7,6 +7,26 @@ Die Argumentnamen in Signatur "{0}" und Implementierung "{1}" stimmen nicht überein. Der Argumentname aus der Signaturdatei wird verwendet. Dadurch können Probleme beim Debuggen oder bei der Profilerstellung auftreten. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Ein statischer Member wird erwartet. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' Symbol "..^" diff --git a/src/Compiler/xlf/FSStrings.es.xlf b/src/Compiler/xlf/FSStrings.es.xlf index 6484fb847fb..5c95db8c1ce 100644 --- a/src/Compiler/xlf/FSStrings.es.xlf +++ b/src/Compiler/xlf/FSStrings.es.xlf @@ -7,6 +7,26 @@ Los nombres de argumento en la firma "{0}" y la implementación "{1}" no coinciden. Se utilizará el nombre del argumento desde el archivo de firma. Esto puede causar problemas durante la depuración o la generación de perfiles. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Se espera un miembro estático. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' símbolo "..^" diff --git a/src/Compiler/xlf/FSStrings.fr.xlf b/src/Compiler/xlf/FSStrings.fr.xlf index 3b15aaca563..56b8b1ea919 100644 --- a/src/Compiler/xlf/FSStrings.fr.xlf +++ b/src/Compiler/xlf/FSStrings.fr.xlf @@ -7,6 +7,26 @@ Les noms d'arguments dans la signature '{0}' et l'implémentation '{1}' ne correspondent pas. Le nom d'argument du fichier de signature va être utilisé. Cela peut entraîner des problèmes durant le débogage ou le profilage. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Un membre statique est attendu. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' symbole '..^' diff --git a/src/Compiler/xlf/FSStrings.it.xlf b/src/Compiler/xlf/FSStrings.it.xlf index 304025244e0..1b530f39425 100644 --- a/src/Compiler/xlf/FSStrings.it.xlf +++ b/src/Compiler/xlf/FSStrings.it.xlf @@ -7,6 +7,26 @@ I nomi degli argomenti nella firma '{0}' e nell'implementazione '{1}' non corrispondono. Verrà usato il nome dell'argomento del file di firma. Questa situazione potrebbe causare problemi durante il debug o la profilatura. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ È previsto un membro statico. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' simbolo '..^' diff --git a/src/Compiler/xlf/FSStrings.ja.xlf b/src/Compiler/xlf/FSStrings.ja.xlf index 31ba40fcb3d..0f89ac43fa5 100644 --- a/src/Compiler/xlf/FSStrings.ja.xlf +++ b/src/Compiler/xlf/FSStrings.ja.xlf @@ -7,6 +7,26 @@ シグネチャ '{0}' と実装 '{1}' の引数の名前が一致しません。シグネチャ ファイルの引数の名前が使用されます。デバッグまたはプロファイルするときに問題が生じる原因となる可能性があります。 + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ 静的メンバーが必要です。 + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' シンボル '..^' diff --git a/src/Compiler/xlf/FSStrings.ko.xlf b/src/Compiler/xlf/FSStrings.ko.xlf index f0bbe7c8aae..e1e5a08529f 100644 --- a/src/Compiler/xlf/FSStrings.ko.xlf +++ b/src/Compiler/xlf/FSStrings.ko.xlf @@ -7,6 +7,26 @@ 시그니처 '{0}'과(와) 구현 '{1}'의 인수 이름이 일치하지 않습니다. 시그니처 파일의 인수 이름이 사용됩니다. 이로 인해 디버깅 또는 프로파일링 시 문제가 발생할 수 있습니다. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ 정적 멤버가 필요합니다. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' 기호 '..^' diff --git a/src/Compiler/xlf/FSStrings.pl.xlf b/src/Compiler/xlf/FSStrings.pl.xlf index 3020002ce7c..f91277e1675 100644 --- a/src/Compiler/xlf/FSStrings.pl.xlf +++ b/src/Compiler/xlf/FSStrings.pl.xlf @@ -7,6 +7,26 @@ Nazwy argumentów w podpisie „{0}” i implementacji „{1}” nie są zgodne. Używana będzie nazwa argumentu z pliku podpisu. Może to spowodować problemy podczas debugowania lub profilowania. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Oczekiwano statycznego elementu członkowskiego. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' symbol „..^” diff --git a/src/Compiler/xlf/FSStrings.pt-BR.xlf b/src/Compiler/xlf/FSStrings.pt-BR.xlf index b5647b8d0eb..71699f1201d 100644 --- a/src/Compiler/xlf/FSStrings.pt-BR.xlf +++ b/src/Compiler/xlf/FSStrings.pt-BR.xlf @@ -7,6 +7,26 @@ Os nomes de argumento na assinatura '{0}' e na implementação '{1}' não coincidem. O nome do argumento do arquivo da assinatura será usado. Isso pode causar problemas durante a depuração ou a criação de perfil. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ O membro estático é esperado. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' símbolo '..^' diff --git a/src/Compiler/xlf/FSStrings.ru.xlf b/src/Compiler/xlf/FSStrings.ru.xlf index b47eb92bdc3..f62266849f4 100644 --- a/src/Compiler/xlf/FSStrings.ru.xlf +++ b/src/Compiler/xlf/FSStrings.ru.xlf @@ -7,6 +7,26 @@ Имена аргументов в сигнатуре "{0}" и реализации "{1}" не совпадают. Будет использоваться имя аргумента из файла сигнатуры. Это может вызвать проблемы при отладке или профилировании. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Ожидается статический элемент. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' символ "..^" diff --git a/src/Compiler/xlf/FSStrings.tr.xlf b/src/Compiler/xlf/FSStrings.tr.xlf index 2fc08de7f13..418144052a7 100644 --- a/src/Compiler/xlf/FSStrings.tr.xlf +++ b/src/Compiler/xlf/FSStrings.tr.xlf @@ -7,6 +7,26 @@ {0}' imzası ve '{1}' uygulaması içindeki bağımsız değişken adları eşleşmiyor. İmza dosyasındaki bağımsız değişken adı kullanılacak. Bu, hata ayıklama veya profil oluşturma sırasında sorunlara neden olabilir. + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ Statik üye bekleniyor. + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' '..^' sembolü diff --git a/src/Compiler/xlf/FSStrings.zh-Hans.xlf b/src/Compiler/xlf/FSStrings.zh-Hans.xlf index f81bb2b61c7..0707623646c 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hans.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hans.xlf @@ -7,6 +7,26 @@ 签名“{0}”和实现“{1}”中的参数名称不匹配。将使用签名文件中的参数名称。在进行调试或分析时这可能会导致问题。 + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ 应为静态成员。 + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' 符号 "..^" diff --git a/src/Compiler/xlf/FSStrings.zh-Hant.xlf b/src/Compiler/xlf/FSStrings.zh-Hant.xlf index d0de30dc7ff..a99363aade0 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hant.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hant.xlf @@ -7,6 +7,26 @@ 特徵標記 '{0}' 和實作 '{1}' 中的引數名稱不相符。將會使用特徵標記檔案中的引數名稱。這可能會在偵錯或分析時造成問題。 + + Nullness warning: {0}. + Nullness warning: {0}. + + + + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability. + + + + Nullness warning: The type '{0}' does not support 'null'. + Nullness warning: The type '{0}' does not support 'null'. + + + + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. + + 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} @@ -37,6 +57,11 @@ 必須是靜態成員。 + + symbol '|' (directly before 'null') + symbol '|' (directly before 'null') + + symbol '..^' 符號 '..^' diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index c0d0cfd158d..1c2c8f19d5e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -189,22 +189,13 @@ let myFunction (input1 : string | null) (input2 : string | null): (string*string let ``WithNull used on anon type`` () = FSharp """module MyLibrary -let strictFunc(arg: 'x when 'x : not null) = arg.ToString() -let looseFunc(arg: _ | null) = arg - -strictFunc({|ZZ=15;YZ="a"|}) |> ignore -looseFunc({|ZZ=15;YZ="a"|}) |> ignore - -let maybeAnon : _ | null = {|Hello="there"|} -let maybeAnon2 : _ | null = null - -strictFunc(maybeAnon) |> ignore -looseFunc(maybeAnon) |> ignore - +//let maybeAnon : _ | null = {|Hello="there"|} +let maybeAnon2 : {|Hello:string|} | null = null """ |> asLibrary |> typeCheckWithStrictNullness - |> shouldSucceed + |> shouldFail + |> withDiagnostics [] [] @@ -234,7 +225,8 @@ looseFunc(maybeDu2) |> ignore """ |> asLibrary |> typeCheckWithStrictNullness - |> shouldSucceed + |> shouldFail + |> withDiagnostics [] [] let ``Nullnesss support for F# types`` () = @@ -285,4 +277,5 @@ looseFunc(maybeTuple2) |> ignore """ |> asLibrary |> typeCheckWithStrictNullness - |> shouldSucceed \ No newline at end of file + |> shouldFail + |> withDiagnostics [] \ No newline at end of file From e4c0bfde7713c0cc24357f32aee033ad83ebf6b0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 20 Mar 2024 19:31:23 +0100 Subject: [PATCH 05/14] more tests --- .../Language/NullableReferenceTypesTests.fs | 119 +++++++++++++++++- 1 file changed, 117 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 1c2c8f19d5e..2aed3cd52e7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -189,7 +189,7 @@ let myFunction (input1 : string | null) (input2 : string | null): (string*string let ``WithNull used on anon type`` () = FSharp """module MyLibrary -//let maybeAnon : _ | null = {|Hello="there"|} +let maybeAnon : _ | null = {|Hello="there"|} let maybeAnon2 : {|Hello:string|} | null = null """ |> asLibrary @@ -278,4 +278,119 @@ looseFunc(maybeTuple2) |> ignore |> asLibrary |> typeCheckWithStrictNullness |> shouldFail - |> withDiagnostics [] \ No newline at end of file + |> withDiagnostics [] + + +[] +let ``Static member on Record with null arg`` () = + FSharp """module MyLibrary +type MyRecord = {X:string;Y:int} + with static member Create(x:string) = {X=x;Y = 42} +let thisWorks = MyRecord.Create("xx") +let thisShouldWarn = MyRecord.Create(null) +let maybeNull : string | null = "abc" +let thisShouldAlsoWarn = MyRecord.Create(maybeNull) +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [Error 3261, Line 7, Col 38, Line 7, Col 42, "Nullness warning: The type 'string' does not support 'null'." + Error 3261, Line 9, Col 42, Line 9, Col 51, "Nullness warning: The types 'string' and 'string | null' do not have equivalent nullability."] + + +[] +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 + |> shouldSucceed + +[] +let ``Option ofObj should remove nullness when piping`` () = + FSharp """module MyLibrary +let processOpt (s: string | null) : string option = + let stringOpt = Option.ofObj s + stringOpt +let processOpt3 (s: string | null) : string option = s |> Option.ofObj +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +let ``Option ofObj called in a useless way raises warning`` () = + FSharp """module MyLibrary +let processOpt1 (s: string) = Option.ofObj s +let processOpt2 (s: string) : option = + Option.ofObj s +let processOpt3 (s: string) : string option = + let sOpt = Option.ofObj s + sOpt +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3262, Line 3, Col 44, Line 3, Col 45, "Value known to be without null passed to a function meant for nullables: You can create 'Some value' directly instead of 'ofObj', or consider not using an option for this value." + Error 3262, Line 5, Col 18, Line 5, Col 19, "Value known to be without null passed to a function meant for nullables: You can create 'Some value' directly instead of 'ofObj', or consider not using an option for this value." + Error 3262, Line 7, Col 29, Line 7, Col 30, "Value known to be without null passed to a function meant for nullables: You can create 'Some value' directly instead of 'ofObj', or consider not using an option for this value."] + + +[] +let ``Option ofObj called on a string literal`` () = + FSharp """module MyLibrary +let whatIsThis = Option.ofObj "abc123" +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withErrorCodes [3262] + +[] +let ``Useless null pattern match`` () = + FSharp """module MyLibrary +let clearlyNotNull = "42" +let mappedVal = + match clearlyNotNull with + | null -> 42 + | _ -> 43 +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics [Error 3261, Line 6, Col 7, Line 6, Col 11, "Nullness warning: The type 'string' does not support 'null'."] + +[] +let ``Useless usage of nonNull utility from fscore`` () = + FSharp """module MyLibrary +let clearlyNotNull = "42" +let mappedVal = nonNull clearlyNotNull +let maybeNull : string | null = null +let mappedMaybe = nonNull maybeNull +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics [Error 3262, Line 4, Col 25, Line 4, Col 39, "Value known to be without null passed to a function meant for nullables: You can remove this `nonNull` assertion."] + +[] +let ``Useless usage of null active patterns from fscore`` () = + FSharp """module MyLibrary +let clearlyNotNull = "42" +let mapped1 = + match clearlyNotNull with + | NonNullQuick safe -> safe +let mapped2 = + match clearlyNotNull with + |Null -> 0 + |NonNull _ -> 1 +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> 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 From 4827b98791784a0b0c13ecbb634db38a027a507f Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 22 Mar 2024 14:42:54 +0100 Subject: [PATCH 06/14] fix xliffs --- src/Compiler/xlf/FSStrings.cs.xlf | 5 ----- src/Compiler/xlf/FSStrings.de.xlf | 7 +------ src/Compiler/xlf/FSStrings.es.xlf | 5 ----- src/Compiler/xlf/FSStrings.fr.xlf | 5 ----- src/Compiler/xlf/FSStrings.it.xlf | 5 ----- src/Compiler/xlf/FSStrings.ja.xlf | 5 ----- src/Compiler/xlf/FSStrings.ko.xlf | 5 ----- src/Compiler/xlf/FSStrings.pl.xlf | 5 ----- src/Compiler/xlf/FSStrings.pt-BR.xlf | 5 ----- src/Compiler/xlf/FSStrings.ru.xlf | 5 ----- src/Compiler/xlf/FSStrings.tr.xlf | 5 ----- src/Compiler/xlf/FSStrings.zh-Hans.xlf | 5 ----- src/Compiler/xlf/FSStrings.zh-Hant.xlf | 5 ----- 13 files changed, 1 insertion(+), 66 deletions(-) diff --git a/src/Compiler/xlf/FSStrings.cs.xlf b/src/Compiler/xlf/FSStrings.cs.xlf index b00f06f2a6c..bdaa68e4447 100644 --- a/src/Compiler/xlf/FSStrings.cs.xlf +++ b/src/Compiler/xlf/FSStrings.cs.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Neshoda typů Očekává se řazená kolekce členů o délce {0} typu\n {1} \nale odevzdala se řazená kolekce členů o délce {2} typu\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.de.xlf b/src/Compiler/xlf/FSStrings.de.xlf index 382ceeba77e..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}. @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Typenkonflikt. Es wurde ein Tupel der Länge {0} des Typs\n {1} \nerwartet, aber ein Tupel der Länge {2} des Typs\n {3}{4}\n angegeben. diff --git a/src/Compiler/xlf/FSStrings.es.xlf b/src/Compiler/xlf/FSStrings.es.xlf index 0de077b722c..c959faa16a0 100644 --- a/src/Compiler/xlf/FSStrings.es.xlf +++ b/src/Compiler/xlf/FSStrings.es.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Error de coincidencia de tipos. Se espera una tupla de longitud {0} de tipo\n {1} \nperero se ha proporcionado una tupla de longitud {2} de tipo\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.fr.xlf b/src/Compiler/xlf/FSStrings.fr.xlf index fe9fb073e71..2291e1b8663 100644 --- a/src/Compiler/xlf/FSStrings.fr.xlf +++ b/src/Compiler/xlf/FSStrings.fr.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Incompatibilité de type. Tuple de longueur attendu {0} de type\n {1} \nmais tuple de longueur {2} de type\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.it.xlf b/src/Compiler/xlf/FSStrings.it.xlf index 4f2ad100fbb..4039607d97d 100644 --- a/src/Compiler/xlf/FSStrings.it.xlf +++ b/src/Compiler/xlf/FSStrings.it.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Tipo non corrispondente. È prevista una tupla di lunghezza {0} di tipo\n {1} \n, ma è stata specificata una tupla di lunghezza {2} di tipo\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.ja.xlf b/src/Compiler/xlf/FSStrings.ja.xlf index 381fc69aa55..639885ed89e 100644 --- a/src/Compiler/xlf/FSStrings.ja.xlf +++ b/src/Compiler/xlf/FSStrings.ja.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n 型が一致しません。型の長さ {0} のタプルが必要です\n {1} \nただし、型の長さ {2} のタプルが指定された場合\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.ko.xlf b/src/Compiler/xlf/FSStrings.ko.xlf index 0b8d143fa17..f449634f49f 100644 --- a/src/Compiler/xlf/FSStrings.ko.xlf +++ b/src/Compiler/xlf/FSStrings.ko.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n 유형 불일치. 형식이 \n {1}이고 길이가 {0}인 튜플이 필요합니다. \n그러나 형식이 \n {3}이고 길이가 {2}인 튜플이 제공되었습니다.{4}\n diff --git a/src/Compiler/xlf/FSStrings.pl.xlf b/src/Compiler/xlf/FSStrings.pl.xlf index bf2362a2e1b..ed9cfaa49b9 100644 --- a/src/Compiler/xlf/FSStrings.pl.xlf +++ b/src/Compiler/xlf/FSStrings.pl.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Niezgodność. Oczekiwano krotki o długości {0} typu\n {1} \nale otrzymano krotkę o długości {2} typu\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.pt-BR.xlf b/src/Compiler/xlf/FSStrings.pt-BR.xlf index a52ded8a22d..0a9c5127b6f 100644 --- a/src/Compiler/xlf/FSStrings.pt-BR.xlf +++ b/src/Compiler/xlf/FSStrings.pt-BR.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Tipo incompatível. Esperando uma tupla de comprimento {0} do tipo\n {1} \nmas recebeu uma tupla de comprimento {2} do tipo\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.ru.xlf b/src/Compiler/xlf/FSStrings.ru.xlf index c12ee893b2c..2d0d0fe75c7 100644 --- a/src/Compiler/xlf/FSStrings.ru.xlf +++ b/src/Compiler/xlf/FSStrings.ru.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Несоответствие типов. Ожидается кортеж длиной {0} типа\n {1}, \nно предоставлен кортеж длиной {2} типа\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.tr.xlf b/src/Compiler/xlf/FSStrings.tr.xlf index 464a295eb95..6044f1c9827 100644 --- a/src/Compiler/xlf/FSStrings.tr.xlf +++ b/src/Compiler/xlf/FSStrings.tr.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n Tür uyuşmazlığı. {0} uzunluğunda türü\n {1} \nolan bir demet bekleniyordu ancak {2} uzunluğunda türü\n {3}{4}\nolan bir demet verildi diff --git a/src/Compiler/xlf/FSStrings.zh-Hans.xlf b/src/Compiler/xlf/FSStrings.zh-Hans.xlf index 547100feaef..c237edfd050 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hans.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hans.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n 类型不匹配。应为长度为 {0} 的类型的元组\n {1} \n但提供了长度为 {2} 的类型的元组\n {3}{4}\n diff --git a/src/Compiler/xlf/FSStrings.zh-Hant.xlf b/src/Compiler/xlf/FSStrings.zh-Hant.xlf index 3da2c9103aa..9533bfe8c0d 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hant.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hant.xlf @@ -32,11 +32,6 @@ Nullness warning: The types '{0}' and '{1}' do not have compatible nullability. - - 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} - - Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n 類型不符。必須是類型為\n {1} \n 的元組長度 {0}，但提供的是類型為\n {3}{4}\n 的元組長度 {2} From cc102b4f730a01353a391975a19ca887e23e0804 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 25 Mar 2024 15:05:03 +0100 Subject: [PATCH 07/14] Regression on passing null literal - to be fixed --- .../Language/NullableReferenceTypesTests.fs | 47 +++++++++++++++++-- 1 file changed, 42 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 2aed3cd52e7..407258d9994 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -195,12 +195,15 @@ let maybeAnon2 : {|Hello:string|} | null = null |> asLibrary |> typeCheckWithStrictNullness |> shouldFail - |> withDiagnostics [] + |> 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 @@ -226,7 +229,30 @@ looseFunc(maybeDu2) |> ignore |> asLibrary |> typeCheckWithStrictNullness |> shouldFail - |> withDiagnostics [] + |> 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 "%A" arg + arg + +strictFunc({|Anon=5|}) |> ignore +strictFunc("hi") |> ignore +strictFunc(null) |> ignore +strictFunc(null:(string|null)) |> ignore +strictFunc(null:obj) |> ignore + + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ ] + [] let ``Nullnesss support for F# types`` () = @@ -278,14 +304,20 @@ looseFunc(maybeTuple2) |> ignore |> asLibrary |> typeCheckWithStrictNullness |> shouldFail - |> withDiagnostics [] - - + |> 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 + type MyRecord = {X:string;Y:int} with static member Create(x:string) = {X=x;Y = 42} + let thisWorks = MyRecord.Create("xx") let thisShouldWarn = MyRecord.Create(null) let maybeNull : string | null = "abc" @@ -322,6 +354,7 @@ let processOpt3 (s: string | null) : string option = s |> Option.ofObj [] let ``Option ofObj called in a useless way raises warning`` () = FSharp """module MyLibrary + let processOpt1 (s: string) = Option.ofObj s let processOpt2 (s: string) : option = Option.ofObj s @@ -351,6 +384,7 @@ let whatIsThis = Option.ofObj "abc123" [] let ``Useless null pattern match`` () = FSharp """module MyLibrary + let clearlyNotNull = "42" let mappedVal = match clearlyNotNull with @@ -365,6 +399,7 @@ let mappedVal = [] let ``Useless usage of nonNull utility from fscore`` () = FSharp """module MyLibrary + let clearlyNotNull = "42" let mappedVal = nonNull clearlyNotNull let maybeNull : string | null = null @@ -378,10 +413,12 @@ let mappedMaybe = nonNull maybeNull [] let ``Useless usage of null active patterns from fscore`` () = FSharp """module MyLibrary + let clearlyNotNull = "42" let mapped1 = match clearlyNotNull with | NonNullQuick safe -> safe + let mapped2 = match clearlyNotNull with |Null -> 0 From bd62198229fa8d9941342e7c89d0ffa2d12aa29a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 26 Mar 2024 10:38:03 +0100 Subject: [PATCH 08/14] regression with obj - captured as a test --- .../Language/NullableReferenceTypesTests.fs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 407258d9994..2d2626aabbc 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -236,9 +236,7 @@ looseFunc(maybeDu2) |> ignore [] let ``Regression strict func`` () = FSharp """module MyLibrary -let strictFunc(arg: 'x when 'x : not null) = - printfn "%A" arg - arg +let strictFunc(arg: 'x when 'x : not null) = printfn "%s" (arg.ToString()) strictFunc({|Anon=5|}) |> ignore strictFunc("hi") |> ignore @@ -251,7 +249,7 @@ strictFunc(null:obj) |> ignore |> 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." ] [] From f0b4c38e2d3b0bb4a65c7567cb2e568c37a4e8db Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 26 Mar 2024 10:44:58 +0100 Subject: [PATCH 09/14] autowiden tests change from preview to 8 --- .../Miscellaneous/MigratedCoreTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 From bc974da739e3594b2f5aa34f949c955f268f909e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 26 Mar 2024 14:06:02 +0100 Subject: [PATCH 10/14] invetigate CI test failures --- .../Language/NullableReferenceTypesTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 2d2626aabbc..5e02d948c6b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -9,7 +9,7 @@ let typeCheckWithStrictNullness cu = |> withCheckNulls |> withWarnOn 3261 |> withOptions ["--warnaserror+"] - |> typecheck + |> compile [] From 0a5b298860f751c51049ee743bcb6cebee395743 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 26 Mar 2024 20:30:54 +0100 Subject: [PATCH 11/14] warnon 3262 --- .../Language/NullableReferenceTypesTests.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 5e02d948c6b..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 From a22b56047b9cbc596404b6eac059cddfe9393c52 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 28 Mar 2024 10:49:11 +0100 Subject: [PATCH 12/14] null handling for obj type --- .../Checking/AugmentWithHashCompare.fs | 32 +++++++------- src/Compiler/Checking/CheckDeclarations.fs | 6 +-- src/Compiler/Checking/CheckExpressions.fs | 16 +++---- src/Compiler/Checking/ConstraintSolver.fs | 19 +++----- src/Compiler/Checking/MethodCalls.fs | 6 +-- src/Compiler/Checking/MethodOverrides.fs | 4 +- src/Compiler/Checking/NameResolution.fs | 2 +- src/Compiler/Checking/QuotationTranslator.fs | 2 +- src/Compiler/Checking/TypeHierarchy.fs | 10 ++--- src/Compiler/Checking/TypeRelations.fs | 4 +- src/Compiler/CodeGen/IlxGen.fs | 4 +- .../Optimize/LowerComputedCollections.fs | 2 +- src/Compiler/Optimize/Optimizer.fs | 6 +-- src/Compiler/Service/FSharpCheckerResults.fs | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 20 +++++---- src/Compiler/TypedTree/TypedTreeOps.fs | 6 +-- .../Nullness/AnonRecords.fs.il.net472.bsl | 8 ++++ .../Language/NullableReferenceTypesTests.fs | 44 ++++++++++++++++--- 18 files changed, 114 insertions(+), 79 deletions(-) diff --git a/src/Compiler/Checking/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index cfaece0bfb4..ec37f2c4ee1 100644 --- a/src/Compiler/Checking/AugmentWithHashCompare.fs +++ b/src/Compiler/Checking/AugmentWithHashCompare.fs @@ -15,7 +15,7 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy let mkIComparableCompareToSlotSig (g: TcGlobals) = - TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty, false, false, false, []) ] ], Some g.int_ty) + TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty_withNulls, false, false, false, []) ] ], Some g.int_ty) let mkGenericIComparableCompareToSlotSig (g: TcGlobals) ty = TSlotSig( @@ -35,7 +35,7 @@ let mkIStructuralComparableCompareToSlotSig (g: TcGlobals) = [], [ [ - TSlotParam(None, (mkRefTupledTy g [ g.obj_ty; g.IComparer_ty ]), false, false, false, []) + TSlotParam(None, (mkRefTupledTy g [ g.obj_ty_withNulls; g.IComparer_ty ]), false, false, false, []) ] ], Some g.int_ty @@ -59,7 +59,7 @@ let mkIStructuralEquatableEqualsSlotSig (g: TcGlobals) = [], [ [ - TSlotParam(None, (mkRefTupledTy g [ g.obj_ty; g.IEqualityComparer_ty ]), false, false, false, []) + TSlotParam(None, (mkRefTupledTy g [ g.obj_ty_withNulls; g.IEqualityComparer_ty ]), false, false, false, []) ] ], Some g.bool_ty @@ -76,10 +76,10 @@ let mkIStructuralEquatableGetHashCodeSlotSig (g: TcGlobals) = ) let mkGetHashCodeSlotSig (g: TcGlobals) = - TSlotSig("GetHashCode", g.obj_ty, [], [], [ [] ], Some g.int_ty) + TSlotSig("GetHashCode", g.obj_ty_noNulls, [], [], [ [] ], Some g.int_ty) let mkEqualsSlotSig (g: TcGlobals) = - TSlotSig("Equals", g.obj_ty, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty, false, false, false, []) ] ], Some g.bool_ty) + TSlotSig("Equals", g.obj_ty_noNulls, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty_withNulls, false, false, false, []) ] ], Some g.bool_ty) //------------------------------------------------------------------------- // Helpers associated with code-generation of comparison/hash augmentations @@ -89,22 +89,22 @@ let mkThisTy g ty = if isStructTy g ty then mkByrefTy g ty else ty let mkCompareObjTy g ty = - mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty g.int_ty) + mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty_withNulls g.int_ty) let mkCompareTy g ty = mkFunTy g (mkThisTy g ty) (mkFunTy g ty g.int_ty) let mkCompareWithComparerTy g ty = - mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty; g.IComparer_ty ]) g.int_ty) + mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty_withNulls; g.IComparer_ty ]) g.int_ty) let mkEqualsObjTy g ty = - mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty g.bool_ty) + mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty_withNulls g.bool_ty) let mkEqualsTy g ty = mkFunTy g (mkThisTy g ty) (mkFunTy g ty g.bool_ty) let mkEqualsWithComparerTy g ty = - mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty; g.IEqualityComparer_ty ]) g.bool_ty) + mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty_withNulls; g.IEqualityComparer_ty ]) g.bool_ty) let mkHashTy g ty = mkFunTy g (mkThisTy g ty) (mkFunTy g g.unit_ty g.int_ty) @@ -1096,7 +1096,7 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = hasNominalInterface g.system_GenericIComparable_tcref let hasExplicitEquals = - tycon.HasOverride g "Equals" [ g.obj_ty ] + tycon.HasOverride g "Equals" [ g.obj_ty_ambivalent ] || hasNominalInterface g.tcref_System_IStructuralEquatable let hasExplicitGenericEquals = hasNominalInterface g.system_GenericIEquatable_tcref @@ -1351,13 +1351,13 @@ let MakeBindingsForCompareAugmentation g (tycon: Tycon) = let tinst, ty = mkMinimalTy g tcref let thisv, thise = mkThisVar g m ty - let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent let comparee = if isUnitTy g ty then mkZero g m else - let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty) + let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty_ambivalent) mkApps g ((exprForValRef m vref2, vref2.Type), (if isNil tinst then [] else [ tinst ]), [ thise; thate ], m) @@ -1394,8 +1394,8 @@ let MakeBindingsForCompareWithComparerAugmentation g (tycon: Tycon) = let compv, compe = mkCompGenLocal m "comp" g.IComparer_ty let thisv, thise = mkThisVar g m ty - let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty - let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty) + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent + let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty_ambivalent) let rhs = let comparee = comparef g tcref tycon (thisv, thise) (thatobjv, thate) compe @@ -1453,7 +1453,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon let withcEqualsExpr = let _tinst, ty = mkMinimalTy g tcref let thisv, thise = mkThisVar g m ty - let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent let thatv, thate = mkCompGenLocal m "that" ty let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty let equalse = equalsf g tcref tycon (thisv, thise) thatobje (thatv, thate) compe @@ -1515,7 +1515,7 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = let tinst, ty = mkMinimalTy g tcref let thisv, thise = mkThisVar g m ty - let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent let equalse = if isUnitTy g ty then diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 504a574b0cc..66d3ae49214 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -860,7 +860,7 @@ module AddAugmentationDeclarations = let m = tycon.Range // Note: tycon.HasOverride only gives correct results after we've done the type augmentation - let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty] + let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty_ambivalent] let hasExplicitGenericIEquatable = tcaugHasNominalInterface g tcaug g.system_GenericIEquatable_tcref if hasExplicitGenericIEquatable then @@ -1610,7 +1610,7 @@ module MutRecBindingChecking = if tcref.IsStructOrEnumTycon then Some (incrCtorInfo, mkUnit g tcref.Range, false), defnCs else - let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty None true (SynExpr.Const (SynConst.Unit, tcref.Range)) tcref.Range + let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty_noNulls None true (SynExpr.Const (SynConst.Unit, tcref.Range)) tcref.Range // If there is no 'inherits' and no simple non-static 'let' of a non-method then add a debug point at the entry to the constructor over the type name itself. let addDebugPointAtImplicitCtorArguments = @@ -3313,7 +3313,7 @@ module EstablishTypeDefinitionCores = if isTyparTy g ty then if firstPass then errorR(Error(FSComp.SR.tcCannotInheritFromVariableType(), m)) - Some g.obj_ty // a "super" that is a variable type causes grief later + Some g.obj_ty_noNulls // a "super" that is a variable type causes grief later else Some ty | _ -> diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 00137c9bd86..38114dfe99a 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -3106,7 +3106,7 @@ let BuildDisposableCleanup (cenv: cenv) env m (v: Val) = else let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None - let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) + let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty_ambivalent, m, v.Type) mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m) /// Build call to get_OffsetToStringData as part of 'fixed' @@ -3346,7 +3346,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr // e.g. MatchCollection typeEquiv g g.int32_ty ty || // e.g. EnvDTE.Documents.Item - typeEquiv g g.obj_ty ty + typeEquiv g g.obj_ty_ambivalent ty | _ -> false match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env m ad "get_Item" tyToSearchForGetEnumeratorAndItem with @@ -4462,7 +4462,7 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn match synTy with | SynType.LongIdent(SynLongIdent([], _, _)) -> // special case when type name is absent - i.e. empty inherit part in type declaration - g.obj_ty, tpenv + g.obj_ty_ambivalent, tpenv | SynType.LongIdent synLongId -> TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId @@ -5096,7 +5096,7 @@ and TcTypeOrMeasureAndRecover kindOpt (cenv: cenv) newOk checkConstraints occ iw match kindOpt, newOk with | Some TyparKind.Measure, NoNewTypars -> TType_measure Measure.One | Some TyparKind.Measure, _ -> TType_measure (NewErrorMeasure ()) - | _, NoNewTypars -> g.obj_ty + | _, NoNewTypars -> g.obj_ty_ambivalent | _ -> NewErrorType () recoveryTy, tpenv @@ -7482,7 +7482,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m) - let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m) + let argsExpr = mkArray (g.obj_ty_withNulls, fillExprsBoxed, m) let percentATysExpr = if percentATys.Length = 0 then mkNull m (mkArrayType g g.system_Type_ty) @@ -7509,7 +7509,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m) let dotnetFormatStringExpr = mkString g m dotnetFormatString - let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m) + let argsExpr = mkArray (g.obj_ty_withNulls, fillExprsBoxed, m) // FormattableString are *always* turned into FormattableStringFactory.Create calls, boxing each argument let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] [] None @@ -9540,7 +9540,7 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de] None mkLambda mItem dv (callExpr, g.unit_ty)) - (let fvty = mkFunTy g g.obj_ty (mkFunTy g argsTy g.unit_ty) + (let fvty = mkFunTy g g.obj_ty_withNulls (mkFunTy g argsTy g.unit_ty) let fv, fe = mkCompGenLocal mItem "callback" fvty let createExpr = BuildNewDelegateExpr (Some einfo, g, cenv.amap, delTy, delInvokeMeth, delArgTys, fe, fvty, mItem) mkLambda mItem fv (createExpr, delTy))) @@ -9926,7 +9926,7 @@ and TcAdhocChecksOnLibraryMethods (cenv: cenv) (env: TcEnv) isInstance (finalCal if (isInstance && finalCalledMethInfo.IsInstance && - typeEquiv g finalCalledMethInfo.ApparentEnclosingType g.obj_ty && + typeEquiv g finalCalledMethInfo.ApparentEnclosingType g.obj_ty_ambivalent && (finalCalledMethInfo.LogicalName = "GetHashCode" || finalCalledMethInfo.LogicalName = "Equals")) then for objArg in objArgs do diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index c3903d1b75c..306af7cbafe 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1050,12 +1050,8 @@ and SolveNullnessEquiv (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty // TODO NULLNESS: this is not sound in contravariant cases etc. It is assuming covariance. | NullnessInfo.WithNull, NullnessInfo.WithoutNull -> CompleteD | _ -> - // NOTE: we never give nullness warnings for the 'obj' type if csenv.g.checkNullness then - if not (isObjTy csenv.g ty1) || not (isObjTy csenv.g ty2) then - WarnD(ConstraintSolverNullnessWarningEquivWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) - else - CompleteD + WarnD(ConstraintSolverNullnessWarningEquivWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) else CompleteD @@ -1088,11 +1084,8 @@ and SolveNullnessSubsumesNullness (csenv: ConstraintSolverEnv) m2 (trace: Option | NullnessInfo.WithNull, NullnessInfo.WithoutNull -> CompleteD | NullnessInfo.WithoutNull, NullnessInfo.WithNull -> - if csenv.g.checkNullness then - if not (isObjTy csenv.g ty1) || not (isObjTy csenv.g ty2) then - WarnD(ConstraintSolverNullnessWarningWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) - else - CompleteD + if csenv.g.checkNullness then + WarnD(ConstraintSolverNullnessWarningWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) else CompleteD @@ -2575,7 +2568,7 @@ and SolveNullnessSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: Opti | NullnessInfo.AmbivalentToNull -> () | NullnessInfo.WithNull -> () | NullnessInfo.WithoutNull -> - if g.checkNullness && not (isObjTy g ty) then + if g.checkNullness then return! WarnD(ConstraintSolverNullnessWarningWithType(denv, ty, n1, m, m2)) } @@ -2590,7 +2583,7 @@ and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty = // code via Option.ofObj and Option.toObj do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsTrueValue(NicePrint.minimalStringOfType denv ty), m, m2)) elif TypeNullIsExtraValueNew g m ty then - if g.checkNullness && not (isObjTy g ty) then + if g.checkNullness then let denv = { denv with showNullnessAnnotations = Some true } do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2)) else @@ -2618,7 +2611,7 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O | NullnessInfo.AmbivalentToNull -> () | NullnessInfo.WithoutNull -> () | NullnessInfo.WithNull -> - if g.checkNullness && TypeNullIsExtraValueNew g m ty && not (isObjTy g ty) then + if g.checkNullness && TypeNullIsExtraValueNew g m ty then let denv = { denv with showNullnessAnnotations = Some true } return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2)) } diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index cbe4a770d6f..6e56d794dfa 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1260,7 +1260,7 @@ let MethInfoChecks g amap isInstance tyargsOpt objArgs ad m (minfo: MethInfo) = /// Build a call to the System.Object constructor taking no arguments, let BuildObjCtorCall (g: TcGlobals) m = let ilMethRef = (mkILCtorMethSpecForTy(g.ilg.typ_Object, [])).MethodRef - Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m) + Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty_noNulls]), [], [], m) /// Implements the elaborated form of adhoc conversions from functions to delegates at member callsites let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, delInvokeMeth: MethInfo, delArgTys, delFuncExpr, delFuncTy, m) = @@ -1447,7 +1447,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C | Some tref -> let ty = mkILNonGenericBoxedTy tref let mref = mkILCtorMethSpecForTy(ty, [g.ilg.typ_Object]).MethodRef - let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) + let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty_noNulls]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) emptyPreBinder, expr | WrapperForIUnknown -> @@ -1456,7 +1456,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C | Some tref -> let ty = mkILNonGenericBoxedTy tref let mref = mkILCtorMethSpecForTy(ty, [g.ilg.typ_Object]).MethodRef - let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) + let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty_noNulls]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) emptyPreBinder, expr | PassByRef (ty, dfltVal2) -> diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 5abf08578fb..c58047383e1 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -897,7 +897,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv #endif Option.isNone tycon.GeneratedCompareToValues && tycon.HasInterface g g.mk_IComparable_ty && - not (tycon.HasOverride g "Equals" [g.obj_ty]) && + not (tycon.HasOverride g "Equals" [g.obj_ty_ambivalent]) && not tycon.IsFSharpInterfaceTycon then (* Warn when we're doing this for class types *) @@ -916,7 +916,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv let tcaug = tycon.TypeContents let m = tycon.Range let hasExplicitObjectGetHashCode = tycon.HasOverride g "GetHashCode" [] - let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty] + let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty_ambivalent] if (Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues) && (hasExplicitObjectGetHashCode || hasExplicitObjectEqualsOverride) then diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index f6ca36614a6..a751fbe8195 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4017,7 +4017,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = match item with | Item.RecdField info -> info.FieldType | Item.AnonRecdField (_, tys, index, _) -> tys[index] - | _ -> g.obj_ty + | _ -> g.obj_ty_ambivalent idsBeforeField, (fieldId, item) :: (nestedFieldSearch [] fieldTy rest) diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index 9c814c1da97..1ee9fb9fbd3 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -1223,7 +1223,7 @@ and ConvILType cenv env m ty = and TryElimErasableTyconRef cenv m (tcref: TyconRef) = match tcref.TypeReprInfo with // Get the base type - | TProvidedTypeRepr info when info.IsErased -> Some (info.BaseTypeForErased (m, cenv.g.obj_ty)) + | TProvidedTypeRepr info when info.IsErased -> Some (info.BaseTypeForErased (m, cenv.g.obj_ty_withNulls)) | _ -> None #endif diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index ea0d9e93970..1ab418c276a 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -68,7 +68,7 @@ let GetSuperTypeOfType g amap m ty = elif isArrayTy g ty then Some g.system_Array_ty elif isRefTy g ty && not (isObjTy g ty) then - Some g.obj_ty + Some g.obj_ty_noNulls elif isStructTupleTy g ty then Some g.system_Value_ty elif isFSharpStructOrEnumTy g ty then @@ -79,9 +79,9 @@ let GetSuperTypeOfType g amap m ty = elif isStructAnonRecdTy g ty then Some g.system_Value_ty elif isAnonRecdTy g ty then - Some g.obj_ty + Some g.obj_ty_noNulls elif isRecdTy g ty || isUnionTy g ty then - Some g.obj_ty + Some g.obj_ty_noNulls else None @@ -267,11 +267,11 @@ let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor List.foldBack (loop (ndeep+1)) (GetImmediateInterfacesOfType skipUnref g amap m ty) - (loop ndeep g.obj_ty state) + (loop ndeep g.obj_ty_noNulls state) else match tryDestTyparTy g ty with | ValueSome tp -> - let state = loop (ndeep+1) g.obj_ty state + let state = loop (ndeep+1) g.obj_ty_noNulls state List.foldBack (fun x vacc -> match x with diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index b04cfe488ce..16ed5e9f9d3 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -31,7 +31,7 @@ let rec TypeDefinitelySubsumesTypeNoCoercion ndeep g amap m ty1 ty2 = let ty1 = stripTyEqns g ty1 let ty2 = stripTyEqns g ty2 // F# reference types are subtypes of type 'obj' - (typeEquiv g ty1 g.obj_ty && isRefTy g ty2) || + (typeEquiv g ty1 g.obj_ty_ambivalent && isRefTy g ty2) || // Follow the supertype chain (isAppTy g ty2 && isRefTy g ty2 && @@ -138,7 +138,7 @@ let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) = let (maxTy, isRefined), m = let initialTy = match tp.Kind with - | TyparKind.Type -> g.obj_ty + | TyparKind.Type -> g.obj_ty_noNulls | TyparKind.Measure -> TType_measure Measure.One // Loop through the constraints computing the lub (((initialTy, false), m), tp.Constraints) ||> List.fold (fun ((maxTy, isRefined), _) tpc -> diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 56bb9b85ad5..a499a54d293 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -642,7 +642,7 @@ and GenNamedTyAppAux (cenv: cenv) m (tyenv: TypeReprEnv) ptrsOK tcref tinst = #if !NO_TYPEPROVIDERS match tcref.TypeReprInfo with // Generate the base type, because that is always the representation of the erased type, unless the assembly is being injected - | TProvidedTypeRepr info when info.IsErased -> GenTypeAux cenv m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased(m, g.obj_ty)) + | TProvidedTypeRepr info when info.IsErased -> GenTypeAux cenv m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased(m, g.obj_ty_withNulls)) | _ -> #endif GenTyAppAux cenv m tyenv (GenTyconRef tcref) tinst @@ -10802,7 +10802,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option Option.isNone tycon.GeneratedCompareToValues && Option.isNone tycon.GeneratedHashAndEqualsValues && tycon.HasInterface g g.mk_IComparable_ty - && not (tycon.HasOverride g "Equals" [ g.obj_ty ]) + && not (tycon.HasOverride g "Equals" [ g.obj_ty_ambivalent ]) && not tycon.IsFSharpInterfaceTycon then [ GenEqualsOverrideCallingIComparable cenv (tcref, ilThisTy, ilThisTy) ] diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index 18eafb2c6de..ab6877889ff 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -34,7 +34,7 @@ let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = else let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None - let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) + let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty_ambivalent, m, v.Type) mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m) let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 5af43b07801..43431340952 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -3228,7 +3228,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // the target takes a tupled argument, so we need to reorder the arg expressions in the // arg list, and create a tuple of y & comp // push the comparer to the end and box the argument - let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty, m, ty) ; comp]] + let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty_ambivalent, m, ty) ; comp]] Some (DevirtualizeApplication cenv env vref ty tyargs args2 m) | _ -> None @@ -3249,7 +3249,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [comp; x; y] -> // push the comparer to the end and box the argument - let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty, m, ty) ; comp]] + let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty_ambivalent, m, ty) ; comp]] Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) | _ -> None @@ -3258,7 +3258,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [x; y] -> - let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty, m, ty); (mkCallGetGenericPEREqualityComparer g m)]] + let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty_ambivalent, m, ty); (mkCallGetGenericPEREqualityComparer g m)]] Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) | _ -> None diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 46ea4bce4f5..8697f65897f 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -1060,7 +1060,7 @@ type internal TypeCheckInfo match r.Item with | Item.Types(_, ty :: _) when equals r.Range typeNameRange && isAppTy g ty -> let superTy = - (tcrefOfAppTy g ty).TypeContents.tcaug_super |> Option.defaultValue g.obj_ty + (tcrefOfAppTy g ty).TypeContents.tcaug_super |> Option.defaultValue g.obj_ty_noNulls let overriddenMethods = GetImmediateIntrinsicMethInfosOfType (None, ad) g amap typeNameRange ty diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index aa6671e96d2..7044e41471c 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -442,7 +442,9 @@ type TcGlobals( let v_enum_ty = mkNonGenericTy v_int_tcr let v_bool_ty = mkNonGenericTy v_bool_tcr let v_char_ty = mkNonGenericTy v_char_tcr - let v_obj_ty = mkNonGenericTy v_obj_tcr + let v_obj_ty_without_null = mkNonGenericTyWithNullness v_obj_tcr v_knownWithoutNull + let v_obj_ty_ambivalent = mkNonGenericTyWithNullness v_obj_tcr KnownAmbivalentToNull + let v_obj_ty_with_null = mkNonGenericTyWithNullness v_obj_tcr v_knownWithNull let v_IFormattable_tcref = findSysTyconRef sys "IFormattable" let v_FormattableString_tcref = findSysTyconRef sys "FormattableString" let v_IFormattable_ty = mkNonGenericTy v_IFormattable_tcref @@ -737,11 +739,11 @@ type TcGlobals( let v_generic_hash_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashWithComparerIntrinsic" , None , None , [vara], mk_hash_withc_sig varaTy) let v_create_instance_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CreateInstance" , None , None , [vara], ([[v_unit_ty]], varaTy)) - let v_unbox_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxGeneric" , None , None , [vara], ([[v_obj_ty]], varaTy)) + let v_unbox_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxGeneric" , None , None , [vara], ([[v_obj_ty_with_null]], varaTy)) - let v_unbox_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxFast" , None , None , [vara], ([[v_obj_ty]], varaTy)) - let v_istype_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestGeneric" , None , None , [vara], ([[v_obj_ty]], v_bool_ty)) - let v_istype_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestFast" , None , None , [vara], ([[v_obj_ty]], v_bool_ty)) + let v_unbox_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxFast" , None , None , [vara], ([[v_obj_ty_with_null]], varaTy)) + let v_istype_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestGeneric" , None , None , [vara], ([[v_obj_ty_with_null]], v_bool_ty)) + let v_istype_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestFast" , None , None , [vara], ([[v_obj_ty_with_null]], v_bool_ty)) let v_dispose_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "Dispose" , None , None , [vara], ([[varaTy]], v_unit_ty)) @@ -807,7 +809,7 @@ type TcGlobals( let v_enum_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "enum" , None , Some "ToEnum", [vara], ([[varaTy]], v_enum_ty)) let v_hash_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "hash" , None , Some "Hash" , [vara], ([[varaTy]], v_int_ty)) - let v_box_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "box" , None , Some "Box" , [vara], ([[varaTy]], v_obj_ty)) + let v_box_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "box" , None , Some "Box" , [vara], ([[varaTy]], v_obj_ty_with_null)) let v_isnull_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "isNull" , None , Some "IsNull" , [vara], ([[varaTy]], v_bool_ty)) let v_raise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "raise" , None , Some "Raise" , [vara], ([[mkSysNonGenericTy sys "Exception"]], varaTy)) let v_failwith_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "failwith" , None , Some "FailWith" , [vara], ([[v_string_ty]], varaTy)) @@ -863,7 +865,7 @@ type TcGlobals( let v_seq_finally_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateThenFinally" , None , None , [varb], ([[mkSeqTy varbTy]; [v_unit_ty --> v_unit_ty]], mkSeqTy varbTy)) let v_seq_trywith_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateTryWith" , None , None , [varb], ([[mkSeqTy varbTy]; [mkNonGenericTy v_exn_tcr --> v_int32_ty]; [mkNonGenericTy v_exn_tcr --> mkSeqTy varbTy]], mkSeqTy varbTy)) let v_seq_of_functions_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateFromFunctions" , None , None , [vara;varb], ([[v_unit_ty --> varaTy]; [varaTy --> v_bool_ty]; [varaTy --> varbTy]], mkSeqTy varbTy)) - let v_create_event_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "CreateEvent" , None , None , [vara;varb], ([[varaTy --> v_unit_ty]; [varaTy --> v_unit_ty]; [(v_obj_ty --> (varbTy --> v_unit_ty)) --> varaTy]], mkIEvent2Ty varaTy varbTy)) + let v_create_event_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "CreateEvent" , None , None , [vara;varb], ([[varaTy --> v_unit_ty]; [varaTy --> v_unit_ty]; [(v_obj_ty_with_null --> (varbTy --> v_unit_ty)) --> varaTy]], mkIEvent2Ty varaTy varbTy)) let v_cgh__useResumableCode_info = makeIntrinsicValRef(fslib_MFStateMachineHelpers_nleref, "__useResumableCode" , None , None , [vara], ([[]], v_bool_ty)) let v_cgh__debugPoint_info = makeIntrinsicValRef(fslib_MFStateMachineHelpers_nleref, "__debugPoint" , None , None , [vara], ([[v_int_ty]; [varaTy]], varaTy)) let v_cgh__resumeAt_info = makeIntrinsicValRef(fslib_MFStateMachineHelpers_nleref, "__resumeAt" , None , None , [vara], ([[v_int_ty]; [varaTy]], varaTy)) @@ -1364,7 +1366,9 @@ type TcGlobals( member _.system_FormattableString_ty = v_FormattableString_ty member _.system_FormattableStringFactory_ty = v_FormattableStringFactory_ty member _.unit_ty = v_unit_ty - member _.obj_ty = v_obj_ty + member _.obj_ty_noNulls = v_obj_ty_without_null + member _.obj_ty_ambivalent = v_obj_ty_ambivalent + member _.obj_ty_withNulls = v_obj_ty_with_null member _.char_ty = v_char_ty member _.decimal_ty = v_decimal_ty diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index dcd41add400..31be53f5ca7 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -720,7 +720,7 @@ let reduceTyconMeasureableOrProvided (g: TcGlobals) (tycon: Tycon) tyargs = | TMeasureableRepr ty -> if isNil tyargs then ty else instType (mkTyconInst tycon tyargs) ty #if !NO_TYPEPROVIDERS - | TProvidedTypeRepr info when info.IsErased -> info.BaseTypeForErased (range0, g.obj_ty) + | TProvidedTypeRepr info when info.IsErased -> info.BaseTypeForErased (range0, g.obj_ty_withNulls) #endif | _ -> invalidArg "tc" "this type definition is not a refinement" @@ -3427,7 +3427,7 @@ let trimPathByDisplayEnv denv path = let superOfTycon (g: TcGlobals) (tycon: Tycon) = match tycon.TypeContents.tcaug_super with - | None -> g.obj_ty + | None -> g.obj_ty_noNulls | Some ty -> ty /// walk a TyconRef's inheritance tree, yielding any parent types as an array @@ -6172,7 +6172,7 @@ and remapTyconRepr ctxt tmenv repr = | TProvidedTypeRepr info -> TProvidedTypeRepr { info with - LazyBaseType = info.LazyBaseType.Force (range0, ctxt.g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy + LazyBaseType = info.LazyBaseType.Force (range0, ctxt.g.obj_ty_withNulls) |> remapType tmenv |> LazyWithContext.NotLazy // The load context for the provided type contains TyconRef objects. We must remap these. // This is actually done on-demand (see the implementation of ProvidedTypeContext) ProvidedType = diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.net472.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.net472.bsl index ed1c23fb398..1ef3de3b967 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.net472.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.net472.bsl @@ -337,6 +337,8 @@ .method public hidebysig virtual final instance int32 CompareTo(object obj) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 8 IL_0000: ldarg.0 @@ -352,6 +354,8 @@ class [runtime]System.Collections.IComparer comp) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 5 .locals init (class '<>f__AnonymousType2430756162`3'j__TPar',!'j__TPar',!'j__TPar'> V_0, @@ -524,6 +528,8 @@ class [runtime]System.Collections.IEqualityComparer comp) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 5 .locals init (class '<>f__AnonymousType2430756162`3'j__TPar',!'j__TPar',!'j__TPar'> V_0, @@ -643,6 +649,8 @@ .method public hidebysig virtual final instance bool Equals(object obj) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 4 .locals init (class '<>f__AnonymousType2430756162`3'j__TPar',!'j__TPar',!'j__TPar'> V_0) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 1227fc44f47..fd601cb05cd 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -235,23 +235,53 @@ looseFunc(maybeDu2) |> ignore 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`` () = +let ``Strict func handling of obj type`` () = 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({|Anon=5|}) |> ignore strictFunc(null:obj) |> ignore - +strictFunc(null:(obj|null)) |> ignore +strictFunc(null:(string|null)) |> 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." ] - + [ Error 3261, Line 6, Col 12, Line 6, Col 20, "Nullness warning: The type 'obj' supports 'null' but a non-null type is expected." + Error 3261, Line 7, Col 18, Line 7, Col 26, "Nullness warning: The type 'obj' supports 'null' but a non-null type is expected." + Error 3261, Line 7, Col 12, Line 7, Col 27, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected." + Error 3261, Line 8, Col 12, Line 8, Col 30, "Nullness warning: The type 'string | null' supports 'null' but a non-null type is expected."] + + + +[] +let ``Strict func null literal`` () = + FSharp """module MyLibrary +let strictFunc(arg: 'x when 'x : not null) = printfn "%s" (arg.ToString()) + +strictFunc(null) |> ignore """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3261, Line 4, Col 12, Line 4, Col 16, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected."] + +[] +let ``Strict func null literal2`` () = + FSharp """module MyLibrary +let strictFunc(arg: 'x when 'x : not null) = printfn "%s" (arg.ToString()) + +strictFunc(null) |> ignore +strictFunc({|Anon=5|}) |> ignore +strictFunc("hi") |> ignore """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3261, Line 4, Col 12, Line 4, Col 16, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected."] + [] let ``Nullnesss support for F# types`` () = From 9e77b544f45ddbc3c23c682ba44fa53aa83b5bcc Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 28 Mar 2024 10:51:31 +0100 Subject: [PATCH 13/14] fantomas --- src/Compiler/CodeGen/IlxGen.fs | 3 ++- src/Compiler/Service/FSharpCheckerResults.fs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index a499a54d293..71854a4ac28 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -642,7 +642,8 @@ and GenNamedTyAppAux (cenv: cenv) m (tyenv: TypeReprEnv) ptrsOK tcref tinst = #if !NO_TYPEPROVIDERS match tcref.TypeReprInfo with // Generate the base type, because that is always the representation of the erased type, unless the assembly is being injected - | TProvidedTypeRepr info when info.IsErased -> GenTypeAux cenv m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased(m, g.obj_ty_withNulls)) + | TProvidedTypeRepr info when info.IsErased -> + GenTypeAux cenv m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased(m, g.obj_ty_withNulls)) | _ -> #endif GenTyAppAux cenv m tyenv (GenTyconRef tcref) tinst diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 8697f65897f..6ba009889c1 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -1060,7 +1060,8 @@ type internal TypeCheckInfo match r.Item with | Item.Types(_, ty :: _) when equals r.Range typeNameRange && isAppTy g ty -> let superTy = - (tcrefOfAppTy g ty).TypeContents.tcaug_super |> Option.defaultValue g.obj_ty_noNulls + (tcrefOfAppTy g ty).TypeContents.tcaug_super + |> Option.defaultValue g.obj_ty_noNulls let overriddenMethods = GetImmediateIntrinsicMethInfosOfType (None, ad) g amap typeNameRange ty From 877ee59b32cf6a93eaf6813c79da8e4393e61ed3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 2 Apr 2024 14:48:56 +0200 Subject: [PATCH 14/14] anon records nullness --- .../EmittedIL/Nullness/AnonRecords.fs.il.netcore.bsl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.netcore.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.netcore.bsl index c5181276c5b..7faa78a8042 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.netcore.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/AnonRecords.fs.il.netcore.bsl @@ -337,6 +337,8 @@ .method public hidebysig virtual final instance int32 CompareTo(object obj) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 8 IL_0000: ldarg.0 @@ -352,6 +354,8 @@ class [runtime]System.Collections.IComparer comp) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 5 .locals init (class '<>f__AnonymousType2430756162`3'j__TPar',!'j__TPar',!'j__TPar'> V_0, @@ -524,6 +528,8 @@ class [runtime]System.Collections.IEqualityComparer comp) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 5 .locals init (class '<>f__AnonymousType2430756162`3'j__TPar',!'j__TPar',!'j__TPar'> V_0, @@ -643,6 +649,8 @@ .method public hidebysig virtual final instance bool Equals(object obj) cil managed { .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) .maxstack 4 .locals init (class '<>f__AnonymousType2430756162`3'j__TPar',!'j__TPar',!'j__TPar'> V_0)