From 28b4ec9e87e46685e90b4896222f253627f4ffba Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 19 Jul 2023 16:08:50 +0200 Subject: [PATCH 1/3] Revert "Fix: 14814 --- Inaccurate error in anonymous record copy-and-update (#15625)" This reverts commit 13072ec08d031afdcb7add8f1fbaad1fbd05512b. --- src/Compiler/Checking/CheckExpressions.fs | 42 ++- src/Compiler/Checking/CheckExpressions.fsi | 2 +- src/Compiler/Checking/CheckPatterns.fs | 5 +- .../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 ++++++++++++++ 8 files changed, 509 insertions(+), 23 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index a46d7cdd15b..32f9a4de039 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1809,10 +1809,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, _) -> @@ -1872,7 +1879,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 @@ -7370,7 +7377,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 @@ -7401,7 +7411,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 @@ -7419,14 +7429,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 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 5e9fb1a9497..16e082f551b 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/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") From 38191654c3fcd90687a57ea3e12e44f17bf70080 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 19 Jul 2023 16:21:25 +0200 Subject: [PATCH 2/3] Checker: fix exception in wrong anon record update --- src/Compiler/Checking/CheckExpressions.fs | 4 ++-- .../Types/RecordTypes/AnonymousRecords.fs | 15 ++++++++++++++- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 32f9a4de039..3f239339a46 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7396,7 +7396,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 @@ -7429,7 +7429,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m errorR(InternalError("Unexpected failure in getting super type", mWholeExpr)) None, tpenv - if fldsList.IsEmpty && isTyparTy g overallTy then + if fldsList.IsEmpty && isTyparTy g overallTy || isAnonRecdTy g overallTy then SolveTypeAsError env.DisplayEnv cenv.css mWholeExpr overallTy mkDefault (mWholeExpr, overallTy), tpenv else diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs index 12ec08fb10a..cfe48c72f0d 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs @@ -74,4 +74,17 @@ module NestedAnonRecds let x = {| abcd = {| ab = 4; cd = 1 |} |} """ |> compile - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + + [] + let ``Wrong update syntax`` () = + Fsx """ +let f (r: {| A: int |}) = + { r with A = 1 } +""" + |> ignoreWarnings + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 39, Line 2, Col 36, Line 2, Col 37, "The record label 'A' is not defined.") + ] From fc2705bc898fa7729a77a3cf5430bac32cd94935 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 19 Jul 2023 16:53:21 +0200 Subject: [PATCH 3/3] Fix baseline --- .../Conformance/Types/RecordTypes/AnonymousRecords.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs index cfe48c72f0d..de9f1909a23 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs @@ -86,5 +86,5 @@ let f (r: {| A: int |}) = |> compile |> shouldFail |> withDiagnostics [ - (Error 39, Line 2, Col 36, Line 2, Col 37, "The record label 'A' is not defined.") + (Error 39, Line 3, Col 14, Line 3, Col 15, "The record label 'A' is not defined.") ]