diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 2f0306f95c5..3a25b96273b 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10399,10 +10399,13 @@ and TcMatchPattern cenv inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynE and TcMatchClauses cenv inputTy (resultTy: OverallTy) env tpenv clauses = let mutable first = true let isFirst() = if first then first <- false; true else false - List.mapFold (fun clause -> TcMatchClause cenv inputTy resultTy env (isFirst()) clause) tpenv clauses + let resultList,(tpEnv,_input) = + List.mapFold (fun (unscopedTyParEnv,inputTy) -> TcMatchClause cenv inputTy resultTy env (isFirst()) unscopedTyParEnv) (tpenv,inputTy) clauses + resultList,tpEnv and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchClause = let (SynMatchClause(synPat, synWhenExprOpt, synResultExpr, patm, spTgt, _)) = synMatchClause + let pat, whenExprOpt, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv synPat synWhenExprOpt let resultEnv = @@ -10417,8 +10420,35 @@ and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchC let resultExpr, tpenv = TcExprThatCanBeCtorBody cenv resultTy resultEnv tpenv synResultExpr let target = TTarget(vspecs, resultExpr, None) + + let inputTypeForNextPatterns= + let removeNull t = replaceNullnessOfTy KnownWithoutNull t + let rec isWild (p:Pattern) = + match p with + | TPat_wild _ -> true + | TPat_as (p,_,_) -> isWild p + | TPat_disjs(patterns,_) -> patterns |> List.exists isWild + | TPat_conjs(patterns,_) -> patterns |> List.forall isWild + | TPat_tuple (_,pats,_,_) -> pats |> List.forall isWild + | _ -> false + + let rec eliminateNull (ty:TType) (p:Pattern) = + match p with + | TPat_null _ -> removeNull ty + | TPat_as (p,_,_) -> eliminateNull ty p + | TPat_disjs(patterns,_) -> (ty,patterns) ||> List.fold eliminateNull + | TPat_tuple (_,pats,_,_) -> + match stripTyparEqns ty with + // In a tuple of size N, if 1 elem is matched for null and N-1 are wild => subsequent clauses can strip nullness + | TType_tuple(ti,tys) when tys.Length = pats.Length && (pats |> List.count (isWild >> not)) = 1 -> + TType_tuple(ti, List.map2 eliminateNull tys pats) + | _ -> ty + | _ -> ty + match whenExprOpt with + | None -> eliminateNull inputTy pat + | _ -> inputTy - MatchClause(pat, whenExprOpt, target, patm), tpenv + MatchClause(pat, whenExprOpt, target, patm), (tpenv,inputTypeForNextPatterns) and TcStaticOptimizationConstraint cenv env tpenv c = let g = cenv.g diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index ff50d481185..9bcebf546c8 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 [] let ``Printing a nullable string should pass`` () = @@ -71,4 +71,60 @@ let doStuff() = """ |> asLibrary |> typeCheckWithStrictNullness - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + + +[] +[] +[] +[] +[] +[] +[] +let ``Eliminate nullness after matching`` (tp) = + FSharp $"""module MyLibrary + +let myFunction (input : string | null) : string = + match input with + | {tp} -> "" + | nonNullString -> nonNullString +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +[] +[] +let ``Eliminate tupled nullness after matching`` (tp) = + FSharp $"""module MyLibrary + +let myFunction (input1 : string | null) (input2 : string | null): (string*string) = + match input1,input2 with + | {tp} -> "","" + | nns1,nns2 -> nns1,nns2 +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + + +[] +[] +[] +[] +[] +[] +[] +let ``Should NOT eliminate tupled nullness after matching`` (tp) = + FSharp $"""module MyLibrary + +let myFunction (input1 : string | null) (input2 : string | null): (string*string) = + match input1,input2 with + | %s{tp} -> "","" + | nns1,nns2 -> nns1,nns2 +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withErrorCode 3261 \ No newline at end of file