diff --git a/src/fsharp/AccessibilityLogic.fs b/src/fsharp/AccessibilityLogic.fs index 8a8fe702846..05325646d11 100644 --- a/src/fsharp/AccessibilityLogic.fs +++ b/src/fsharp/AccessibilityLogic.fs @@ -208,12 +208,13 @@ and IsTypeInstAccessible g amap m ad tinst = /// Indicate if a provided member is accessible let IsProvidedMemberAccessible (amap:Import.ImportMap) m ad ty access = let g = amap.g - let isTyAccessible = IsTypeAccessible g amap m ad ty - if not isTyAccessible then false + if IsTypeAccessible g amap m ad ty then + match tryTcrefOfAppTy g ty with + | ValueNone -> true + | ValueSome tcrefOfViewedItem -> + IsILMemberAccessible g amap m tcrefOfViewedItem ad access else - not (isAppTy g ty) || - let tcrefOfViewedItem = tcrefOfAppTy g ty - IsILMemberAccessible g amap m tcrefOfViewedItem ad access + false /// Compute the accessibility of a provided member let ComputeILAccess isPublic isFamily isFamilyOrAssembly isFamilyAndAssembly = diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index b4dac49c0a1..afb3a536dfd 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -542,7 +542,11 @@ let ConvertSequenceExprToObject g amap overallExpr = // printfn "FAILED - not worth compiling an unrecognized immediate yield! %s " (stringOfRange m) None else - let tyConfirmsToSeq g ty = isAppTy g ty && tyconRefEq g (tcrefOfAppTy g ty) g.tcref_System_Collections_Generic_IEnumerable + let tyConfirmsToSeq g ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> + tyconRefEq g tcref g.tcref_System_Collections_Generic_IEnumerable + | _ -> false match SearchEntireHierarchyOfType (tyConfirmsToSeq g) g amap m (tyOfExpr g arbitrarySeqExpr) with | None -> // printfn "FAILED - yield! did not yield a sequence! %s" (stringOfRange m) diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 829e7b05562..1d2d8910301 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -848,8 +848,8 @@ let MakeMethInfoCall amap m minfo minst args = let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: range, mbase: Tainted) = let methodName = mbase.PUntaint((fun x -> x.Name), m) let declaringType = Import.ImportProvidedType amap m (mbase.PApply((fun x -> x.DeclaringType), m)) - if isAppTy amap.g declaringType then - let declaringEntity = tcrefOfAppTy amap.g declaringType + match tryTcrefOfAppTy amap.g declaringType with + | ValueSome declaringEntity -> if not declaringEntity.IsLocalRef && ccuEq declaringEntity.nlr.Ccu amap.g.fslibCcu then match amap.g.knownIntrinsics.TryGetValue ((declaringEntity.LogicalName, methodName)) with | true, vref -> Some vref @@ -861,7 +861,7 @@ let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: ra | _ -> None else None - else + | _ -> None #endif diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 368b6c3fb03..029769e4d6a 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2398,10 +2398,10 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | _ -> () let errorTextF s = - if isAppTy g ty then - let tcref = tcrefOfAppTy g ty + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> FSComp.SR.undefinedNameFieldConstructorOrMemberWhenTypeIsKnown(tcref.DisplayNameWithStaticParametersAndTypars, s) - else + | _ -> FSComp.SR.undefinedNameFieldConstructorOrMember(s) raze (UndefinedName (depth, errorTextF, id, suggestMembers)) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index a61a719d710..9abd05cfd58 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -17400,10 +17400,7 @@ and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = } and TcSignatureElementsNonMutRec cenv parent typeNames endm env defs = - eventually { - - return! Eventually.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs - } + Eventually.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (defs: SynModuleSigDecl list) = eventually { diff --git a/tests/fsharp/Compiler/Libraries/Core/Collections/CollectionTests.fs b/tests/fsharp/Compiler/Libraries/Core/Collections/CollectionTests.fs new file mode 100644 index 00000000000..934936fd0c3 --- /dev/null +++ b/tests/fsharp/Compiler/Libraries/Core/Collections/CollectionTests.fs @@ -0,0 +1,28 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework + +[] +module ``Array2D Tests`` = + + [] + let ``Iter should not throw on non-zero based 2D arrays``() = + // Regression for FSHARP1.0: 5919 + // bug in array2D functions would cause iter to blow up + + let a = Array2D.createBased 1 5 10 10 0.0 + let testDelegate = TestDelegate (fun _ -> a |> Array2D.iter (printf "%f")) + + Assert.DoesNotThrow testDelegate + + [] + let ``Iteri should not throw on non-zero based 2D arrays``() = + // Regression for FSHARP1.0: 5919 + // bug in array2D functions would cause iteri to blow up + + let a = Array2D.createBased 1 5 10 10 0.0 + let testDelegate = TestDelegate (fun _ -> a |> Array2D.iteri (fun _ _ x -> printf "%f" x)) + + Assert.DoesNotThrow testDelegate \ No newline at end of file diff --git a/tests/fsharp/Compiler/Libraries/Core/Collections/IEnumerableTests.fs b/tests/fsharp/Compiler/Libraries/Core/Collections/IEnumerableTests.fs new file mode 100644 index 00000000000..a2e994bbae1 --- /dev/null +++ b/tests/fsharp/Compiler/Libraries/Core/Collections/IEnumerableTests.fs @@ -0,0 +1,43 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework + +[] +module ``IEnumerable Tests`` = + + // Regression test for FSHARP1.0:4726 + // Makes sure that the .Dispose() method, if available, in invoked on IEnumerable + + let mutable dispose_called_in_E = 0 // we expect this to be incremented 3 times + let mutable dispose_called_in_C = 0 // we expect this to be incremented once (=this is what the bug was about, i.e. .Dispose() was never invoked) + + type E(_c:int) = class + interface System.IDisposable with + member __.Dispose () = dispose_called_in_E <- dispose_called_in_E + 1 + end + + type C() = class + let mutable i = 0 + interface System.Collections.IEnumerator with + member __.Current with get () = new E(i) :> obj + member __.MoveNext () = + i <- i+1 + i<4 + member __.Reset () = i <- 0 + interface System.Collections.IEnumerable with + member x.GetEnumerator () = x :> System.Collections.IEnumerator + + interface System.IDisposable with + member __.Dispose () = dispose_called_in_C <- dispose_called_in_C + 1 + end + end + + [] + let ``Dispose``() = + let _ = Seq.cast (new C()) |> Seq.map (fun x -> use o = x; + o) |> Seq.length + + Assert.areEqual 3 dispose_called_in_E + Assert.areEqual 1 dispose_called_in_C \ No newline at end of file diff --git a/tests/fsharp/Compiler/Libraries/Core/Collections/ListTests.fs b/tests/fsharp/Compiler/Libraries/Core/Collections/ListTests.fs new file mode 100644 index 00000000000..324a0661883 --- /dev/null +++ b/tests/fsharp/Compiler/Libraries/Core/Collections/ListTests.fs @@ -0,0 +1,59 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework +open FSharp.Compiler.SourceCodeServices + +[] +module ``List Tests`` = + + [] + let ``List hd should not exist``() = + // Regression test for FSharp1.0:5641 + // Title: List.hd/tl --> List.head/tail + + CompilerAssert.TypeCheckSingleError + """ +List.hd [1] |> ignore + """ + FSharpErrorSeverity.Error + 39 + (2, 6, 2, 8) + "The value, constructor, namespace or type 'hd' is not defined." + + + + [] + let ``List tl should not exist``() = + // Regression test for FSharp1.0:5641 + // Title: List.hd/tl --> List.head/tail + + CompilerAssert.TypeCheckSingleError + """ +List.tl [1] |> ignore + """ + FSharpErrorSeverity.Error + 39 + (2, 6, 2, 8) + "The value, constructor, namespace or type 'tl' is not defined." + + [] + let ``List head of empty list``() = + let testDelegate = TestDelegate (fun _ -> (List.head [] |> ignore)) + + Assert.Throws testDelegate |> ignore + + [] + let ``List tail of empty list``() = + let testDelegate = TestDelegate (fun _ -> (List.tail [] |> ignore)) + + Assert.Throws testDelegate |> ignore + + [] + let ``List head and tail``() = + Assert.areEqual 1 (List.head [1 .. 10]) + Assert.areEqual "a" (List.head ["a"]) + Assert.areEqual [2 .. 10] (List.tail [1 .. 10]) + Assert.areEqual [] (List.tail [1]) + Assert.areEqual (List.head (List.tail ['a'; 'a'])) (List.head ['a'; 'a']) \ No newline at end of file diff --git a/tests/fsharp/Compiler/Libraries/Core/Collections/MapTests.fs b/tests/fsharp/Compiler/Libraries/Core/Collections/MapTests.fs new file mode 100644 index 00000000000..a0418bb000b --- /dev/null +++ b/tests/fsharp/Compiler/Libraries/Core/Collections/MapTests.fs @@ -0,0 +1,17 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework + +[] +module ``Map Tests`` = + + [] + let ``Equality should be implemented on map``() = + // Dev11:19569 - this used to throw an ArgumentException saying Object didn't implement IComparable + + let m = Map.ofArray [| 1, obj() |] + let testDelegate = TestDelegate (fun _ -> (m = m) |> ignore) + + Assert.DoesNotThrow testDelegate \ No newline at end of file diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 97980a0ad7b..80517837708 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -78,6 +78,10 @@ + + + + diff --git a/tests/fsharpqa/Source/Libraries/Core/Collections/Array2DIter01.fs b/tests/fsharpqa/Source/Libraries/Core/Collections/Array2DIter01.fs deleted file mode 100644 index d230135a676..00000000000 --- a/tests/fsharpqa/Source/Libraries/Core/Collections/Array2DIter01.fs +++ /dev/null @@ -1,10 +0,0 @@ -// #Regression #Libraries #Collections -// Regression for FSHARP1.0: 5919 -// bug in array2D functions would cause iter to blow up - -module M - -let a = Array2D.createBased 1 5 10 10 0.0 -a |> Array2D.iter (printf "%f") - -exit 0 diff --git a/tests/fsharpqa/Source/Libraries/Core/Collections/Array2DIter02.fs b/tests/fsharpqa/Source/Libraries/Core/Collections/Array2DIter02.fs deleted file mode 100644 index 95de7ed0009..00000000000 --- a/tests/fsharpqa/Source/Libraries/Core/Collections/Array2DIter02.fs +++ /dev/null @@ -1,10 +0,0 @@ -// #Regression #Libraries #Collections -// Regression for FSHARP1.0: 5919 -// bug in array2D functions would cause iteri to blow up - -module M - -let a = Array2D.createBased 1 5 10 10 0.0 -a |> Array2D.iteri (fun i j x -> printf "%f" x) - -exit 0 diff --git a/tests/fsharpqa/Source/Libraries/Core/Collections/EqualityOnMap01.fs b/tests/fsharpqa/Source/Libraries/Core/Collections/EqualityOnMap01.fs deleted file mode 100644 index 2b665710186..00000000000 --- a/tests/fsharpqa/Source/Libraries/Core/Collections/EqualityOnMap01.fs +++ /dev/null @@ -1,5 +0,0 @@ -// #Regression #Libraries #Collections -// Dev11:19569 - this used to throw an ArgumentException saying Object didn't implement IComparable - -let m = Map.ofArray [| 1, obj() |] -exit <| if (m = m) then 0 else 1 diff --git a/tests/fsharpqa/Source/Libraries/Core/Collections/Seq_Cast_Dispose01.fs b/tests/fsharpqa/Source/Libraries/Core/Collections/Seq_Cast_Dispose01.fs deleted file mode 100644 index 9ad88b379ad..00000000000 --- a/tests/fsharpqa/Source/Libraries/Core/Collections/Seq_Cast_Dispose01.fs +++ /dev/null @@ -1,38 +0,0 @@ -// #Regression #Libraries #Collections -// -// Regression test for FSHARP1.0:4726 -// Makes sure that the .Dispose() method, if available, in invoked on IEnumerable -// -// This test should probably go under the SystematicUnitTests suite, but -// I could not decide how to make it fit... so I'm leaving it here. -// -// - -let mutable dispose_called_in_E = 0 // we expect this to be incremented 3 times -let mutable dispose_called_in_C = 0 // we expect this to be incremented once (=this is what the bug was about, i.e. .Dispose() was never invoked) - -type E(c:int) = class - interface System.IDisposable with - member x.Dispose () = dispose_called_in_E <- dispose_called_in_E + 1 - end - -type C() = class - let mutable i = 0 - interface System.Collections.IEnumerator with - member x.Current with get () = new E(i) :> obj - member x.MoveNext () = i <- i+1 - i<4 - member x.Reset () = i <- 0 - interface System.Collections.IEnumerable with - member x.GetEnumerator () = x :> System.Collections.IEnumerator - - interface System.IDisposable with - member x.Dispose () = dispose_called_in_C <- dispose_called_in_C + 1 - end - - end - -let _ = Seq.cast (new C()) |> Seq.map (fun x -> use o = x; - o) |> Seq.length - -(if (dispose_called_in_E<>3 && dispose_called_in_C<>1) then 1 else 0) |> exit diff --git a/tests/fsharpqa/Source/Libraries/Core/Collections/env.lst b/tests/fsharpqa/Source/Libraries/Core/Collections/env.lst deleted file mode 100644 index 11b81762be6..00000000000 --- a/tests/fsharpqa/Source/Libraries/Core/Collections/env.lst +++ /dev/null @@ -1,5 +0,0 @@ - SOURCE=seq_cast_dispose01.fs # seq_cast_dispose01.fs - SOURCE=list_head_tail01.fs SCFLAGS="--test:ErrorRanges" # list_head_tail01.fs - SOURCE=Array2DIter01.fs # Array2DIter01.fs - SOURCE=Array2DIter02.fs # Array2DIter02.fs - SOURCE=EqualityOnMap01.fs # EqualityOnMap01.fs \ No newline at end of file diff --git a/tests/fsharpqa/Source/Libraries/Core/Collections/list_head_tail01.fs b/tests/fsharpqa/Source/Libraries/Core/Collections/list_head_tail01.fs deleted file mode 100644 index c8ef0126e5d..00000000000 --- a/tests/fsharpqa/Source/Libraries/Core/Collections/list_head_tail01.fs +++ /dev/null @@ -1,33 +0,0 @@ -// #Regression #Libraries #Collections -// Regression test for FSharp1.0:5641 -// Title: List.hd/tl --> List.head/tail - -//The value, constructor, namespace or type 'hd' is not defined -//The value, constructor, namespace or type 'tl' is not defined - -// Positive tests... -if (List.head [1 .. 10] <> 1) - || (List.head ["a"] <> "a") - || (List.tail [1 .. 10] <> [2 .. 10]) - || (List.tail [1] <> []) - || (List.head ['a'; 'a'] <> List.head (List.tail ['a'; 'a'])) -then exit 1 - -// Negative tests... -try - List.head [] |> ignore - exit 1 -with - | :? System.ArgumentException -> () - -try - List.tail [] |> ignore - exit 1 -with - | :? System.ArgumentException -> () - -// Test deprecation message (now it's an error!) -List.hd [1] |> ignore -List.tl [1] |> ignore - -exit 0