From 2b15585b81b4a271e63c6a3e38551b59c1556f2f Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 19 Jul 2023 17:52:57 +0200 Subject: [PATCH] Checker: fix exception on wrong update syntax in anon records (#15638) --- src/Compiler/Checking/CheckExpressions.fs | 44 ++- src/Compiler/Checking/CheckExpressions.fsi | 2 +- src/Compiler/Checking/CheckPatterns.fs | 5 +- .../Types/RecordTypes/AnonymousRecords.fs | 25 +- .../ErrorMessages/NameResolutionTests.fs | 262 +++++++++++++++++- .../ErrorMessages/SuggestionsTests.fs | 6 +- tests/fsharp/typecheck/sigs/neg07.bsl | 10 + .../RequireQualifiedAccess/E_OnRecord.fs | 1 - tests/service/Symbols.fs | 204 ++++++++++++++ 9 files changed, 534 insertions(+), 25 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 01f9ff4e602..81b1571cdbe 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1807,10 +1807,17 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' let fldResolutions = let allFields = flds |> List.map (fun ((_, ident), _) -> ident) flds - |> List.map (fun (fld, fldExpr) -> - let (fldPath, fldId) = fld - let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fldPath fldId allFields - fld, frefSet, fldExpr) + |> List.choose (fun (fld, fldExpr) -> + try + let fldPath, fldId = fld + let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fldPath fldId allFields + Some(fld, frefSet, fldExpr) + with e -> + errorRecoveryNoRange e + None + ) + + if fldResolutions.IsEmpty then None else let relevantTypeSets = fldResolutions |> List.map (fun (_, frefSet, _) -> @@ -1870,7 +1877,7 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' Map.add fref2.FieldName fldExpr fs, (fref2.FieldName, fldExpr) :: rfldsList | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(), m))) - tinst, tcref, fldsmap, List.rev rfldsList + Some(tinst, tcref, fldsmap, List.rev rfldsList) let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g @@ -7366,7 +7373,10 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m match flds with | [] -> [] | _ -> - let tinst, tcref, _, fldsList = BuildFieldMap cenv env hasOrigExpr overallTy flds mWholeExpr + match BuildFieldMap cenv env hasOrigExpr overallTy flds mWholeExpr with + | None -> [] + | Some(tinst, tcref, _, fldsList) -> + let gtyp = mkAppTy tcref tinst UnifyTypes cenv env mWholeExpr overallTy gtyp @@ -7382,7 +7392,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m let withExprAddrVal, withExprAddrValExpr = mkCompGenLocal mWholeExpr "inputRecord" (if isStructTy g overallTy then mkByrefTy g overallTy else overallTy) Some(withExpr, withExprAddrVal, withExprAddrValExpr) - if hasOrigExpr && not (isRecdTy g overallTy) then + if hasOrigExpr && not (isRecdTy g overallTy || isAnonRecdTy g overallTy) then errorR(Error(FSComp.SR.tcExpressionFormRequiresRecordTypes(), mWholeExpr)) if requiresCtor || haveCtor then @@ -7397,7 +7407,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m error(Error(errorInfo, mWholeExpr)) if isFSharpObjModelTy g overallTy then errorR(Error(FSComp.SR.tcTypeIsNotARecordTypeNeedConstructor(), mWholeExpr)) - elif not (isRecdTy g overallTy) then errorR(Error(FSComp.SR.tcTypeIsNotARecordType(), mWholeExpr)) + elif not (isRecdTy g overallTy || fldsList.IsEmpty) then errorR(Error(FSComp.SR.tcTypeIsNotARecordType(), mWholeExpr)) let superInitExprOpt , tpenv = match inherits, GetSuperTypeOfType g cenv.amap mWholeExpr overallTy with @@ -7415,14 +7425,18 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m errorR(InternalError("Unexpected failure in getting super type", mWholeExpr)) None, tpenv - let expr, tpenv = TcRecordConstruction cenv overallTy env tpenv withExprInfoOpt overallTy fldsList mWholeExpr + if fldsList.IsEmpty && isTyparTy g overallTy || isAnonRecdTy g overallTy then + SolveTypeAsError env.DisplayEnv cenv.css mWholeExpr overallTy + mkDefault (mWholeExpr, overallTy), tpenv + else + let expr, tpenv = TcRecordConstruction cenv overallTy env tpenv withExprInfoOpt overallTy fldsList mWholeExpr - let expr = - match superInitExprOpt with - | _ when isStructTy g overallTy -> expr - | Some superInitExpr -> mkCompGenSequential mWholeExpr superInitExpr expr - | None -> expr - expr, tpenv + let expr = + match superInitExprOpt with + | _ when isStructTy g overallTy -> expr + | Some superInitExpr -> mkCompGenSequential mWholeExpr superInitExpr expr + | None -> expr + expr, tpenv // Check '{| .... |}' diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 0d02f07a223..b26381b6b02 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -895,7 +895,7 @@ val BuildFieldMap: ty: TType -> flds: ((Ident list * Ident) * 'T) list -> m: range -> - TypeInst * TyconRef * Map * (string * 'T) list + (TypeInst * TyconRef * Map * (string * 'T) list) option /// Check a long identifier 'Case' or 'Case argsR' that has been resolved to an active pattern case val TcPatLongIdentActivePatternCase: diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 229ae15a98e..5038131473e 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -441,7 +441,10 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m = and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m = let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, fieldPat) - let tinst, tcref, fldsmap, _fldsList = BuildFieldMap cenv env true ty fieldPats m + match BuildFieldMap cenv env true ty fieldPats m with + | None -> (fun _ -> TPat_error m), patEnv + | Some(tinst, tcref, fldsmap, _fldsList) -> + let gtyp = mkAppTy tcref tinst let inst = List.zip (tcref.Typars m) tinst diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs index e9dbe8ffd43..de9f1909a23 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs @@ -64,4 +64,27 @@ type ErrorResponse = Error 10, Line 5, Col 42, Line 5, Col 43, "Unexpected integer literal in field declaration. Expected ':' or other token." Error 10, Line 7, Col 12, Line 7, Col 14, "Unexpected symbol '|}' in field declaration. Expected identifier or other token." Error 10, Line 10, Col 17, Line 10, Col 21, "Incomplete structured construct at or before this point in field declaration. Expected identifier or other token." - ] \ No newline at end of file + ] + + [] + let ``Nested anonymous records where outer label = concatenated inner labels (see secondary issue reported in 6411)`` () = + FSharp """ +module NestedAnonRecds + +let x = {| abcd = {| ab = 4; cd = 1 |} |} +""" + |> compile + |> shouldSucceed + + [] + let ``Wrong update syntax`` () = + Fsx """ +let f (r: {| A: int |}) = + { r with A = 1 } +""" + |> ignoreWarnings + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 39, Line 3, Col 14, Line 3, Col 15, "The record label 'A' is not defined.") + ] diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameResolutionTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameResolutionTests.fs index 23d6324b592..3b41ae6b6eb 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameResolutionTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameResolutionTests.fs @@ -21,8 +21,10 @@ let r:F = { Size=3; Height=4; Wall=1 } """ |> typecheck |> shouldFail - |> withSingleDiagnostic (Error 1129, Line 9, Col 31, Line 9, Col 35, - ("The record type 'F' does not contain a label 'Wall'. Maybe you want one of the following:" + System.Environment.NewLine + " Wallis")) + |> withDiagnostics [ + (Error 1129, Line 9, Col 31, Line 9, Col 35, "The record type 'F' does not contain a label 'Wall'. Maybe you want one of the following:" + System.Environment.NewLine + " Wallis") + (Error 764, Line 9, Col 11, Line 9, Col 39, "No assignment given for field 'Wallis' of type 'Test.F'") + ] [] let RecordFieldProposal () = @@ -38,5 +40,257 @@ let r = { Size=3; Height=4; Wall=1 } """ |> typecheck |> shouldFail - |> withSingleDiagnostic (Error 39, Line 9, Col 29, Line 9, Col 33, - ("The record label 'Wall' is not defined. Maybe you want one of the following:" + System.Environment.NewLine + " Walls" + System.Environment.NewLine + " Wallis")) + |> withDiagnostics [ + (Error 39, Line 9, Col 29, Line 9, Col 33, "The record label 'Wall' is not defined. Maybe you want one of the following:" + System.Environment.NewLine + " Walls" + System.Environment.NewLine + " Wallis") + (Error 764, Line 9, Col 9, Line 9, Col 37, "No assignment given for field 'Wallis' of type 'Test.F'") + ] + + let multipleRecdTypeChoiceWarningWith1AlternativeSource = """ +namespace N + +module Module1 = + + type OtherThing = + { Name: string } + +module Module2 = + + type Person = + { Name: string + City: string } + +module Lib = + + open Module2 + open Module1 + + let F thing = + let x = thing.Name + thing.City +""" + + [] + let MultipleRecdTypeChoiceWarningWith1AlternativeLangPreview () = + FSharp multipleRecdTypeChoiceWarningWith1AlternativeSource + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 3566, Line 22, Col 9, Line 22, Col 19, "Multiple type matches were found:\n N.Module1.OtherThing\n N.Module2.Person\nThe type 'N.Module1.OtherThing' was used. Due to the overlapping field names\n Name\nconsider using type annotations or change the order of open statements.") + (Error 39, Line 22, Col 15, Line 22, Col 19, "The type 'OtherThing' does not define the field, constructor or member 'City'.") + ] + + [] + let MultipleRecdTypeChoiceWarningWith1AlternativeLang7 () = + FSharp multipleRecdTypeChoiceWarningWith1AlternativeSource + |> withLangVersion70 + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Information 3566, Line 22, Col 9, Line 22, Col 19, "Multiple type matches were found:\n N.Module1.OtherThing\n N.Module2.Person\nThe type 'N.Module1.OtherThing' was used. Due to the overlapping field names\n Name\nconsider using type annotations or change the order of open statements.") + (Error 39, Line 22, Col 15, Line 22, Col 19, "The type 'OtherThing' does not define the field, constructor or member 'City'.") + ] + + let multipleRecdTypeChoiceWarningWith2AlternativeSource = """ +namespace N + +module Module1 = + + type OtherThing = + { Name: string + Planet: string } + +module Module2 = + + type Person = + { Name: string + City: string + Planet: string } + +module Module3 = + + type Cafe = + { Name: string + City: string + Country: string + Planet: string } + +module Lib = + + open Module3 + open Module2 + open Module1 + + let F thing = + let x = thing.Name + thing.City +""" + + [] + let MultipleRecdTypeChoiceWarningWith2AlternativeLangPreview () = + FSharp multipleRecdTypeChoiceWarningWith2AlternativeSource + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 3566, Line 33, Col 9, Line 33, Col 19, "Multiple type matches were found:\n N.Module1.OtherThing\n N.Module2.Person\n N.Module3.Cafe\nThe type 'N.Module1.OtherThing' was used. Due to the overlapping field names\n Name\n Planet\nconsider using type annotations or change the order of open statements.") + (Error 39, Line 33, Col 15, Line 33, Col 19, "The type 'OtherThing' does not define the field, constructor or member 'City'.") + ] + + [] + let MultipleRecdTypeChoiceWarningWith2AlternativeLang7 () = + FSharp multipleRecdTypeChoiceWarningWith2AlternativeSource + |> withLangVersion70 + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Information 3566, Line 33, Col 9, Line 33, Col 19, "Multiple type matches were found:\n N.Module1.OtherThing\n N.Module2.Person\n N.Module3.Cafe\nThe type 'N.Module1.OtherThing' was used. Due to the overlapping field names\n Name\n Planet\nconsider using type annotations or change the order of open statements.") + (Error 39, Line 33, Col 15, Line 33, Col 19, "The type 'OtherThing' does not define the field, constructor or member 'City'.") + ] + + let multipleRecdTypeChoiceWarningNotRaisedWithCorrectOpenStmtsOrderingSource = """ +namespace N + +module Module1 = + + type OtherThing = + { Name: string + Planet: string } + +module Module2 = + + type Person = + { Name: string + City: string + Planet: string } + +module Module3 = + + type Cafe = + { Name: string + City: string + Country: string + Planet: string } + +module Lib = + + open Module3 + open Module1 + open Module2 + + let F thing = + let x = thing.Name + thing.City +""" + + [] + let MultipleRecdTypeChoiceWarningNotRaisedWithCorrectOpenStmtsOrderingLangPreview () = + FSharp multipleRecdTypeChoiceWarningNotRaisedWithCorrectOpenStmtsOrderingSource + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let MultipleRecdTypeChoiceWarningNotRaisedWithCorrectOpenStmtsOrderingLang7 () = + FSharp multipleRecdTypeChoiceWarningNotRaisedWithCorrectOpenStmtsOrderingSource + |> withLangVersion70 + |> typecheck + |> shouldSucceed + + let multipleRecdTypeChoiceWarningNotRaisedWithoutOverlapsSource = """ +namespace N + +module Module1 = + + type OtherThing = + { NameX: string + Planet: string } + +module Module2 = + + type Person = + { Name: string + City: string + Planet: string } + +module Module3 = + + type Cafe = + { NameX: string + City: string + Country: string + Planet: string } + +module Lib = + + open Module3 + open Module2 + open Module1 + + let F thing = + let x = thing.Name + thing.City +""" + + [] + let MultipleRecdTypeChoiceWarningNotRaisedWithoutOverlapsLangPreview () = + FSharp multipleRecdTypeChoiceWarningNotRaisedWithoutOverlapsSource + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let MultipleRecdTypeChoiceWarningNotRaisedWithoutOverlapsLang7 () = + FSharp multipleRecdTypeChoiceWarningNotRaisedWithoutOverlapsSource + |> withLangVersion70 + |> typecheck + |> shouldSucceed + + let multipleRecdTypeChoiceWarningNotRaisedWithTypeAnnotationsSource = """ + namespace N + + module Module1 = + + type OtherThing = + { NameX: string + Planet: string } + + module Module2 = + + type Person = + { Name: string + City: string + Planet: string } + + module Module3 = + + type Cafe = + { NameX: string + City: string + Country: string + Planet: string } + + module Lib = + + open Module3 + open Module2 + open Module1 + + let F (thing: Person) = + let x = thing.Name + thing.City + """ + + [] + let MultipleRecdTypeChoiceWarningNotRaisedWithTypeAnnotationsLangPreview () = + FSharp multipleRecdTypeChoiceWarningNotRaisedWithTypeAnnotationsSource + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let MultipleRecdTypeChoiceWarningNotRaisedWithTypeAnnotationsLang7 () = + FSharp multipleRecdTypeChoiceWarningNotRaisedWithTypeAnnotationsSource + |> withLangVersion70 + |> typecheck + |> shouldSucceed diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/SuggestionsTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/SuggestionsTests.fs index 43e3f16ded5..50837863d5a 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/SuggestionsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/SuggestionsTests.fs @@ -173,8 +173,10 @@ let r = { Field1 = "hallo"; Field2 = 1 } """ |> typecheck |> shouldFail - |> withSingleDiagnostic (Error 39, Line 8, Col 11, Line 8, Col 17, - ("The record label 'Field1' is not defined. Maybe you want one of the following:" + Environment.NewLine + " MyRecord.Field1")) + |> withDiagnostics [ + (Error 39, Line 8, Col 11, Line 8, Col 17, "The record label 'Field1' is not defined. Maybe you want one of the following:" + Environment.NewLine + " MyRecord.Field1") + (Error 39, Line 8, Col 29, Line 8, Col 35, "The record label 'Field2' is not defined. Maybe you want one of the following:" + Environment.NewLine + " MyRecord.Field2") + ] [] let ``Suggest Type Parameters`` () = diff --git a/tests/fsharp/typecheck/sigs/neg07.bsl b/tests/fsharp/typecheck/sigs/neg07.bsl index b768e036c87..618ebb131d0 100644 --- a/tests/fsharp/typecheck/sigs/neg07.bsl +++ b/tests/fsharp/typecheck/sigs/neg07.bsl @@ -24,9 +24,19 @@ neg07.fs(36,11,36,27): typecheck error FS0026: This rule will never be matched neg07.fs(46,15,46,27): typecheck error FS0039: The record label 'RecordLabel1' is not defined. Maybe you want one of the following: R.RecordLabel1 +neg07.fs(46,33,46,45): typecheck error FS0039: The record label 'RecordLabel2' is not defined. Maybe you want one of the following: + R.RecordLabel2 + +neg07.fs(47,17,47,55): typecheck error FS0025: Incomplete pattern matches on this expression. +neg07.fs(47,59,47,60): typecheck error FS0039: The value or constructor 'a' is not defined. +neg07.fs(47,63,47,64): typecheck error FS0039: The value or constructor 'b' is not defined. + neg07.fs(47,19,47,31): typecheck error FS0039: The record label 'RecordLabel1' is not defined. Maybe you want one of the following: R.RecordLabel1 +neg07.fs(47,37,47,49): typecheck error FS0039: The record label 'RecordLabel2' is not defined. Maybe you want one of the following: + R.RecordLabel2 + neg07.fs(57,10,57,17): typecheck error FS1196: The 'UseNullAsTrueValue' attribute flag may only be used with union types that have one nullary case and at least one non-nullary case neg07.fs(64,10,64,18): typecheck error FS1196: The 'UseNullAsTrueValue' attribute flag may only be used with union types that have one nullary case and at least one non-nullary case diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/E_OnRecord.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/E_OnRecord.fs index ce8f3cdcf89..5c554f2cffb 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/E_OnRecord.fs +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/E_OnRecord.fs @@ -2,7 +2,6 @@ // Verify error when not fully qualifying a record field when it // has the RequireQualifiedAccess attribute. -//The record label 'Field1' is not defined\. //The record label 'Field1' is not defined\. [] diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 796ef87782e..75f22d768d2 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -474,3 +474,207 @@ type Foo = (:? FSharpMemberOrFunctionOrValue as setMfv) -> Assert.AreNotEqual(getMfv.CurriedParameterGroups, setMfv.CurriedParameterGroups) | _ -> Assert.Fail "Expected symbols to be FSharpMemberOrFunctionOrValue" + + [] + let ``Multiple symbols are resolved for property`` () = + let source = """ +type X(y: string) = + member val Y = y with get, set +""" + + let _, checkResults = getParseAndCheckResults source + let symbolUses = + checkResults.GetSymbolUsesAtLocation(3, 16, " member val Y = y with get, set", [ "Y" ]) + |> List.map (fun su -> su.Symbol) + + match symbolUses with + | [ :? FSharpMemberOrFunctionOrValue as setMfv + :? FSharpMemberOrFunctionOrValue as getMfv ] -> + Assert.AreEqual("set_Y", setMfv.CompiledName) + Assert.AreEqual("get_Y", getMfv.CompiledName) + | _ -> Assert.Fail "Expected symbols" + + [] + let ``Multiple relevant symbols for type name`` () = + let _, checkResults = getParseAndCheckResults """ +// This is a generated file; the original input is 'FSInteractiveSettings.txt' +namespace FSInteractiveSettings + +type internal SR () = + + static let mutable swallowResourceText = false + + /// If set to true, then all error messages will just return the filled 'holes' delimited by ',,,'s - this is for language-neutral testing (e.g. localization-invariant baselines). + static member SwallowResourceText with get () = swallowResourceText + and set (b) = swallowResourceText <- b + // END BOILERPLATE +""" + + let symbols = + checkResults.GetSymbolUsesAtLocation(5, 16, "type internal SR () =", [ "" ]) + |> List.map (fun su -> su.Symbol) + + match symbols with + | [ :? FSharpMemberOrFunctionOrValue as cctor + :? FSharpMemberOrFunctionOrValue as ctor + :? FSharpEntity as entity ] -> + Assert.AreEqual(".cctor", cctor.CompiledName) + Assert.AreEqual(".ctor", ctor.CompiledName) + Assert.AreEqual("SR", entity.DisplayName) + | _ -> Assert.Fail "Expected symbols" + +module Expressions = + [] + let ``Unresolved record field 01`` () = + let _, checkResults = getParseAndCheckResults """ +type R = + { F1: int + F2: int } + +{ F = 1 + F2 = 1 } +""" + getSymbolUses checkResults + |> Seq.exists (fun symbolUse -> symbolUse.IsFromUse && symbolUse.Symbol.DisplayName = "F2") + |> shouldEqual true + + [] + let ``Unresolved record field 02`` () = + let _, checkResults = getParseAndCheckResults """ +[] +type R = + { F1: int + F2: int } + +{ F1 = 1 + R.F2 = 1 } +""" + getSymbolUses checkResults + |> Seq.exists (fun symbolUse -> symbolUse.IsFromUse && symbolUse.Symbol.DisplayName = "F2") + |> shouldEqual true + + [] + let ``Unresolved record field 03`` () = + let _, checkResults = getParseAndCheckResults """ +[] +type R = + { F1: int + F2: int } + +{ R.F2 = 1 + F1 = 1 } +""" + getSymbolUses checkResults + |> Seq.exists (fun symbolUse -> symbolUse.IsFromUse && symbolUse.Symbol.DisplayName = "F2") + |> shouldEqual true + + [] + let ``Unresolved record field 04`` () = + let _, checkResults = getParseAndCheckResults """ +type R = + { F1: int + F2: int } + +match Unchecked.defaultof with +{ F = 1 + F2 = 1 } -> () +""" + getSymbolUses checkResults + |> Seq.exists (fun symbolUse -> symbolUse.IsFromUse && symbolUse.Symbol.DisplayName = "F2") + |> shouldEqual true + + [] + let ``Unresolved record field 05`` () = + let _, checkResults = getParseAndCheckResults """ +[] +type R = + { F1: int + F2: int } + +match Unchecked.defaultof with +{ F = 1 + R.F2 = 1 } -> () +""" + getSymbolUses checkResults + |> Seq.exists (fun symbolUse -> symbolUse.IsFromUse && symbolUse.Symbol.DisplayName = "F2") + |> shouldEqual true + + + [] + let ``Unresolved record field 06`` () = + let _, checkResults = getParseAndCheckResults """ +[] +type R = + { F1: int + F2: int } + +match Unchecked.defaultof with +{ R.F2 = 1 + F = 1 } -> () +""" + getSymbolUses checkResults + |> Seq.exists (fun symbolUse -> symbolUse.IsFromUse && symbolUse.Symbol.DisplayName = "F2") + |> shouldEqual true + +module GetValSignatureText = + let private assertSignature (expected:string) source (lineNumber, column, line, identifier) = + let _, checkResults = getParseAndCheckResults source + let symbolUseOpt = checkResults.GetSymbolUseAtLocation(lineNumber, column, line, [ identifier ]) + match symbolUseOpt with + | None -> Assert.Fail "Expected symbol" + | Some symbolUse -> + match symbolUse.Symbol with + | :? FSharpMemberOrFunctionOrValue as mfv -> + let expected = expected.Replace("\r", "") + let signature = mfv.GetValSignatureText(symbolUse.DisplayContext, symbolUse.Range) + Assert.AreEqual(expected, signature.Value) + | symbol -> Assert.Fail $"Expected FSharpMemberOrFunctionOrValue, got %A{symbol}" + + [] + let ``Signature text for let binding`` () = + assertSignature + "val a: b: int -> c: int -> int" + "let a b c = b + c" + (1, 4, "let a b c = b + c", "a") + + [] + let ``Signature text for member binding`` () = + assertSignature + "member Bar: a: int -> b: int -> int" + """ +type Foo() = + member this.Bar (a:int) (b:int) : int = 0 +""" + (3, 19, " member this.Bar (a:int) (b:int) : int = 0", "Bar") + +#if NETCOREAPP + [] + let ``Signature text for type with generic parameter in path`` () = + assertSignature + "new: builder: ImmutableArray<'T>.Builder -> ImmutableArrayViaBuilder<'T>" + """ +module Telplin + +open System +open System.Collections.Generic +open System.Collections.Immutable + +type ImmutableArrayViaBuilder<'T>(builder: ImmutableArray<'T>.Builder) = + class end +""" + (8, 29, "type ImmutableArrayViaBuilder<'T>(builder: ImmutableArray<'T>.Builder) =", ".ctor") +#endif + + [] + let ``Includes attribute for parameter`` () = + assertSignature + "val a: [] c: int -> int" + """ +module Telplin + +type BAttribute() = + inherit System.Attribute() + +let a ([] c: int) : int = 0 +""" + (7, 5, "let a ([] c: int) : int = 0", "a")