Merge pull request #9304 from dotnet/merges/master-to-release/dev16.7

Merge master to release/dev16.7

Author: KevinRansom

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 =

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)

src/fsharp/MethodCalls.fs

@@ -848,8 +848,8 @@ let MakeMethInfoCall amap m minfo minst args =
 let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: range, mbase: Tainted<ProvidedMethodBase>) = 
     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
 

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))

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 {

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
+
+[<TestFixture>]
+module ``Array2D Tests`` =
+
+    [<Test>]
+    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
+
+    [<Test>]
+    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

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
+
+[<TestFixture>]
+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
+
+    [<Test>]
+    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

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
+
+[<TestFixture>]
+module ``List Tests`` =
+
+    [<Test>]
+    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."
+
+        
+        
+    [<Test>]
+    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."
+
+    [<Test>]
+    let ``List head of empty list``() =
+        let testDelegate = TestDelegate (fun _ -> (List.head [] |> ignore))
+
+        Assert.Throws<System.ArgumentException> testDelegate |> ignore
+
+    [<Test>]
+    let ``List tail of empty list``() =
+        let testDelegate = TestDelegate (fun _ -> (List.tail [] |> ignore))
+
+        Assert.Throws<System.ArgumentException> testDelegate |> ignore
+
+    [<Test>]
+    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'])

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
+
+[<TestFixture>]
+module ``Map Tests`` =
+
+    [<Test>]
+    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

tests/fsharp/FSharpSuite.Tests.fsproj

@@ -78,6 +78,10 @@
     <Compile Include="Compiler\Stress\LargeExprTests.fs" />
     <Compile Include="Compiler\Regressions\IndexerRegressionTests.fs" />
     <Compile Include="Compiler\Regressions\ForInDoMutableRegressionTest.fs" />
+    <Compile Include="Compiler\Libraries\Core\Collections\IEnumerableTests.fs" />
+    <Compile Include="Compiler\Libraries\Core\Collections\MapTests.fs" />
+    <Compile Include="Compiler\Libraries\Core\Collections\CollectionTests.fs" />
+    <Compile Include="Compiler\Libraries\Core\Collections\ListTests.fs" />
     <None Include="app.config" />
     <None Include="update.base.line.with.actuals.fsx" />