From 1f992d5484cf0e160df1e96c8d5bc8ee7b1f443b Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 14:41:30 +0200 Subject: [PATCH 01/12] Reproduce #1253 --- .../RequireQualifiedAccess/OnRecordVsUnion.fs | 11 +++++++++++ .../NameResolution/RequireQualifiedAccess/env.lst | 1 + 2 files changed, 12 insertions(+) create mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs new file mode 100644 index 00000000000..45222ba64f3 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs @@ -0,0 +1,11 @@ +// #Conformance #TypeInference #Attributes +// Verify the RequireQualifiedAccess attribute works on unions + +module A = + [] + type U = | C + + type C() = + static member M() = () + +let x = A.C.M() \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst index 53cdac9eb37..b728797f909 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst @@ -1,5 +1,6 @@ SOURCE=OnRecord.fs # OnRecord.fs SOURCE=E_OnRecord.fs # E_OnRecord.fs + SOURCE=OnRecordVsUnion.fs # OnRecordVsUnion.fs SOURCE=OnDiscriminatedUnion.fs # OnDiscriminatedUnion.fs SOURCE=E_OnDiscriminatedUnion.fs # E_OnDiscriminatedUnion.fs From e94d90d0926580db77ff91f50b7d745ad07e2e6a Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 15:07:04 +0200 Subject: [PATCH 02/12] Union resolution should not stop other searches --- src/fsharp/NameResolution.fs | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 72de74d869a..4e909445d55 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -845,7 +845,6 @@ let AtMostOneResult m res = match res with | Exception err -> raze err | Result [] -> raze (Error(FSComp.SR.nrInvalidModuleExprType(),m)) - | Result [res] -> success res | Result (res :: _) -> success res //------------------------------------------------------------------------- @@ -1976,19 +1975,25 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Some vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) | _-> - match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> - let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText - let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - let ucinfo = FreshenUnionCaseRef ncenv m ucref - success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest) - | _ -> match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> - - // Something in a type? + // Something in a discrimanted union? + let unionSearch,showDeprecated = + match TryFindTypeWithUnionCase modref id with + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText + let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let ucinfo = FreshenUnionCaseRef ncenv m ucref + success [resInfo,Item.UnionCase(ucinfo,showDeprecated),rest],showDeprecated + | _ -> NoResultsOrUsefulErrors,false + + match unionSearch with + | Result (res :: _) when not showDeprecated -> success res + | _ -> + + // Something in a type? let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) @@ -2012,8 +2017,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN match tyconSearch with | Result (res :: _) -> success res - | _ -> - + | _ -> // Something in a sub-namespace or sub-module let moduleSearch = if not (isNil rest) then @@ -2027,7 +2031,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN else NoResultsOrUsefulErrors - match tyconSearch +++ moduleSearch with + match tyconSearch +++ unionSearch +++ moduleSearch with | Result [] -> let predictedPossibleTypes = modref.ModuleOrNamespaceType.AllEntities From dceea0cff633cac0d95aa1fab7a2e7f019dadfdd Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 15:19:38 +0200 Subject: [PATCH 03/12] reproduce #1294 --- .../RequireQualifiedAccess/OnRecordVsUnion2.fs | 17 +++++++++++++++++ .../RequireQualifiedAccess/env.lst | 1 + 2 files changed, 18 insertions(+) create mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs new file mode 100644 index 00000000000..49ece588f89 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs @@ -0,0 +1,17 @@ +// #Conformance #TypeInference #Attributes +// Verify the RequireQualifiedAccess attribute works on unions + +module Module = + type R = { a: int } with static member New = { a = 1 } + type Choice = | R of R +open Module + +let record1 = R.New +let choice1 v = + match v with + | R r -> r + +let record2 = Module.R.New +let choice2 v = + match v with + | Module.R r -> r \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst index b728797f909..5bd0f043979 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst @@ -2,5 +2,6 @@ SOURCE=E_OnRecord.fs # E_OnRecord.fs SOURCE=OnRecordVsUnion.fs # OnRecordVsUnion.fs + SOURCE=OnRecordVsUnion2.fs # OnRecordVsUnion2.fs SOURCE=OnDiscriminatedUnion.fs # OnDiscriminatedUnion.fs SOURCE=E_OnDiscriminatedUnion.fs # E_OnDiscriminatedUnion.fs From c92208eff2f4b92b63a0225b95b88c48b7ec64b9 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 15:26:55 +0200 Subject: [PATCH 04/12] fix #1294 --- src/fsharp/NameResolution.fs | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 4e909445d55..500f2342590 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1979,20 +1979,6 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> - // Something in a discrimanted union? - let unionSearch,showDeprecated = - match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> - let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText - let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - let ucinfo = FreshenUnionCaseRef ncenv m ucref - success [resInfo,Item.UnionCase(ucinfo,showDeprecated),rest],showDeprecated - | _ -> NoResultsOrUsefulErrors,false - - match unionSearch with - | Result (res :: _) when not showDeprecated -> success res - | _ -> - // Something in a type? let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) @@ -2018,6 +2004,21 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN match tyconSearch with | Result (res :: _) -> success res | _ -> + + // Something in a discriminated union? + let unionSearch,showDeprecated = + match TryFindTypeWithUnionCase modref id with + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText + let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let ucinfo = FreshenUnionCaseRef ncenv m ucref + success [resInfo,Item.UnionCase(ucinfo,showDeprecated),rest],showDeprecated + | _ -> NoResultsOrUsefulErrors,false + + match unionSearch with + | Result (res :: _) when not showDeprecated -> success res + | _ -> + // Something in a sub-namespace or sub-module let moduleSearch = if not (isNil rest) then @@ -2031,7 +2032,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN else NoResultsOrUsefulErrors - match tyconSearch +++ unionSearch +++ moduleSearch with + match tyconSearch +++ moduleSearch +++ unionSearch with | Result [] -> let predictedPossibleTypes = modref.ModuleOrNamespaceType.AllEntities From d9402ee98cf4f8a9bdc218fa349e2e7bb3967d56 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 16:29:10 +0200 Subject: [PATCH 05/12] Show that constructor syntax still works --- .../RequireQualifiedAccess/OnRecordVsUnion2.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs index 49ece588f89..128c972c8f1 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs @@ -11,7 +11,11 @@ let choice1 v = match v with | R r -> r +let newChoice = R { a = 1} + let record2 = Module.R.New let choice2 v = match v with - | Module.R r -> r \ No newline at end of file + | Module.R r -> r + +let newChoice2 = Module.R { a = 1} \ No newline at end of file From fd1c06c9356675c8eef4042e65a45cdb24c77de2 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 17:13:23 +0200 Subject: [PATCH 06/12] Fix shortcut --- src/fsharp/NameResolution.fs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 500f2342590..15ab9ad16f9 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2001,10 +2001,6 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN |> CollectResults (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ) |> MapResults (fun (resInfo,item) -> (resInfo,item,[])) - match tyconSearch with - | Result (res :: _) -> success res - | _ -> - // Something in a discriminated union? let unionSearch,showDeprecated = match TryFindTypeWithUnionCase modref id with From 5adfc1f788be52f350eaa10f35378f9ddad1d886 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 2 Sep 2016 17:45:26 +0200 Subject: [PATCH 07/12] Fix shortcut --- src/fsharp/NameResolution.fs | 4 ++++ tests/fsharp/core/quotes/test.fsx | 34 +++++++++++++++---------------- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 15ab9ad16f9..500f2342590 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2001,6 +2001,10 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN |> CollectResults (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ) |> MapResults (fun (resInfo,item) -> (resInfo,item,[])) + match tyconSearch with + | Result (res :: _) -> success res + | _ -> + // Something in a discriminated union? let unionSearch,showDeprecated = match TryFindTypeWithUnionCase modref id with diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index 556d3ec9fb3..d94fdd3fa66 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -676,26 +676,26 @@ module ErrorEstimateTest = (fun xv yv -> errorEstimateAux t (Map.ofSeq [(x.Name,xv); (y.Name,yv)])) | _ -> failwithf "unrecognized term: %A - expected a lambda of two args" t - let (±) x = Err(x) - //fsi.AddPrinter (fun (x,Err(v)) -> sprintf "%g±%g" x v) + let (±) x = Err(x) + //fsi.AddPrinter (fun (x,Err(v)) -> sprintf "%g±%g" x v) - errorEstimate <@ fun x -> x @> (1.0,±0.1) - errorEstimate <@ fun x -> 2.0*x @> (1.0,±0.1) - errorEstimate <@ fun x -> x*x @> (1.0,±0.1) - errorEstimate <@ fun x -> 1.0/x @> (0.5,±0.1) + errorEstimate <@ fun x -> x @> (1.0,±0.1) + errorEstimate <@ fun x -> 2.0*x @> (1.0,±0.1) + errorEstimate <@ fun x -> x*x @> (1.0,±0.1) + errorEstimate <@ fun x -> 1.0/x @> (0.5,±0.1) errorEstimate <@ fun x -> let y = x + x - y*y + 2.0 @> (1.0,±0.1) + y*y + 2.0 @> (1.0,±0.1) - errorEstimate <@ fun x -> x+2.0*x+3.0*x*x @> (1.0,±0.1) + errorEstimate <@ fun x -> x+2.0*x+3.0*x*x @> (1.0,±0.1) - errorEstimate <@ fun x -> x+2.0*x+3.0/(x*x) @> (0.3,±0.1) + errorEstimate <@ fun x -> x+2.0*x+3.0/(x*x) @> (0.3,±0.1) [] let poly x = x+2.0*x+3.0/(x*x) - errorEstimate <@ poly @> (0.3,±0.1) - errorEstimate <@ poly @> (30271.3,±0.0001) + errorEstimate <@ poly @> (0.3,±0.1) + errorEstimate <@ poly @> (30271.3,±0.0001) *) module Test72594 = let effect (i:int) = () @@ -2071,8 +2071,8 @@ module QuotationsOfLocalFunctions_FSharp_1_0_6403 = // Note for the cases below: We still get temporaries introduced in some quotations, // e.g. Q5 and Q6. The introduction of temporaries is OK according to our V2.0 specification, - // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not - // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing + // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not + // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing // to make that breaking change at a later date. test "cejnewoui5" (match c.Q5 with Let(_, (Int32 1), Call (Some (Value _),_, [_])) -> true | _ -> false) test "cejnewoui6" (match c.Q6 with Let(_, (Int32 2), Call (Some (Value _),_, [_])) -> true | _ -> false) @@ -2089,8 +2089,8 @@ module QuotationsOfLocalFunctions_FSharp_1_0_6403 = // Note for the cases below: We still get temporaries introduced in some quotations, // e.g. Q5 and Q6. The introduction of temporaries is OK according to our V2.0 specification, - // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not - // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing + // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not + // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing // to make that breaking change at a later date. test "scejnewoui5" (match C.SQ5 with Let(_, (Int32 1), Call (None,_, [_])) -> true | _ -> false) test "scejnewoui6" (match C.SQ6 with Let(_, (Int32 2), Call (None,_, [_])) -> true | _ -> false) @@ -2166,7 +2166,7 @@ module OverloadsInTypeExtensions = open Overloads - check "OverloadsInTypeExtensions" (try A.X.TestOverloads() with _ -> false) true + check "OverloadsInTypeExtensions" (try A.X.X.TestOverloads() with _ -> false) true module ArrayQuoteTests = check "cenwkjen" (match <@ [| 2.0;3.0;4.0 |] @> with NewArray (ty, [Double 2.0; Double 3.0; Double 4.0]) -> true | _ -> false) true @@ -2717,4 +2717,4 @@ let aa = if not failures.IsEmpty then (printfn "Test Failed, failures = %A" failures; exit 1) else (stdout.WriteLine "Test Passed"; System.IO.File.WriteAllText("test.ok","ok"); - exit 0) \ No newline at end of file + exit 0) From 21c94b755bce5e0eca6e39375cf49ddd970eb984 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 23 Nov 2016 09:49:42 +0100 Subject: [PATCH 08/12] Adding further tests --- .../RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs | 12 ++++++++++++ .../RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs | 10 ++++++++++ .../OnUnionWithCaseOfSameName.fs | 9 +++++++++ .../OnUnionWithCaseOfSameName2.fs | 10 ++++++++++ .../NameResolution/RequireQualifiedAccess/env.lst | 5 +++++ 5 files changed, 46 insertions(+) create mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs create mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs create mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs create mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs new file mode 100644 index 00000000000..000ca1eab90 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs @@ -0,0 +1,12 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions without RQA + +//This function takes too many arguments, or is used in a context where a function is not expected + +module A = + type U = | C + + type C() = + static member M() = () + +let x:A.U = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs new file mode 100644 index 00000000000..d26a6024967 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs @@ -0,0 +1,10 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions without RQA + +module A = + type U = | C + + type C() = + static member M() = () + +let x = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs new file mode 100644 index 00000000000..eee2b7cdb5c --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs @@ -0,0 +1,9 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions where type name is case name + +module A = + type C = + | B + | C + +let x = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs new file mode 100644 index 00000000000..7148ad9bea2 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs @@ -0,0 +1,10 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions where type name is case name + +module A = + [] + type C = + | B + | C + +let x = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst index 5bd0f043979..dadbaeb4e55 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst @@ -5,3 +5,8 @@ SOURCE=OnRecordVsUnion2.fs # OnRecordVsUnion2.fs SOURCE=OnDiscriminatedUnion.fs # OnDiscriminatedUnion.fs SOURCE=E_OnDiscriminatedUnion.fs # E_OnDiscriminatedUnion.fs + + SOURCE=OnRecordVsUnion_NoRQA.fs # OnRecordVsUnion_NoRQA.fs + SOURCE=OnRecordVsUnion_NoRQA2.fs # OnRecordVsUnion_NoRQA2.fs + SOURCE=OnUnionWithCaseOfSameName.fs # OnUnionWithCaseOfSameName.fs + SOURCE=OnUnionWithCaseOfSameName2.fs # OnUnionWithCaseOfSameName2.fs \ No newline at end of file From a48463dc6fa42aa2f2cb14fecda399faed0e9e92 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 23 Nov 2016 13:03:28 +0100 Subject: [PATCH 09/12] Search for a discriminated union without RequireQualifiedAccess attribute --- src/fsharp/NameResolution.fs | 15 ++++++++++++++- .../RequireQualifiedAccess/OnRecordVsUnion2.fs | 4 +--- .../OnRecordVsUnion_NoRQA.fs | 2 -- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 500f2342590..de2467106cd 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1979,13 +1979,26 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> + // Something in a discriminated union without RequireQualifiedAccess attribute? + let unionSearchWithoutRQA = + match TryFindTypeWithUnionCase modref id with + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) && not (HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs) -> + let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText + let ucinfo = FreshenUnionCaseRef ncenv m ucref + success [resInfo,Item.UnionCase(ucinfo,false),rest] + | _ -> NoResultsOrUsefulErrors + + match unionSearchWithoutRQA with + | Result (res :: _) -> success res + | _ -> + // Something in a type? let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) if not (isNil rest) then let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs,TypeNameResolutionStaticArgsInfo.Indefinite), PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs + ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs // Check if we've got some explicit type arguments else let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs index 128c972c8f1..6ee304d50c0 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs @@ -1,5 +1,4 @@ -// #Conformance #TypeInference #Attributes -// Verify the RequireQualifiedAccess attribute works on unions +// #Conformance #TypeInference #Attributes module Module = type R = { a: int } with static member New = { a = 1 } @@ -13,7 +12,6 @@ let choice1 v = let newChoice = R { a = 1} -let record2 = Module.R.New let choice2 v = match v with | Module.R r -> r diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs index 000ca1eab90..2fb35c7087f 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs @@ -1,8 +1,6 @@ // #Conformance #TypeInference #Attributes // Verify the access works on unions without RQA -//This function takes too many arguments, or is used in a context where a function is not expected - module A = type U = | C From aa7eacbf24f065b03609e8d730ecb1e8441d32f9 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 23 Nov 2016 15:33:04 +0100 Subject: [PATCH 10/12] Don't run union search twice --- src/fsharp/NameResolution.fs | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index de2467106cd..b9a709f7426 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1979,16 +1979,22 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> - // Something in a discriminated union without RequireQualifiedAccess attribute? - let unionSearchWithoutRQA = + let unionSearchResult = match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) && not (HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs) -> + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + Some(tycon,HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs) + | _ -> None + + // Something in a discriminated union without RequireQualifiedAccess attribute? + let unionSearchWithoutRequireQualifiedAccess = + match unionSearchResult with + | Some(tycon,false) -> let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText let ucinfo = FreshenUnionCaseRef ncenv m ucref success [resInfo,Item.UnionCase(ucinfo,false),rest] | _ -> NoResultsOrUsefulErrors - match unionSearchWithoutRQA with + match unionSearchWithoutRequireQualifiedAccess with | Result (res :: _) -> success res | _ -> @@ -2020,12 +2026,11 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN // Something in a discriminated union? let unionSearch,showDeprecated = - match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> - let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText - let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + match unionSearchResult with + | Some(tycon,hasRequireQualifiedAccessAttribute) -> + let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText let ucinfo = FreshenUnionCaseRef ncenv m ucref - success [resInfo,Item.UnionCase(ucinfo,showDeprecated),rest],showDeprecated + success [resInfo,Item.UnionCase(ucinfo,hasRequireQualifiedAccessAttribute),rest],hasRequireQualifiedAccessAttribute | _ -> NoResultsOrUsefulErrors,false match unionSearch with From 0127d859496ae0bb1dbc67136bcfac90c82cac14 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 23 Nov 2016 17:22:37 +0100 Subject: [PATCH 11/12] Simplify code --- src/fsharp/NameResolution.fs | 32 +++++++------------------------- 1 file changed, 7 insertions(+), 25 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index b9a709f7426..5d6a480a3f0 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1979,23 +1979,18 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> - let unionSearchResult = + // Something in a discriminated union without RequireQualifiedAccess attribute? + let unionSearch,hasRequireQualifiedAccessAttribute = match TryFindTypeWithUnionCase modref id with | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> - Some(tycon,HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs) - | _ -> None - - // Something in a discriminated union without RequireQualifiedAccess attribute? - let unionSearchWithoutRequireQualifiedAccess = - match unionSearchResult with - | Some(tycon,false) -> let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText let ucinfo = FreshenUnionCaseRef ncenv m ucref - success [resInfo,Item.UnionCase(ucinfo,false),rest] - | _ -> NoResultsOrUsefulErrors + let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + success [resInfo,Item.UnionCase(ucinfo,hasRequireQualifiedAccessAttribute),rest],hasRequireQualifiedAccessAttribute + | _ -> NoResultsOrUsefulErrors,false - match unionSearchWithoutRequireQualifiedAccess with - | Result (res :: _) -> success res + match unionSearch with + | Result (res :: _) when not hasRequireQualifiedAccessAttribute -> success res | _ -> // Something in a type? @@ -2024,19 +2019,6 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Result (res :: _) -> success res | _ -> - // Something in a discriminated union? - let unionSearch,showDeprecated = - match unionSearchResult with - | Some(tycon,hasRequireQualifiedAccessAttribute) -> - let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText - let ucinfo = FreshenUnionCaseRef ncenv m ucref - success [resInfo,Item.UnionCase(ucinfo,hasRequireQualifiedAccessAttribute),rest],hasRequireQualifiedAccessAttribute - | _ -> NoResultsOrUsefulErrors,false - - match unionSearch with - | Result (res :: _) when not showDeprecated -> success res - | _ -> - // Something in a sub-namespace or sub-module let moduleSearch = if not (isNil rest) then From 318b41dbe95e22550371be7ebc1be7bd2911dff8 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 23 Nov 2016 17:38:29 +0100 Subject: [PATCH 12/12] Fix encoding issue --- tests/fsharp/core/quotes/test.fsx | 34 +++++++++++++++---------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index d94fdd3fa66..556d3ec9fb3 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -676,26 +676,26 @@ module ErrorEstimateTest = (fun xv yv -> errorEstimateAux t (Map.ofSeq [(x.Name,xv); (y.Name,yv)])) | _ -> failwithf "unrecognized term: %A - expected a lambda of two args" t - let (±) x = Err(x) - //fsi.AddPrinter (fun (x,Err(v)) -> sprintf "%g±%g" x v) + let (±) x = Err(x) + //fsi.AddPrinter (fun (x,Err(v)) -> sprintf "%g±%g" x v) - errorEstimate <@ fun x -> x @> (1.0,±0.1) - errorEstimate <@ fun x -> 2.0*x @> (1.0,±0.1) - errorEstimate <@ fun x -> x*x @> (1.0,±0.1) - errorEstimate <@ fun x -> 1.0/x @> (0.5,±0.1) + errorEstimate <@ fun x -> x @> (1.0,±0.1) + errorEstimate <@ fun x -> 2.0*x @> (1.0,±0.1) + errorEstimate <@ fun x -> x*x @> (1.0,±0.1) + errorEstimate <@ fun x -> 1.0/x @> (0.5,±0.1) errorEstimate <@ fun x -> let y = x + x - y*y + 2.0 @> (1.0,±0.1) + y*y + 2.0 @> (1.0,±0.1) - errorEstimate <@ fun x -> x+2.0*x+3.0*x*x @> (1.0,±0.1) + errorEstimate <@ fun x -> x+2.0*x+3.0*x*x @> (1.0,±0.1) - errorEstimate <@ fun x -> x+2.0*x+3.0/(x*x) @> (0.3,±0.1) + errorEstimate <@ fun x -> x+2.0*x+3.0/(x*x) @> (0.3,±0.1) [] let poly x = x+2.0*x+3.0/(x*x) - errorEstimate <@ poly @> (0.3,±0.1) - errorEstimate <@ poly @> (30271.3,±0.0001) + errorEstimate <@ poly @> (0.3,±0.1) + errorEstimate <@ poly @> (30271.3,±0.0001) *) module Test72594 = let effect (i:int) = () @@ -2071,8 +2071,8 @@ module QuotationsOfLocalFunctions_FSharp_1_0_6403 = // Note for the cases below: We still get temporaries introduced in some quotations, // e.g. Q5 and Q6. The introduction of temporaries is OK according to our V2.0 specification, - // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not - // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing + // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not + // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing // to make that breaking change at a later date. test "cejnewoui5" (match c.Q5 with Let(_, (Int32 1), Call (Some (Value _),_, [_])) -> true | _ -> false) test "cejnewoui6" (match c.Q6 with Let(_, (Int32 2), Call (Some (Value _),_, [_])) -> true | _ -> false) @@ -2089,8 +2089,8 @@ module QuotationsOfLocalFunctions_FSharp_1_0_6403 = // Note for the cases below: We still get temporaries introduced in some quotations, // e.g. Q5 and Q6. The introduction of temporaries is OK according to our V2.0 specification, - // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not - // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing + // where compilation of some calls, pattern matching etc. may introduce temporaries. It’s not + // totally ideal: we would prefer if Q5 and Q6 reported “call” quotations, and would be willing // to make that breaking change at a later date. test "scejnewoui5" (match C.SQ5 with Let(_, (Int32 1), Call (None,_, [_])) -> true | _ -> false) test "scejnewoui6" (match C.SQ6 with Let(_, (Int32 2), Call (None,_, [_])) -> true | _ -> false) @@ -2166,7 +2166,7 @@ module OverloadsInTypeExtensions = open Overloads - check "OverloadsInTypeExtensions" (try A.X.X.TestOverloads() with _ -> false) true + check "OverloadsInTypeExtensions" (try A.X.TestOverloads() with _ -> false) true module ArrayQuoteTests = check "cenwkjen" (match <@ [| 2.0;3.0;4.0 |] @> with NewArray (ty, [Double 2.0; Double 3.0; Double 4.0]) -> true | _ -> false) true @@ -2717,4 +2717,4 @@ let aa = if not failures.IsEmpty then (printfn "Test Failed, failures = %A" failures; exit 1) else (stdout.WriteLine "Test Passed"; System.IO.File.WriteAllText("test.ok","ok"); - exit 0) + exit 0) \ No newline at end of file