diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 3dd87b80b87..13075a5e6b9 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 @@ -7362,7 +7369,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 @@ -7393,7 +7403,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 @@ -7411,14 +7421,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 82e1c01cbf8..5ce9fa02e69 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -435,7 +435,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 74f62a1c3be..1862e6befe5 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,7 @@ 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'") + ] diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/SuggestionsTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/SuggestionsTests.fs index 7d86ada35e8..419b51b66de 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..71594bc81bf 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -474,3 +474,96 @@ type Foo = (:? FSharpMemberOrFunctionOrValue as setMfv) -> Assert.AreNotEqual(getMfv.CurriedParameterGroups, setMfv.CurriedParameterGroups) | _ -> Assert.Fail "Expected symbols to be FSharpMemberOrFunctionOrValue" + +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