Merge main to release/net8

src/Compiler/FSComp.txt

@@ -1697,4 +1697,5 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form
 3565,parsExpectingType,"Expecting type"
 featureInformationalObjInferenceDiagnostic,"Diagnostic 3559 (warn when obj inferred) at informational level, off by default"
 3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements."
-3567,parsMissingMemberBody,"Expecting member body"
+3567,parsMissingMemberBody,"Expecting member body"
+3568,parsMissingKeyword,"Missing keyword '%s'"

src/Compiler/SyntaxTree/ParseHelpers.fs

@@ -1090,3 +1090,12 @@ let appendValToLeadingKeyword mVal leadingKeyword =
     | SynLeadingKeyword.Override mOverride -> SynLeadingKeyword.OverrideVal(mOverride, mVal)
     | SynLeadingKeyword.Default (mDefault) -> SynLeadingKeyword.DefaultVal(mDefault, mVal)
     | _ -> leadingKeyword
+
+let mkSynUnionCase attributes (access: SynAccess option) id kind mDecl (xmlDoc, mBar) =
+    match access with
+    | Some access -> errorR (Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations (), access.Range))
+    | _ -> ()
+
+    let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
+    let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
+    SynUnionCase(attributes, id, kind, xmlDoc, None, mDecl, trivia)

src/Compiler/SyntaxTree/ParseHelpers.fsi

@@ -238,3 +238,12 @@ val checkForMultipleAugmentations: m: range -> a1: 'a list -> a2: 'a list -> 'a
 val rangeOfLongIdent: lid: LongIdent -> range
 
 val appendValToLeadingKeyword: mVal: range -> leadingKeyword: SynLeadingKeyword -> SynLeadingKeyword
+
+val mkSynUnionCase:
+    attributes: SynAttributes ->
+    access: SynAccess option ->
+    id: SynIdent ->
+    kind: SynUnionCaseKind ->
+    mDecl: range ->
+    (PreXmlDoc * range) ->
+        SynUnionCase

src/Compiler/pars.fsy

@@ -2485,69 +2485,36 @@ attrUnionCaseDecls:
 /* The core of a union case definition */
 attrUnionCaseDecl:
   | opt_attributes opt_access unionCaseName
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        let mDecl = rhs parseState 3
-        (fun (xmlDoc, mBar) ->
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
-            Choice2Of2 (SynUnionCase ($1, $3, SynUnionCaseKind.Fields [], xmlDoc, None, mDecl, trivia))) }
+      { mkSynUnionCase $1 $2 $3 (SynUnionCaseKind.Fields []) (rhs2 parseState 1 3) >> Choice2Of2 }
 
   | opt_attributes opt_access recover
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        (fun (xmlDoc, mBar) ->
-            let id = SynIdent(mkSynId mBar.EndRange "", None)
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mBar
-            Choice2Of2 (SynUnionCase ($1, id, SynUnionCaseKind.Fields [], xmlDoc, None, mDecl, trivia))) }
+      { fun (xmlDoc, mBar) -> mkSynUnionCase $1 $2 (SynIdent(mkSynId mBar.EndRange "", None)) (SynUnionCaseKind.Fields []) mBar (xmlDoc, mBar) |> Choice2Of2 }
 
   | opt_attributes opt_access unionCaseName OF unionCaseRepr
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        let mDecl = rhs2 parseState 1 5
-        (fun (xmlDoc, mBar) ->
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
-            Choice2Of2 (SynUnionCase ($1, $3, SynUnionCaseKind.Fields $5, xmlDoc, None, mDecl, trivia))) }
+      { mkSynUnionCase $1 $2 $3 (SynUnionCaseKind.Fields $5) (rhs2 parseState 1 5) >> Choice2Of2 }
+
+  | opt_attributes opt_access unionCaseName unionCaseRepr
+      { errorR (Error(FSComp.SR.parsMissingKeyword("of"), rhs2 parseState 3 4))
+        mkSynUnionCase $1 $2 $3 (SynUnionCaseKind.Fields $4) (rhs2 parseState 1 4) >> Choice2Of2 }
 
   | opt_attributes opt_access OF unionCaseRepr
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        let mOf = rhs parseState 3
+      { let mOf = rhs parseState 3
         let mId = mOf.StartRange
         errorR (Error(FSComp.SR.parsMissingUnionCaseName(), mOf))
-        let mDecl = rhs2 parseState 1 4
-        (fun (xmlDoc, mBar) ->
-            let id = SynIdent(mkSynId mId "", None)
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
-            Choice2Of2(SynUnionCase($1, id, SynUnionCaseKind.Fields $4, xmlDoc, None, mDecl, trivia))) }
+        mkSynUnionCase $1 $2 (SynIdent(mkSynId mId "", None)) (SynUnionCaseKind.Fields $4) (rhs2 parseState 1 4) >> Choice2Of2 }
 
   | opt_attributes opt_access OF recover
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        let mOf = rhs parseState 3
+      { let mOf = rhs parseState 3
         let mId = mOf.StartRange
         errorR (Error(FSComp.SR.parsMissingUnionCaseName(), mOf))
-        let mDecl = rhs2 parseState 1 3
-        (fun (xmlDoc, mBar) ->
-            let id = SynIdent(mkSynId mId "", None)
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
-            Choice2Of2(SynUnionCase($1, id, SynUnionCaseKind.Fields [], xmlDoc, None, mDecl, trivia))) }
+        mkSynUnionCase $1 $2 (SynIdent(mkSynId mId "", None)) (SynUnionCaseKind.Fields []) (rhs2 parseState 1 3) >> Choice2Of2 }
 
   | opt_attributes opt_access unionCaseName OF recover
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        let mDecl = rhs2 parseState 1 4
-        (fun (xmlDoc, mBar) ->
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
-            Choice2Of2 (SynUnionCase ($1, $3, SynUnionCaseKind.Fields [], xmlDoc, None, mDecl, trivia))) }
+      { mkSynUnionCase $1 $2 $3 (SynUnionCaseKind.Fields []) (rhs2 parseState 1 4) >> Choice2Of2 }
 
   | opt_attributes opt_access unionCaseName COLON topType
-      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2))
-        if parseState.LexBuffer.ReportLibraryOnlyFeatures then libraryOnlyWarning(lhs parseState)
-        let mDecl = rhs2 parseState 1 5
-        (fun (xmlDoc, mBar) ->
-            let trivia: SynUnionCaseTrivia = { BarRange = Some mBar }
-            let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
-            Choice2Of2 (SynUnionCase ($1, $3, SynUnionCaseKind.FullType $5, xmlDoc, None, mDecl, trivia))) }
+      { if parseState.LexBuffer.ReportLibraryOnlyFeatures then libraryOnlyWarning(lhs parseState)
+        mkSynUnionCase $1 $2 $3 (SynUnionCaseKind.FullType $5) (rhs2 parseState 1 5) >> Choice2Of2 }
 
   | opt_attributes opt_access unionCaseName EQUALS atomicExpr
       { if Option.isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(), rhs parseState 2))

src/Compiler/xlf/FSComp.txt.cs.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Neúplný výraz operátoru (například^b) nebo volání kvalifikovaného typu (příklad: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.de.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Unvollständiger Operatorausdruck (Beispiel: a^b) oder qualifizierter Typaufruf (Beispiel: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.es.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Expresión de operador incompleta (ejemplo, a^b) o invocación de tipo calificada (ejemplo: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.fr.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Expression d’opérateur incomplète (exemple a^b) ou appel de type qualifié (exemple : ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.it.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Espressione operatore incompleta (ad esempio a^b) o chiamata di tipo qualificato (ad esempio: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.ja.xlf

@@ -822,6 +822,11 @@
         <target state="translated">不完全な演算子式 (例 a^b) または修飾型の呼び出し (例: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.ko.xlf

@@ -822,6 +822,11 @@
         <target state="translated">불완전한 연산자 식(예: a^b) 또는 정규화된 형식 호출(예: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.pl.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Niekompletne wyrażenie operatora (na przykład a^b) lub wywołanie typu kwalifikowanego (przykład: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.pt-BR.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Expressão de operador incompleta (exemplo a^b) ou invocação de tipo qualificado (exemplo: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.ru.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Неполное выражение оператора (например, a^b) или вызов квалифицированного типа (например, ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.tr.xlf

@@ -822,6 +822,11 @@
         <target state="translated">Eksik işleç ifadesi (örnek a^b) veya tam tür çağrısı (örnek: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.zh-Hans.xlf

@@ -822,6 +822,11 @@
         <target state="translated">运算符表达式不完整(示例: a^b)或限定类型调用(示例: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

src/Compiler/xlf/FSComp.txt.zh-Hant.xlf

@@ -822,6 +822,11 @@
         <target state="translated">不完整的運算子運算式 (範例 a^b) 或限定類型調用 (範例: ^T.Name)</target>
         <note />
       </trans-unit>
+      <trans-unit id="parsMissingKeyword">
+        <source>Missing keyword '{0}'</source>
+        <target state="new">Missing keyword '{0}'</target>
+        <note />
+      </trans-unit>
       <trans-unit id="parsMissingMemberBody">
         <source>Expecting member body</source>
         <target state="new">Expecting member body</target>

tests/service/data/SyntaxTree/UnionCase/Missing keyword of.fs

@@ -0,0 +1,11 @@
+module Module
+
+let a = ()
+
+type U =
+    | Case1
+    | Case2 string
+    | Case3 of int
+    | Case4 4
+
+let b = ()

tests/service/data/SyntaxTree/UnionCase/Missing keyword of.fs.bsl

@@ -0,0 +1,86 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/UnionCase/Missing keyword of.fs", false, QualifiedNameOfFile Module,
+      [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Let
+             (false,
+              [SynBinding
+                 (None, Normal, false, false, [],
+                  PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                  SynValData
+                    (None, SynValInfo ([], SynArgInfo ([], false, None)), None),
+                  Named (SynIdent (a, None), false, None, (3,4--3,5)), None,
+                  Const (Unit, (3,8--3,10)), (3,4--3,5), Yes (3,0--3,10),
+                  { LeadingKeyword = Let (3,0--3,3)
+                    InlineKeyword = None
+                    EqualsRange = Some (3,6--3,7) })], (3,0--3,10));
+           Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [U],
+                     PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (5,5--5,6)),
+                  Simple
+                    (Union
+                       (None,
+                        [SynUnionCase
+                           ([], SynIdent (Case1, None), Fields [],
+                            PreXmlDoc ((6,4), FSharp.Compiler.Xml.XmlDocCollector),
+                            None, (6,6--6,11), { BarRange = Some (6,4--6,5) });
+                         SynUnionCase
+                           ([], SynIdent (Case2, None),
+                            Fields
+                              [SynField
+                                 ([], false, None,
+                                  LongIdent
+                                    (SynLongIdent ([string], [], [None])), false,
+                                  PreXmlDoc ((7,12), FSharp.Compiler.Xml.XmlDocCollector),
+                                  None, (7,12--7,18), { LeadingKeyword = None })],
+                            PreXmlDoc ((7,4), FSharp.Compiler.Xml.XmlDocCollector),
+                            None, (7,6--7,18), { BarRange = Some (7,4--7,5) });
+                         SynUnionCase
+                           ([], SynIdent (Case3, None),
+                            Fields
+                              [SynField
+                                 ([], false, None,
+                                  LongIdent (SynLongIdent ([int], [], [None])),
+                                  false,
+                                  PreXmlDoc ((8,15), FSharp.Compiler.Xml.XmlDocCollector),
+                                  None, (8,15--8,18), { LeadingKeyword = None })],
+                            PreXmlDoc ((8,4), FSharp.Compiler.Xml.XmlDocCollector),
+                            None, (8,6--8,18), { BarRange = Some (8,4--8,5) });
+                         SynUnionCase
+                           ([], SynIdent (Case4, None),
+                            Fields
+                              [SynField
+                                 ([], false, None,
+                                  StaticConstant (Int32 4, (9,12--9,13)), false,
+                                  PreXmlDoc ((9,12), FSharp.Compiler.Xml.XmlDocCollector),
+                                  None, (9,12--9,13), { LeadingKeyword = None })],
+                            PreXmlDoc ((9,4), FSharp.Compiler.Xml.XmlDocCollector),
+                            None, (9,6--9,13), { BarRange = Some (9,4--9,5) })],
+                        (6,4--9,13)), (6,4--9,13)), [], None, (5,5--9,13),
+                  { LeadingKeyword = Type (5,0--5,4)
+                    EqualsRange = Some (5,7--5,8)
+                    WithKeyword = None })], (5,0--9,13));
+           Let
+             (false,
+              [SynBinding
+                 (None, Normal, false, false, [],
+                  PreXmlDoc ((11,0), FSharp.Compiler.Xml.XmlDocCollector),
+                  SynValData
+                    (None, SynValInfo ([], SynArgInfo ([], false, None)), None),
+                  Named (SynIdent (b, None), false, None, (11,4--11,5)), None,
+                  Const (Unit, (11,8--11,10)), (11,4--11,5), Yes (11,0--11,10),
+                  { LeadingKeyword = Let (11,0--11,3)
+                    InlineKeyword = None
+                    EqualsRange = Some (11,6--11,7) })], (11,0--11,10))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--11,10), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(7,6)-(7,18) parse error Missing keyword 'of'
+(9,6)-(9,13) parse error Missing keyword 'of'

tests/service/data/SyntaxTree/UnionCase/Missing name 05.fs.bsl

@@ -41,5 +41,5 @@ ImplFile
       { ConditionalDirectives = []
         CodeComments = [] }, set []))
 
-(5,6)-(5,14) parse error Accessibility modifiers are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation.
 (5,15)-(5,17) parse error Missing union case name
+(5,6)-(5,14) parse error Accessibility modifiers are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation.

tests/service/data/SyntaxTree/UnionCase/Missing name 06.fs.bsl

@@ -35,5 +35,5 @@ ImplFile
         CodeComments = [] }, set []))
 
 (6,4)-(6,5) parse error Unexpected symbol '|' in union case
-(5,6)-(5,14) parse error Accessibility modifiers are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation.
 (5,15)-(5,17) parse error Missing union case name
+(5,6)-(5,14) parse error Accessibility modifiers are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation.