Skip to content

Commit

Permalink
Merge branch 'master' into fsharp4
Browse files Browse the repository at this point in the history 
Conflicts:
	src/fsharp/FSharp.Core/array.fs
	src/fsharp/FSharp.Core/seq.fs
  • Loading branch information
@latkin
latkin committed Jan 28, 2015
2 parents 58669ae + cacff75 commit f6cea7c
Show file tree
Hide file tree
Showing 12 changed files with 126 additions and 67 deletions.
43 changes: 43 additions & 0 deletions src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,14 @@ open System
open FSharp.Core.Unittests.LibraryTestFx
open NUnit.Framework

module LeakUtils =
// when testing for liveness, the things that we want to observe must always be created in
// a nested function call to avoid the GC (possibly) treating them as roots past the last use in the block.
// We also need something non trivial to disuade the compiler from inlining in Release builds.
type ToRun<'a>(f : unit -> 'a) =
member this.Invoke() = f()

let run (toRun : ToRun<'a>) = toRun.Invoke()

// ---------------------------------------------------

Expand Down Expand Up @@ -191,6 +199,41 @@ type AsyncModule() =

for _i = 1 to 50 do test()


[<Test>]
member this.``Async.AwaitWaitHandle does not leak memory`` () =
// This test checks that AwaitWaitHandle does not leak continuations (described in #131),
// We only test the worst case - when the AwaitWaitHandle is already set.
use manualResetEvent = new System.Threading.ManualResetEvent(true)

let tryToLeak() =
let resource =
LeakUtils.ToRun (fun () ->
let resource = obj()
let work =
async {
let! _ = Async.AwaitWaitHandle manualResetEvent
GC.KeepAlive(resource)
return ()
}

work |> Async.RunSynchronously |> ignore
WeakReference(resource))
|> LeakUtils.run

Assert.IsTrue(resource.IsAlive)

GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()

Assert.IsFalse(resource.IsAlive)

// The leak hangs on a race condition which is really hard to trigger in F# 3.0, hence the 100000 runs...
for _ in 1..100 do tryToLeak()

[<Test>]
member this.``AwaitWaitHandle.DisposedWaitHandle2``() =
let wh = new System.Threading.ManualResetEvent(false)
Expand Down
29 changes: 15 additions & 14 deletions src/fsharp/FSharp.Core/array.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,6 @@ namespace Microsoft.FSharp.Collections
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Core.SR
open Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings
#if FX_NO_ICLONEABLE
open Microsoft.FSharp.Core.ICloneableExtensions
#else
Expand All @@ -36,7 +35,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("Last")>]
let inline last (array : 'T[]) =
checkNonNull "array" array
if array.Length = 0 then invalidArg "array" InputArrayEmptyString
if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
array.[array.Length-1]

[<CompiledName("TryLast")>]
Expand Down Expand Up @@ -205,7 +204,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("Head")>]
let head (array : 'T[]) =
checkNonNull "array" array
if array.Length = 0 then invalidArg "array" InputArrayEmptyString else array.[0]
if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString else array.[0]

[<CompiledName("Copy")>]
let copy (array: 'T[]) =
Expand Down Expand Up @@ -719,18 +718,20 @@ namespace Microsoft.FSharp.Collections
let reduce f (array : _[]) =
checkNonNull "array" array
let len = array.Length
if len = 0 then invalidArg "array" InputArrayEmptyString else
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)
let mutable res = array.[0]
for i = 1 to len - 1 do
res <- f.Invoke(res,array.[i])
res
if len = 0 then
invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
else
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)
let mutable res = array.[0]
for i = 1 to len - 1 do
res <- f.Invoke(res,array.[i])
res

[<CompiledName("ReduceBack")>]
let reduceBack f (array : _[]) =
checkNonNull "array" array
let len = array.Length
if len = 0 then invalidArg "array" InputArrayEmptyString
if len = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
else foldSubRight f array 0 (len - 2) array.[len - 1]

[<CompiledName("SortInPlaceWith")>]
Expand Down Expand Up @@ -843,7 +844,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("Min")>]
let inline min (array:_[]) =
checkNonNull "array" array
if array.Length = 0 then invalidArg "array" InputArrayEmptyString
if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
let mutable acc = array.[0]
for i = 1 to array.Length - 1 do
let curr = array.[i]
Expand All @@ -854,7 +855,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("MinBy")>]
let inline minBy f (array:_[]) =
checkNonNull "array" array
if array.Length = 0 then invalidArg "array" InputArrayEmptyString
if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
let mutable accv = array.[0]
let mutable acc = f accv
for i = 1 to array.Length - 1 do
Expand All @@ -868,7 +869,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("Max")>]
let inline max (array:_[]) =
checkNonNull "array" array
if array.Length = 0 then invalidArg "array" InputArrayEmptyString
if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
let mutable acc = array.[0]
for i = 1 to array.Length - 1 do
let curr = array.[i]
Expand All @@ -879,7 +880,7 @@ namespace Microsoft.FSharp.Collections
[<CompiledName("MaxBy")>]
let inline maxBy f (array:_[]) =
checkNonNull "array" array
if array.Length = 0 then invalidArg "array" InputArrayEmptyString
if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString
let mutable accv = array.[0]
let mutable acc = f accv
for i = 1 to array.Length - 1 do
Expand Down
39 changes: 22 additions & 17 deletions src/fsharp/FSharp.Core/control.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1671,29 +1671,34 @@ namespace Microsoft.FSharp.Control
Action<obj>(fun _ ->
if latch.Enter() then
// if we got here - then we need to unregister RegisteredWaitHandle + trigger cancellation
// entrance to TP callback is protected by latch - so savedCont will never be called
match !rwh with
| None -> ()
| Some rwh -> rwh.Unregister(null) |> ignore
// entrance to TP callback is protected by latch - so savedCont will never be called
lock rwh (fun () ->
match !rwh with
| None -> ()
| Some rwh -> rwh.Unregister(null) |> ignore)
Async.Start (async { do (aux.ccont (OperationCanceledException()) |> unfake) }))

and registration : CancellationTokenRegistration= aux.token.Register(cancelHandler, null)
and registration : CancellationTokenRegistration = aux.token.Register(cancelHandler, null)

let savedCont = args.cont
try
rwh := Some(ThreadPool.RegisterWaitForSingleObject
(waitObject=waitHandle,
callBack=WaitOrTimerCallback(fun _ timeOut ->
if latch.Enter() then
rwh := None
registration.Dispose()
aux.trampolineHolder.Protect (fun () -> savedCont (not timeOut)) |> unfake),
state=null,
millisecondsTimeOutInterval=millisecondsTimeout,
executeOnlyOnce=true));
FakeUnit
lock rwh (fun () ->
rwh := Some(ThreadPool.RegisterWaitForSingleObject
(waitObject=waitHandle,
callBack=WaitOrTimerCallback(fun _ timeOut ->
if latch.Enter() then
lock rwh (fun () -> rwh.Value.Value.Unregister(null) |> ignore)
rwh := None
registration.Dispose()
aux.trampolineHolder.Protect (fun () -> savedCont (not timeOut)) |> unfake),
state=null,
millisecondsTimeOutInterval=millisecondsTimeout,
executeOnlyOnce=true));
FakeUnit)
with _ ->
if latch.Enter() then reraise() // reraise exception only if we successfully enter the latch (no other continuations were called)
if latch.Enter() then
registration.Dispose()
reraise() // reraise exception only if we successfully enter the latch (no other continuations were called)
else FakeUnit
)
#endif
Expand Down
9 changes: 4 additions & 5 deletions src/fsharp/FSharp.Core/local.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@ namespace Microsoft.FSharp.Primitives.Basics

open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Core.Operators
open System.Diagnostics.CodeAnalysis
Expand Down Expand Up @@ -327,7 +326,7 @@ module internal List =


let init count f =
if count < 0 then invalidArg "count" InputMustBeNonNegativeString
if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString
if count = 0 then []
else
let res = freshConsNoTail (f 0)
Expand All @@ -344,7 +343,7 @@ module internal List =
takeFreshConsTail cons2 (n - 1) xs

let take n l =
if n < 0 then invalidArg "count" InputMustBeNonNegativeString
if n < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString
if n = 0 then [] else
match l with
| [] -> raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements))
Expand Down Expand Up @@ -714,7 +713,7 @@ module internal Array =
(# "newarr !0" type ('T) count : 'T array #)

let inline init (count:int) (f: int -> 'T) =
if count < 0 then invalidArg "count" InputMustBeNonNegativeString
if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString
let arr = (zeroCreateUnchecked count : 'T array)
for i = 0 to count - 1 do
arr.[i] <- f i
Expand Down Expand Up @@ -883,4 +882,4 @@ module internal Array =
res.[i] <- array.[startIndex+i]
else
Array.Copy(array, startIndex, res, 0, count)
res
res
14 changes: 7 additions & 7 deletions src/fsharp/FSharp.Core/prim-types.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -656,17 +656,17 @@ namespace Microsoft.FSharp.Core

module LanguagePrimitives =


module (* internal *) ErrorStrings =
[<Sealed>]
type (* internal *) ErrorStrings =
// inline functions cannot call GetString, so we must make these bits public
let AddressOpNotFirstClassString = SR.GetString(SR.addressOpNotFirstClass)
let NoNegateMinValueString = SR.GetString(SR.noNegateMinValue)
static member AddressOpNotFirstClassString with get () = SR.GetString(SR.addressOpNotFirstClass)
static member NoNegateMinValueString with get () = SR.GetString(SR.noNegateMinValue)
// needs to be public to be visible from inline function 'average' and others
let InputSequenceEmptyString = SR.GetString(SR.inputSequenceEmpty)
static member InputSequenceEmptyString with get () = SR.GetString(SR.inputSequenceEmpty)
// needs to be public to be visible from inline function 'average' and others
let InputArrayEmptyString = SR.GetString(SR.arrayWasEmpty)
static member InputArrayEmptyString with get () = SR.GetString(SR.arrayWasEmpty)
// needs to be public to be visible from inline function 'average' and others
let InputMustBeNonNegativeString = SR.GetString(SR.inputMustBeNonNegative)
static member InputMustBeNonNegativeString with get () = SR.GetString(SR.inputMustBeNonNegative)

[<CodeAnalysis.SuppressMessage("Microsoft.Design", "CA1034:NestedTypesShouldNotBeVisible")>] // nested module OK
module IntrinsicOperators =
Expand Down
13 changes: 7 additions & 6 deletions src/fsharp/FSharp.Core/prim-types.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1015,22 +1015,23 @@ namespace Microsoft.FSharp.Core
val inline DivideByInt< ^T > : x:^T -> y:int -> ^T when ^T : (static member DivideByInt : ^T * int -> ^T)

/// <summary>For internal use only</summary>
module (* internal *) ErrorStrings =
[<Sealed>]
type (* internal *) ErrorStrings =

[<CompilerMessage("This value is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val InputSequenceEmptyString : string
static member InputSequenceEmptyString : string with get

[<CompilerMessage("This value is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val InputArrayEmptyString : string
static member InputArrayEmptyString : string with get

[<CompilerMessage("This value is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val AddressOpNotFirstClassString : string
static member AddressOpNotFirstClassString : string with get

[<CompilerMessage("This value is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val NoNegateMinValueString : string
static member NoNegateMinValueString : string with get

[<CompilerMessage("This value is for use by compiled F# code and should not be used directly", 1204, IsHidden=true)>]
val InputMustBeNonNegativeString : string
static member InputMustBeNonNegativeString : string with get


//-------------------------------------------------------------------------
Expand Down
Loading

0 comments on commit f6cea7c

Please sign in to comment.