fix bug with 'null' literal type inference

dotnet · May 6, 2023 · 125d7db · 125d7db
1 parent b1ba8b3
commit 125d7db
Show file tree

Hide file tree

Showing 23 changed files with 217 additions and 88 deletions.
diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props
@@ -3,35 +3,31 @@
 <Project>
   <PropertyGroup>
     <!-- This turns on/off the feature in FSharp.Core. -->
-    <!-- If the feature is on, this turns off null checking in all assemblies. Otherwise it is selectively enabled in the project files. -->
     <CheckNulls>false</CheckNulls>
   </PropertyGroup>
 
   <PropertyGroup Condition="'$(FSHARPCORE_USE_PACKAGE)' == 'true'">
-    <!-- nullness checking isn't possible when using shipped FSHarp.Core package until it's updated -->
+    <!-- nullness checking isn't possible when using shipped FSharp.Core package until it's updated -->
     <CheckNulls>false</CheckNulls>
   </PropertyGroup>
 
   <PropertyGroup Condition="'$(Configuration)' == 'Proto'">
-    <DefineConstants>BUILDING_WITH_LKG;NO_CHECKNULLS;$(DefineConstants)</DefineConstants>
+    <DefineConstants>BUILDING_WITH_LKG;NO_NULLCHECKING_LIB_SUPPORT;$(DefineConstants)</DefineConstants>
     <NullCheckingSupportInLibrary>false</NullCheckingSupportInLibrary>
   </PropertyGroup>
 
-  <PropertyGroup Condition="'$(Configuration)' != 'Proto' AND '$(CheckNulls)' == 'true'">
-    <OtherFlags>$(OtherFlags) /langversion:preview /checknulls</OtherFlags>
-    <NullCheckingSupportInLibrary>true</NullCheckingSupportInLibrary>
+  <PropertyGroup Condition="'$(Configuration)' != 'Proto'">
+    <OtherFlags>$(OtherFlags) /langversion:preview</OtherFlags>
   </PropertyGroup>
 
-  <PropertyGroup Condition="'$(Configuration)' != 'Proto' AND '$(CheckNulls)' != 'true'">
-    <OtherFlags>$(OtherFlags) /langversion:preview</OtherFlags>
-    <!-- 3271: warning nullness annotations being ignored -->
-    <NoWarn>$(NoWarn);3271</NoWarn>
-    <DefineConstants>$(DefineConstants);NO_CHECKNULLS</DefineConstants>
-    <NullCheckingSupportInLibrary>true</NullCheckingSupportInLibrary>
+  <PropertyGroup Condition="'$(CheckNulls)' == 'true'">
+    <OtherFlags>$(OtherFlags) /checknulls</OtherFlags>
   </PropertyGroup>
 
-  <PropertyGroup Condition="'$(NullCheckingSupportInLibrary)' == 'false'">
-    <DefineConstants>NO_NULLCHECKING_LIB_SUPPORT;$(DefineConstants)</DefineConstants>
+  <PropertyGroup Condition="'$(CheckNulls)' == 'false'">
+    <!-- 3271: warning nullness annotations being ignored -->
+    <NoWarn>$(NoWarn);3271</NoWarn>
+    <DefineConstants>NO_CHECKNULLS;$(DefineConstants)</DefineConstants>
   </PropertyGroup>
 
   <Choose>

diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs
@@ -971,6 +971,43 @@ let TranslatePartialValReprInfo tps (PrelimValReprInfo (argsData, retData)) =
 // Members
 //-------------------------------------------------------------------------
 
+let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC m =
+    let g = cenv.g
+    if g.langFeatureNullness then 
+        if TypeNullNever g innerTyC then
+            let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
+            errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) 
+
+        match tryAddNullnessToTy nullness innerTyC with 
+
+        | None -> 
+            let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
+            errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) 
+            innerTyC
+
+        | Some innerTyCWithNull ->
+            // The inner type is not allowed to support null or use null as a representation value.
+            // For example "int option?" is not allowed, nor "string??".
+            //
+            // For variable types in FSharp.Core we make an exception because we must allow
+            //    val toObj: value: 'T option -> 'T __withnull when 'T : not struct (* and 'T : __notnull *)
+            // wihout implying 'T is not null.  This is because it is legitimate to use this
+            // function to "collapse" null and obj-null-coming-from-option using such a function.
+
+            if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then 
+                AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC
+
+            innerTyCWithNull
+
+    else
+        if warn then
+            warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m)) 
+        innerTyC
+
+//-------------------------------------------------------------------------
+// Members
+//-------------------------------------------------------------------------
+
 let ComputeLogicalName (id: Ident) (memberFlags: SynMemberFlags) =
     match memberFlags.MemberKind with
     | SynMemberKind.ClassConstructor -> ".cctor"
@@ -4381,37 +4418,9 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
 
     | SynType.WithNull(innerTy, ambivalent, m) -> 
         let innerTyC, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv innerTy
-        if g.langFeatureNullness then 
-            if TypeNullNever g innerTyC then
-                let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
-                errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) 
-
-            // TODO - doesn't feel right - it will add KnownNotNull + KnownWithNull --> KnownWithNull, e.g.
-            //    let f (x: string) = (x = null)
-            match tryAddNullnessToTy (if ambivalent then KnownAmbivalentToNull else KnownWithNull) innerTyC with 
-
-            | None -> 
-                let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
-                errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) 
-                innerTyC, tpenv
-
-            | Some innerTyCWithNull ->
-                // The inner type is not allowed to support null or use null as a representation value.
-                // For example "int option?" is not allowed, not "string??".
-                //
-                // For variable types in FSharp.Core we make an exception because we must allow
-                //    val toObj: value: 'T option -> 'T __withnull when 'T : not struct (* and 'T : __notnull *)
-                // wihout implying 'T is not null.  This is because it is legitimate to use this
-                // function to "collapse" null and obj-null-coming-from-option using such a function.
-
-                if g.compilingFSharpCore && not (isTyparTy g innerTyC) then 
-                    AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC
-
-                innerTyCWithNull, tpenv
-
-        else
-            warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m)) 
-            innerTyC, tpenv
+        let nullness = if ambivalent then KnownAmbivalentToNull else KnownWithNull
+        let tyWithNull = TcAddNullnessToType false cenv env nullness innerTyC m
+        tyWithNull, tpenv
 
     | SynType.MeasurePower(ty, exponent, m) ->
         TcTypeMeasurePower kindOpt cenv newOk checkConstraints occ env tpenv ty exponent m
@@ -5595,8 +5604,9 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
 
     | SynExpr.Null m ->
         TcNonControlFlowExpr env <| fun env ->
-        AddCxTypeDefnSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
-        mkNull m overallTy.Commit, tpenv
+        AddCxTypeUseSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
+        let tyWithNull = addNullnessToTy KnownWithNull overallTy.Commit
+        mkNull m tyWithNull, tpenv
 
     | SynExpr.Lazy (synInnerExpr, m) ->
         TcNonControlFlowExpr env <| fun env ->

diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs
@@ -470,7 +470,7 @@ and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
 
 and TcNullPat cenv env patEnv ty m =
     try
-        AddCxTypeDefnSupportsNull env.DisplayEnv cenv.css m NoTrace ty
+        AddCxTypeUseSupportsNull env.DisplayEnv cenv.css m NoTrace ty
     with exn ->
         errorRecovery exn m
     (fun _ -> TPat_null m), patEnv

diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs
@@ -770,7 +770,7 @@ module PrintTypes =
             [wordL (tagKeyword "null") |> longConstraintPrefix]
 
         | TyparConstraint.NotSupportsNull _ ->
-                [(wordL (tagKeyword "not") ^^ wordL(tagKeyword "null")) |> longConstraintPrefix]
+                [(wordL (tagKeyword "__notnull") (* ^^ wordL(tagKeyword "null") *) ) |> longConstraintPrefix]
 
         | TyparConstraint.IsNonNullableStruct _ ->
             if denv.shortConstraints then 
@@ -882,7 +882,7 @@ module PrintTypes =
         match nullness.Evaluate() with
         | NullnessInfo.WithNull -> part2 ^^ wordL (tagText "__withnull")
         | NullnessInfo.WithoutNull -> part2
-        | NullnessInfo.AmbivalentToNull -> part2 // TODO NULLNESS: emit this optionally ^^ wordL (tagText "%")
+        | NullnessInfo.AmbivalentToNull -> part2 ^^ wordL (tagText "__maybenull")  // TODO NULLNESS: emit this optionally ^^ wordL (tagText "%")
 
     /// Layout a type, taking precedence into account to insert brackets where needed
     and layoutTypeWithInfoAndPrec denv env prec ty =

diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs
@@ -395,7 +395,7 @@ module internal TokenClassifications =
         | HIGH_PRECEDENCE_PAREN_APP
         | FIXED
         | HIGH_PRECEDENCE_BRACK_APP
-        | AMBIVALENT__
+        | MAYBENULL__
         | NOTNULL__
         | WITHNULL__
         | TYPE_COMING_SOON

diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs
@@ -1084,11 +1084,11 @@ type LexFilterImpl (
                     //      f<{| C : int |}>x
                     //      f<x # x>x
                     //      f<x ' x>x
-                    //      f<x __ambivalent>x
+                    //      f<x __maybenull>x
                     //      f<x  __notnull>x
                     //      f<x  __withnull>x
                     | DEFAULT | COLON | COLON_GREATER | STRUCT | NULL | DELEGATE | AND | WHEN 
-                    | NOTNULL__ | AMBIVALENT__ | WITHNULL__
+                    | NOTNULL__ | MAYBENULL__ | WITHNULL__
                     | DOT_DOT
                     | NEW
                     | LBRACE_BAR

diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs
@@ -394,7 +394,7 @@ module Keywords =
             FSHARP, "__token_OLET", OLET(true)
             FSHARP, "__token_constraint", CONSTRAINT
             (*------- for prototyping *)
-            FSHARP, "__ambivalent", AMBIVALENT__
+            FSHARP, "__maybenull", MAYBENULL__
             FSHARP, "__notnull", NOTNULL__
             FSHARP, "__withnull", WITHNULL__
         ]

diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy
@@ -91,7 +91,7 @@ let parse_error_rich = Some(fun (ctxt: ParseErrorContext<_>) ->
 %token GREATER_RBRACK STRUCT SIG
 %token STATIC MEMBER CLASS ABSTRACT OVERRIDE DEFAULT CONSTRUCTOR INHERIT
 %token EXTERN VOID PUBLIC PRIVATE INTERNAL GLOBAL
-%token AMBIVALENT__ NOTNULL__ WITHNULL__
+%token MAYBENULL__ NOTNULL__ WITHNULL__
 
 /* for parser 'escape hatch' out of expression context without consuming the 'recover' token */
 %token TYPE_COMING_SOON TYPE_IS_HERE MODULE_COMING_SOON MODULE_IS_HERE
@@ -5496,7 +5496,7 @@ appTypeConPower:
     { $1 }
 
 appType:
-  | appType AMBIVALENT__
+  | appType MAYBENULL__
     { SynType.WithNull($1, true, lhs parseState) }
 
   | appType WITHNULL__

diff --git a/src/Compiler/xlf/FSStrings.cs.xlf b/src/Compiler/xlf/FSStrings.cs.xlf
@@ -62,6 +62,16 @@
         <target state="translated">interpolovaný řetězec (část)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Viz taky {0}.</target>

diff --git a/src/Compiler/xlf/FSStrings.de.xlf b/src/Compiler/xlf/FSStrings.de.xlf
@@ -62,6 +62,16 @@
         <target state="translated">Interpolierte Zeichenfolge (Teil)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Siehe auch "{0}".</target>

diff --git a/src/Compiler/xlf/FSStrings.es.xlf b/src/Compiler/xlf/FSStrings.es.xlf
@@ -62,6 +62,16 @@
         <target state="translated">cadena interpolada (parte)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Vea también {0}.</target>

diff --git a/src/Compiler/xlf/FSStrings.fr.xlf b/src/Compiler/xlf/FSStrings.fr.xlf
@@ -62,6 +62,16 @@
         <target state="translated">chaîne interpolée (partie)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Voir aussi {0}.</target>

diff --git a/src/Compiler/xlf/FSStrings.it.xlf b/src/Compiler/xlf/FSStrings.it.xlf
@@ -62,6 +62,16 @@
         <target state="translated">stringa interpolata (parte)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Vedere anche {0}.</target>

diff --git a/src/Compiler/xlf/FSStrings.ja.xlf b/src/Compiler/xlf/FSStrings.ja.xlf
@@ -62,6 +62,16 @@
         <target state="translated">補間された文字列 (部分)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">。{0} も参照してください。</target>

diff --git a/src/Compiler/xlf/FSStrings.ko.xlf b/src/Compiler/xlf/FSStrings.ko.xlf
@@ -62,6 +62,16 @@
         <target state="translated">보간 문자열(부분)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">{0}도 참조하세요.</target>

diff --git a/src/Compiler/xlf/FSStrings.pl.xlf b/src/Compiler/xlf/FSStrings.pl.xlf
@@ -62,6 +62,16 @@
         <target state="translated">ciąg interpolowany (część)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Zobacz też {0}.</target>

diff --git a/src/Compiler/xlf/FSStrings.pt-BR.xlf b/src/Compiler/xlf/FSStrings.pt-BR.xlf
@@ -62,6 +62,16 @@
         <target state="translated">cadeia de caracteres interpolada (parte)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. Consulte também {0}.</target>

diff --git a/src/Compiler/xlf/FSStrings.ru.xlf b/src/Compiler/xlf/FSStrings.ru.xlf
@@ -62,6 +62,16 @@
         <target state="translated">интерполированная строка (часть)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Parser.TOKEN.NOTNULL__">
+        <source>keyword '__notnull'</source>
+        <target state="new">keyword '__notnull'</target>
+        <note />
+      </trans-unit>
+      <trans-unit id="Parser.TOKEN.WITHNULL__">
+        <source>keyword '__withnull'</source>
+        <target state="new">keyword '__withnull'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="SeeAlso">
         <source>. See also {0}.</source>
         <target state="translated">. См. также {0}.</target>