diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index 0c7bc9b5a17..9a5c59441e2 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -488,6 +488,8 @@ stages: displayName: Publish Test Results inputs: testResultsFormat: 'XUnit' + testRunTitle: WindowsCompressedMetadata $(_testKind) + mergeTestResults: true testResultsFiles: '*.xml' searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_configuration)' continueOnError: true @@ -558,7 +560,9 @@ stages: displayName: Publish Test Results inputs: testResultsFormat: 'XUnit' + testRunTitle: Linux testResultsFiles: '*.xml' + mergeTestResults: true searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() @@ -602,6 +606,8 @@ stages: inputs: testResultsFormat: 'XUnit' testResultsFiles: '*.xml' + testRunTitle: MacOS + mergeTestResults: true searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md index fd5a94681ec..185fa3a015f 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md @@ -20,5 +20,6 @@ * Better ranges for CE `return, yield, return! and yield!` error reporting. ([PR #17792](https://github.com/dotnet/fsharp/pull/17792)) * Better ranges for CE `match!`. ([PR #17789](https://github.com/dotnet/fsharp/pull/17789)) * Better ranges for CE `use` error reporting. ([PR #17811](https://github.com/dotnet/fsharp/pull/17811)) +* Better ranges for `inherit` error reporting. ([PR #17879](https://github.com/dotnet/fsharp/pull/17879)) ### Breaking Changes diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml index e9557ab4f4e..92075c52737 100644 --- a/eng/Version.Details.xml +++ b/eng/Version.Details.xml @@ -1,9 +1,9 @@ - + https://github.com/dotnet/source-build-reference-packages - fd609e3b427601180d23633e2f1a4cdac6c42c20 + f3889ab90d78377122a3e427fe9a74c03611a4bd diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index e739169ea9c..814374417d3 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3622,7 +3622,11 @@ module EstablishTypeDefinitionCores = // Note: for a mutually recursive set we can't check this condition // until "isSealedTy" and "isClassTy" give reliable results. superTy |> Option.iter (fun ty -> - let m = match inherits with | [] -> m | (_, m, _) :: _ -> m + let m = + match inherits with + | [] -> m + | (synType, _, _) :: _ -> synType.Range + if isSealedTy g ty then errorR(Error(FSComp.SR.tcCannotInheritFromSealedType(), m)) elif not (isClassTy g ty) then @@ -4292,7 +4296,7 @@ module TcDeclarations = | SynMemberDefn.AutoProperty (range=m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have auto property", m)) | SynMemberDefn.ImplicitInherit (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveOneInherit(), m)) | SynMemberDefn.LetBindings (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(), m)) - | SynMemberDefn.Inherit (range=m) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(), m)) + | SynMemberDefn.Inherit (trivia= { InheritKeyword = m }) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(), m)) | SynMemberDefn.NestedType (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)) | _ -> () | ds -> @@ -4464,7 +4468,7 @@ module TcDeclarations = let implements2 = members |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) let inherits = members |> List.choose (function - | SynMemberDefn.Inherit (ty, idOpt, m) -> Some(ty, m, idOpt) + | SynMemberDefn.Inherit (ty, idOpt, m, _) -> Some(ty, m, idOpt) | SynMemberDefn.ImplicitInherit (ty, _, idOpt, m) -> Some(ty, m, idOpt) | _ -> None) diff --git a/src/Compiler/Driver/GraphChecking/FileContentMapping.fs b/src/Compiler/Driver/GraphChecking/FileContentMapping.fs index 5fd190b1995..938034623ba 100644 --- a/src/Compiler/Driver/GraphChecking/FileContentMapping.fs +++ b/src/Compiler/Driver/GraphChecking/FileContentMapping.fs @@ -220,7 +220,7 @@ let visitSynMemberDefn (md: SynMemberDefn) : FileContentEntry list = | SynMemberDefn.Interface(interfaceType, _, members, _) -> yield! visitSynType interfaceType yield! collectFromOption (List.collect visitSynMemberDefn) members - | SynMemberDefn.Inherit(baseType, _, _) -> yield! visitSynType baseType + | SynMemberDefn.Inherit(baseType = t) -> yield! visitSynType t | SynMemberDefn.ValField(fieldInfo, _) -> yield! visitSynField fieldInfo | SynMemberDefn.NestedType _ -> () | SynMemberDefn.AutoProperty(attributes = attributes; typeOpt = typeOpt; synExpr = synExpr) -> diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 2623cbde347..7b273f71430 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -814,7 +814,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynMemberDefn.Interface(members = Some membs) -> for m in membs do yield! walkMember m - | SynMemberDefn.Inherit(_, _, m) -> + | SynMemberDefn.Inherit(range = m) -> // can break on the "inherit" clause yield! checkRange m | SynMemberDefn.ImplicitInherit(_, arg, _, m) -> diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index e0957fe0140..ca1a1c5e657 100644 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -996,7 +996,7 @@ module SyntaxTraversal = |> pick x | ok -> ok - | SynMemberDefn.Inherit(synType, _identOption, range) -> traverseInherit (synType, range) + | SynMemberDefn.Inherit(synType, _identOption, range, _) -> traverseInherit (synType, range) | SynMemberDefn.ValField _ -> None | SynMemberDefn.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 0b3f0134545..cfbefd49ade 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -913,7 +913,7 @@ module ParsedInput = walkType t |> Option.orElseWith (fun () -> members |> Option.bind (List.tryPick walkMember)) - | SynMemberDefn.Inherit(t, _, _) -> walkType t + | SynMemberDefn.Inherit(baseType = t) -> walkType t | SynMemberDefn.ValField(fieldInfo = field) -> walkField field @@ -2240,7 +2240,7 @@ module ParsedInput = | SynMemberDefn.Interface(interfaceType = t; members = members) -> walkType t members |> Option.iter (List.iter walkMember) - | SynMemberDefn.Inherit(t, _, _) -> walkType t + | SynMemberDefn.Inherit(baseType = t) -> walkType t | SynMemberDefn.ValField(fieldInfo = field) -> walkField field | SynMemberDefn.NestedType(tdef, _, _) -> walkTypeDefn tdef | SynMemberDefn.AutoProperty(attributes = Attributes attrs; typeOpt = t; synExpr = e) -> diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index fc0c811e55d..81e893592b8 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -1496,7 +1496,7 @@ type SynMemberDefn = | Interface of interfaceType: SynType * withKeyword: range option * members: SynMemberDefns option * range: range - | Inherit of baseType: SynType * asIdent: Ident option * range: range + | Inherit of baseType: SynType * asIdent: Ident option * range: range * trivia: SynMemberDefnInheritTrivia | ValField of fieldInfo: SynField * range: range diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 45b03ad3b75..379362f407c 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -1670,7 +1670,7 @@ type SynMemberDefn = | Interface of interfaceType: SynType * withKeyword: range option * members: SynMemberDefns option * range: range /// An 'inherit' definition within a class - | Inherit of baseType: SynType * asIdent: Ident option * range: range + | Inherit of baseType: SynType * asIdent: Ident option * range: range * trivia: SynMemberDefnInheritTrivia /// A 'val' definition within a class | ValField of fieldInfo: SynField * range: range diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fs b/src/Compiler/SyntaxTree/SyntaxTrivia.fs index 6a550c3b1a8..2cd42701e70 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fs +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fs @@ -420,6 +420,9 @@ type SynMemberDefnAbstractSlotTrivia = static member Zero = { GetSetKeywords = None } +[] +type SynMemberDefnInheritTrivia = { InheritKeyword: range } + [] type SynFieldTrivia = { diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi index f16294b0a1d..ab6525bc010 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi @@ -522,6 +522,10 @@ type SynMemberDefnAbstractSlotTrivia = static member Zero: SynMemberDefnAbstractSlotTrivia +/// Represents additional information for SynMemberDefn.Inherit +[] +type SynMemberDefnInheritTrivia = { InheritKeyword: range } + /// Represents additional information for SynField [] type SynFieldTrivia = diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 185bd1ed842..fac3f30a073 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -2316,7 +2316,8 @@ opt_classDefn: inheritsDefn: | INHERIT atomTypeNonAtomicDeprecated optBaseSpec { let mDecl = unionRanges (rhs parseState 1) $2.Range - SynMemberDefn.Inherit($2, $3, mDecl) } + let trivia = { InheritKeyword = rhs parseState 1 } + SynMemberDefn.Inherit($2, $3, mDecl, trivia) } | INHERIT atomTypeNonAtomicDeprecated opt_HIGH_PRECEDENCE_APP atomicExprAfterType optBaseSpec { let mDecl = unionRanges (rhs parseState 1) $4.Range @@ -2324,8 +2325,9 @@ inheritsDefn: | INHERIT ends_coming_soon_or_recover { let mDecl = (rhs parseState 1) + let trivia = { InheritKeyword = (rhs parseState 1) } if not $2 then errorR (Error(FSComp.SR.parsTypeNameCannotBeEmpty (), mDecl)) - SynMemberDefn.Inherit(SynType.LongIdent(SynLongIdent([], [], [])), None, mDecl) } + SynMemberDefn.Inherit(SynType.LongIdent(SynLongIdent([], [], [])), None, mDecl, trivia) } optAsSpec: | asSpec diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 72dd62e397c..7b65ba798fe 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -2,164 +2,149 @@ module CompilerService.AsyncMemoize open System open System.Threading -open Xunit open Internal.Utilities.Collections open System.Threading.Tasks open System.Diagnostics -open System.Collections.Concurrent + open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Diagnostics -open FSharp.Compiler.BuildGraph +open Xunit -let timeout = TimeSpan.FromSeconds 10. +[] +module internal JobEvents = -let waitFor (mre: ManualResetEvent) = - if not <| mre.WaitOne timeout then - failwith "waitFor timed out" + let publishEvent (cache: AsyncMemoize<_, _, _>) = + let wrapper = Event<_>() + cache.OnEvent (fun e -> lock wrapper <| fun () -> wrapper.Trigger e) + wrapper.Publish |> Event.map (fun (jobEvent, (_,k,_)) -> jobEvent, k) -let waitUntil condition value = - task { - let sw = Stopwatch.StartNew() - while not <| condition value do - if sw.Elapsed > timeout then - failwith "waitUntil timed out" - do! Task.Delay 10 - } + let collectEvents cache = + cache |> publishEvent |> Event.scan (fun es e -> e :: es) [] |> Event.map List.rev -let rec internal spinFor (duration: TimeSpan) = - async { - let sw = Stopwatch.StartNew() - do! Async.Sleep 10 - let remaining = duration - sw.Elapsed - if remaining > TimeSpan.Zero then - return! spinFor remaining - } - -#if BUILDING_WITH_LKG -type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality>(memoize: AsyncMemoize<'a,'b,'c>) as self = -#else -type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality and 'a:not null and 'b:not null>(memoize: AsyncMemoize<'a,'b,'c>) as self = -#endif + /// Exposes a live view of the list of JobEvents generated by AsyncMemoize. + let observe cache = + let updateAvailable = new AutoResetEvent(false) + let mutable recorded = [] - let events = ConcurrentQueue() + let update next = + Debug.WriteLine $"%A{next}" + recorded <- next + updateAvailable.Set() |> ignore - do memoize.OnEvent self.Add + collectEvents cache |> Event.add update - member _.Add (e, (_label, k, _version)) = events.Enqueue (e, k) + let waitForUpdate = updateAvailable |> Async.AwaitWaitHandle |> Async.Ignore - member _.Received value = events |> Seq.exists (fst >> (=) value) - - member _.CountOf value count = events |> Seq.filter (fst >> (=) value) |> Seq.length |> (=) count + async { + Debug.WriteLine $"current: %A{recorded}" + return recorded, waitForUpdate + } - member _.ShouldBe (expected) = - let expected = expected |> Seq.toArray - let actual = events |> Seq.toArray - Assert.Equal<_ array>(expected, actual) + let countOf value count events = events |> Seq.filter (fst >> (=) value) |> Seq.length |> (=) count - member _.Sequence = events |> Seq.map id + let received value events = events |> Seq.exists (fst >> (=) value) + let waitUntil observedCache condition = + let rec loop() = async { + let! current, waitForUpdate = observedCache + if current |> condition |> not then + do! waitForUpdate + return! loop() + } + loop() [] let ``Basics``() = - - let computation key = async { - do! Async.Sleep 1 - return key * 2 - } - - let memoize = AsyncMemoize() - let events = EventRecorder(memoize) - - let result = - seq { - memoize.Get'(5, computation 5) - memoize.Get'(5, computation 5) - memoize.Get'(2, computation 2) - memoize.Get'(5, computation 5) - memoize.Get'(3, computation 3) - memoize.Get'(2, computation 2) + task { + let computation key = async { + do! Async.Sleep 1 + return key * 2 } - |> Async.Parallel - |> Async.RunSynchronously - let expected = [| 10; 10; 4; 10; 6; 4|] + let memoize = AsyncMemoize() + let events = observe memoize + + let result = + seq { + memoize.Get'(5, computation 5) + memoize.Get'(5, computation 5) + memoize.Get'(2, computation 2) + memoize.Get'(5, computation 5) + memoize.Get'(3, computation 3) + memoize.Get'(2, computation 2) + } + |> Async.Parallel + |> Async.RunSynchronously - Assert.Equal(expected, result) + let expected = [| 10; 10; 4; 10; 6; 4|] - (waitUntil (events.CountOf Finished) 3).Wait() + Assert.Equal(expected, result) - let groups = events.Sequence |> Seq.groupBy snd |> Seq.toList - Assert.Equal(3, groups.Length) - for key, events in groups do - Assert.Equal>(Set [ Requested, key; Started, key; Finished, key ], Set events) + do! waitUntil events (countOf Finished 3) + let! current, _ = events + let groups = current |> Seq.groupBy snd |> Seq.toList + Assert.Equal(3, groups.Length) + for key, events in groups do + Assert.Equal>(Set [ Requested, key; Started, key; Finished, key ], Set events) + } [] let ``We can cancel a job`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new ManualResetEventSlim(false) + let cts = new CancellationTokenSource() + let ctsCancelled = new ManualResetEventSlim(false) - let computation action = async { - action() |> ignore - do! spinFor timeout + let computation = async { + use! _catch = Async.OnCancel ignore + jobStarted.Set() + ctsCancelled.Wait() + do! async { } failwith "Should be canceled before it gets here" } let memoize = AsyncMemoize<_, int, _>() - let events = EventRecorder(memoize) - - use cts1 = new CancellationTokenSource() - use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() + let events = observe memoize let key = 1 - let _task1 = Async.StartAsTask( memoize.Get'(key, computation jobStarted.Set), cancellationToken = cts1.Token) - - waitFor jobStarted - jobStarted.Reset() |> ignore + let _task1 = Async.StartAsTask( memoize.Get'(1, computation), cancellationToken = cts.Token) - let _task2 = Async.StartAsTask( memoize.Get'(key, computation ignore), cancellationToken = cts2.Token) - let _task3 = Async.StartAsTask( memoize.Get'(key, computation ignore), cancellationToken = cts3.Token) + jobStarted.Wait() + cts.Cancel() + ctsCancelled.Set() - do! waitUntil (events.CountOf Requested) 3 + do! waitUntil events (received Canceled) + let! current, _ = events - cts1.Cancel() - cts2.Cancel() - - waitFor jobStarted - - cts3.Cancel() - - do! waitUntil events.Received Canceled - - events.ShouldBe [ - Requested, key - Started, key - Requested, key - Requested, key - Restarted, key - Canceled, key - ] + Assert.Equal<_ list>( + [ + Requested, key + Started, key + Canceled, key + ], + current + ) } [] let ``Job is restarted if first requestor cancels`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new SemaphoreSlim(0) - let jobCanComplete = new ManualResetEvent(false) + let jobCanComplete = new ManualResetEventSlim(false) let computation key = async { - jobStarted.Set() |> ignore - waitFor jobCanComplete + jobStarted.Release() |> ignore + + jobCanComplete.Wait() return key * 2 } let memoize = AsyncMemoize<_, int, _>() - let events = EventRecorder(memoize) - + let events = observe memoize use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -169,48 +154,49 @@ let ``Job is restarted if first requestor cancels`` () = let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) - waitFor jobStarted - jobStarted.Reset() |> ignore - + do! jobStarted.WaitAsync() let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) - do! waitUntil (events.CountOf Requested) 3 + do! waitUntil events (countOf Requested 3) cts1.Cancel() - waitFor jobStarted - jobCanComplete.Set() |> ignore + do! jobStarted.WaitAsync() + let! result = _task2 Assert.Equal(2, result) - events.ShouldBe [ - Requested, key + let! current, _ = events + + Assert.Equal<_ list>( + [ Requested, key Started, key Requested, key Requested, key Restarted, key - Finished, key ] + Finished, key ], + current + ) } [] let ``Job is restarted if first requestor cancels but keeps running if second requestor cancels`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new ManualResetEventSlim(false) - let jobCanComplete = new ManualResetEvent(false) + let jobCanComplete = new ManualResetEventSlim(false) let computation key = async { jobStarted.Set() |> ignore - waitFor jobCanComplete + jobCanComplete.Wait() return key * 2 } let memoize = AsyncMemoize<_, int, _>() - let events = EventRecorder(memoize) - + let events = observe memoize use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -220,17 +206,17 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) - waitFor jobStarted + jobStarted.Wait() jobStarted.Reset() |> ignore let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) - do! waitUntil (events.CountOf Requested) 3 + do! waitUntil events (countOf Requested 3) cts1.Cancel() - waitFor jobStarted + jobStarted.Wait() cts2.Cancel() @@ -239,13 +225,17 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let! result = _task3 Assert.Equal(2, result) - events.ShouldBe [ - Requested, key + let! current, _ = events + + Assert.Equal<_ list>( + [ Requested, key Started, key Requested, key Requested, key Restarted, key - Finished, key ] + Finished, key ], + current + ) } @@ -376,59 +366,56 @@ let ``Stress test`` () = [] [] let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = - task { - let cache = AsyncMemoize(cancelDuplicateRunningJobs=cancelDuplicate) - - let mutable started = 0 - let mutable finished = 0 + let cache = AsyncMemoize(cancelDuplicateRunningJobs=cancelDuplicate) - let job1started = new ManualResetEvent(false) - let job1finished = new ManualResetEvent(false) + let mutable started = 0 + let mutable finished = 0 - let jobCanContinue = new ManualResetEvent(false) + let job1started = new ManualResetEventSlim(false) + let job1finished = new ManualResetEventSlim(false) - let job2started = new ManualResetEvent(false) - let job2finished = new ManualResetEvent(false) + let jobCanContinue = new ManualResetEventSlim(false) - let work onStart onFinish = async { - Interlocked.Increment &started |> ignore - onStart() |> ignore - waitFor jobCanContinue - do! spinFor (TimeSpan.FromMilliseconds 100) - Interlocked.Increment &finished |> ignore - onFinish() |> ignore - } + let job2started = new ManualResetEventSlim(false) + let job2finished = new ManualResetEventSlim(false) - let key1 = - { new ICacheKey<_, _> with - member _.GetKey() = 1 - member _.GetVersion() = 1 - member _.GetLabel() = "key1" } + let work onStart onFinish = async { + Interlocked.Increment &started |> ignore + onStart() |> ignore + jobCanContinue.Wait() + do! Async.Sleep 100 + Interlocked.Increment &finished |> ignore + onFinish() |> ignore + } - cache.Get(key1, work job1started.Set job1finished.Set) |> Async.Start + let key1 = + { new ICacheKey<_, _> with + member _.GetKey() = 1 + member _.GetVersion() = 1 + member _.GetLabel() = "key1" } - waitFor job1started + cache.Get(key1, work job1started.Set job1finished.Set) |> Async.Catch |> Async.Ignore |> Async.Start - let key2 = - { new ICacheKey<_, _> with - member _.GetKey() = key1.GetKey() - member _.GetVersion() = key1.GetVersion() + 1 - member _.GetLabel() = "key2" } + job1started.Wait() - cache.Get(key2, work job2started.Set job2finished.Set ) |> Async.Start + let key2 = + { new ICacheKey<_, _> with + member _.GetKey() = key1.GetKey() + member _.GetVersion() = key1.GetVersion() + 1 + member _.GetLabel() = "key2" } - waitFor job2started + cache.Get(key2, work job2started.Set job2finished.Set ) |> Async.Catch |> Async.Ignore |> Async.Start - jobCanContinue.Set() |> ignore + job2started.Wait() - waitFor job2finished + jobCanContinue.Set() |> ignore - if not cancelDuplicate then - waitFor job1finished - - Assert.Equal((2, expectFinished), (started, finished)) - } + job2finished.Wait() + + if not cancelDuplicate then + job1finished.Wait() + Assert.Equal((2, expectFinished), (started, finished)) type DummyException(msg) = inherit Exception(msg) @@ -490,7 +477,7 @@ let ``Preserve thread static diagnostics`` () = let diagnostics = diagnosticsLogger.GetDiagnostics() - //Assert.Equal(3, diagnostics.Length) + Assert.Equal(4, diagnostics.Length) return result, diagnostics } @@ -498,9 +485,9 @@ let ``Preserve thread static diagnostics`` () = let results = (Task.WhenAll tasks).Result - let _diagnosticCounts = results |> Seq.map snd |> Seq.map Array.length |> Seq.groupBy id |> Seq.map (fun (k, v) -> k, v |> Seq.length) |> Seq.sortBy fst |> Seq.toList + let diagnosticCounts = results |> Seq.map snd |> Seq.map Array.length |> Seq.groupBy id |> Seq.map (fun (k, v) -> k, v |> Seq.length) |> Seq.sortBy fst |> Seq.toList - //Assert.Equal<(int * int) list>([4, 100], diagnosticCounts) + Assert.Equal<(int * int) list>([4, 100], diagnosticCounts) let diagnosticMessages = results |> Seq.map snd |> Seq.map (Array.map (fun (d, _) -> d.Exception.Message) >> Array.toList) |> Set @@ -523,7 +510,7 @@ let ``Preserve thread static diagnostics already completed job`` () = return Ok input } - async { + task { let diagnosticsLogger = CompilationDiagnosticLogger($"Testing", FSharpDiagnosticOptions.Default) @@ -534,10 +521,9 @@ let ``Preserve thread static diagnostics already completed job`` () = let diagnosticMessages = diagnosticsLogger.GetDiagnostics() |> Array.map (fun (d, _) -> d.Exception.Message) |> Array.toList - Assert.Equal>(["job 1 error"; "job 1 error"], diagnosticMessages) + Assert.Equal<_ list>(["job 1 error"; "job 1 error"], diagnosticMessages) } - |> Async.StartAsTask [] @@ -550,34 +536,22 @@ let ``We get diagnostics from the job that failed`` () = member _.GetVersion() = 1 member _.GetLabel() = "job1" } - let job (input: int) = async { - let ex = DummyException($"job {input} error") - do! Async.Sleep 100 - DiagnosticsThreadStatics.DiagnosticsLogger.Error(ex) + let job = async { + let ex = DummyException($"job error") + + // no recovery + DiagnosticsThreadStatics.DiagnosticsLogger.Error ex return 5 } - let result = - [1; 2] - |> Seq.map (fun i -> - async { - let diagnosticsLogger = CompilationDiagnosticLogger($"Testing", FSharpDiagnosticOptions.Default) - - use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Optimize) - try - let! _ = cache.Get(key, job i ) - () - with _ -> - () - let diagnosticMessages = diagnosticsLogger.GetDiagnostics() |> Array.map (fun (d, _) -> d.Exception.Message) |> Array.toList - - return diagnosticMessages - }) - |> Async.Parallel - |> Async.StartAsTask - |> (fun t -> t.Result) - |> Array.toList - - Assert.True( - result = [["job 1 error"]; ["job 1 error"]] || - result = [["job 2 error"]; ["job 2 error"]] ) + task { + let logger = CapturingDiagnosticsLogger("AsyncMemoize diagnostics test") + + SetThreadDiagnosticsLoggerNoUnwind logger + + do! cache.Get(key, job ) |> Async.Catch |> Async.Ignore + + let messages = logger.Diagnostics |> List.map fst |> List.map _.Exception.Message + + Assert.Equal<_ list>(["job error"], messages) + } diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/ExceptionDefinitions/ExceptionDefinitions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/ExceptionDefinitions/ExceptionDefinitions.fs index fb7785d3758..1ec630b6e98 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/ExceptionDefinitions/ExceptionDefinitions.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/ExceptionDefinitions/ExceptionDefinitions.fs @@ -289,7 +289,7 @@ module ExceptionDefinition = |> compile |> shouldFail |> withDiagnostics [ - (Error 945, Line 9, Col 5, Line 9, Col 24, "Cannot inherit a sealed type") + (Error 945, Line 9, Col 13, Line 9, Col 22, "Cannot inherit a sealed type") (Error 1133, Line 9, Col 5, Line 9, Col 24, "No constructors are available for the type 'FSharpExn'") ] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/TypeAbbreviations.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/TypeAbbreviations.fs index 80db08b3025..365f1af46b7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/TypeAbbreviations.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/TypeAbbreviations.fs @@ -157,7 +157,7 @@ module TypeAbbreviations = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 945, Line 9, Col 9, Line 9, Col 22, "Cannot inherit a sealed type") + (Error 945, Line 9, Col 17, Line 9, Col 22, "Cannot inherit a sealed type") ] //SOURCE=E_PrivateTypeAbbreviation02.fs SCFLAGS="--test:ErrorRanges" # E_PrivateTypeAbbreviation02.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs index 26acb4b9d0f..0c61d444a9d 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs @@ -195,8 +195,8 @@ module UnionTypes = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 961, Line 10, Col 5, Line 10, Col 22, "This 'inherit' declaration specifies the inherited type but no arguments. Consider supplying arguments, e.g. 'inherit BaseType(args)'.") - (Error 945, Line 10, Col 5, Line 10, Col 22, "Cannot inherit a sealed type") + (Error 961, Line 10, Col 5, Line 10, Col 12, "This 'inherit' declaration specifies the inherited type but no arguments. Consider supplying arguments, e.g. 'inherit BaseType(args)'.") + (Error 945, Line 10, Col 13, Line 10, Col 22, "Cannot inherit a sealed type") ] //SOURCE=E_LowercaseDT.fs # E_LowercaseDT.fs diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs index 55f4d1cbf1b..44e8e202a94 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs @@ -815,4 +815,19 @@ type A() = default this.M() = () """ |> typecheck - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + + [] + let ``This 'inherit' declaration specifies the inherited type but no arguments. Consider supplying arguments, e. g. 'inherit BaseType(args)'`` () = + Fsx """ +type IA = interface end + +type Class() = + inherit IA + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 961, Line 5, Col 5, Line 5, Col 12, "This 'inherit' declaration specifies the inherited type but no arguments. Consider supplying arguments, e.g. 'inherit BaseType(args)'.") + (Error 946, Line 5, Col 13, Line 5, Col 15, "Cannot inherit from interface type. Use interface ... with instead.") + ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs index aff47308ad2..bf3a9cbaac6 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs @@ -12,12 +12,16 @@ open System.Threading.Tasks open FSharp.Compiler.Interactive open FSharp.Compiler.Interactive.Shell open FSharp.Test.ScriptHelpers -open FSharp.Test.Utilities open Xunit type InteractiveTests() = + let copyHousingToTemp() = + let tempName = TestFramework.getTemporaryFileName() + File.Copy(__SOURCE_DIRECTORY__ ++ "housing.csv", tempName + ".csv") + tempName + [] member _.``ValueRestriction error message should not have type variables fully solved``() = use script = new FSharpScript() @@ -248,10 +252,10 @@ System.Configuration.ConfigurationManager.AppSettings.Item "Environment" <- "LOC if RuntimeInformation.ProcessArchitecture = Architecture.Arm64 then () else - let code = @" -#r ""nuget:Microsoft.ML,version=1.4.0-preview"" -#r ""nuget:Microsoft.ML.AutoML,version=0.16.0-preview"" -#r ""nuget:Microsoft.Data.Analysis,version=0.4.0"" + let code = $""" +#r "nuget:Microsoft.ML,version=1.4.0-preview" +#r "nuget:Microsoft.ML.AutoML,version=0.16.0-preview" +#r "nuget:Microsoft.Data.Analysis,version=0.4.0" open System open System.IO @@ -267,7 +271,7 @@ let Shuffle (arr:int[]) = arr.[i] <- temp arr -let housingPath = ""housing.csv"" +let housingPath = @"{copyHousingToTemp()}.csv" let housingData = DataFrame.LoadCsv(housingPath) let randomIndices = (Shuffle(Enumerable.Range(0, (int (housingData.Rows.Count) - 1)).ToArray())) let testSize = int (float (housingData.Rows.Count) * 0.1) @@ -281,11 +285,11 @@ open Microsoft.ML.AutoML let mlContext = MLContext() let experiment = mlContext.Auto().CreateRegressionExperiment(maxExperimentTimeInSeconds = 15u) -let result = experiment.Execute(housing_train, labelColumnName = ""median_house_value"") +let result = experiment.Execute(housing_train, labelColumnName = "median_house_value") let details = result.RunDetails -printfn ""%A"" result +printfn "{@"%A"}" result 123 -" +""" use script = new FSharpScript(additionalArgs=[| |]) let opt = script.Eval(code) |> getValue let value = opt.Value @@ -511,3 +515,4 @@ let add (col:IServiceCollection) = use script = new FSharpScript(additionalArgs=[| |]) let _value,diag = script.Eval(code) Assert.Empty(diag) + diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index 16b0ff7b878..4769b4c322d 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -385,22 +385,17 @@ module BuildGraphTests = for i in 1 .. 300 do async { - Interlocked.Increment(&count) |> ignore - errorR (ExampleException $"{i}") + errorR (ExampleException $"{Interlocked.Increment(&count)}") + error (ExampleException $"{Interlocked.Increment(&count)}") } ] - let run = - tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.StartAsTask - - Assert.True( - run.Wait(1000), - "MultipleDiagnosticsLoggers.Parallel did not finish." - ) - - // Diagnostics from all started tasks should be collected despite the exception. - errorCountShouldBe count + task { + do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore + // Diagnostics from all started tasks should be collected despite the exception. + errorCountShouldBe count + } [] let ``AsyncLocal diagnostics context flows correctly`` () = diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 15e1dd848e6..f08d67883b7 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -8151,7 +8151,13 @@ FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAu FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewGetSetMember(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynBinding], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynBinding], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberGetSetTrivia) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitCtor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynPat, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberDefnImplicitCtorTrivia) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitInherit(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInherit(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynMemberDefn+Inherit: FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia get_trivia() +FSharp.Compiler.Syntax.SynMemberDefn+Inherit: FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia trivia +FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInherit(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia) +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: FSharp.Compiler.Text.Range InheritKeyword +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: FSharp.Compiler.Text.Range get_InheritKeyword() +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: System.String ToString() +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: Void .ctor(FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInterface(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberDefn]], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewLetBindings(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], Boolean, Boolean, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewMember(FSharp.Compiler.Syntax.SynBinding, FSharp.Compiler.Text.Range) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 15e1dd848e6..f08d67883b7 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -8151,7 +8151,13 @@ FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAu FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewGetSetMember(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynBinding], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynBinding], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberGetSetTrivia) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitCtor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynPat, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberDefnImplicitCtorTrivia) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitInherit(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInherit(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynMemberDefn+Inherit: FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia get_trivia() +FSharp.Compiler.Syntax.SynMemberDefn+Inherit: FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia trivia +FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInherit(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia) +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: FSharp.Compiler.Text.Range InheritKeyword +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: FSharp.Compiler.Text.Range get_InheritKeyword() +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: System.String ToString() +FSharp.Compiler.SyntaxTrivia.SynMemberDefnInheritTrivia: Void .ctor(FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInterface(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMemberDefn]], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewLetBindings(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynBinding], Boolean, Boolean, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewMember(FSharp.Compiler.Syntax.SynBinding, FSharp.Compiler.Text.Range) diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs index 78d03ac8a9b..5752f9de41c 100644 --- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs @@ -123,7 +123,14 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () = let weakTcImports = test () checker.InvalidateConfiguration Project1.options checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() - GC.Collect(2, GCCollectionMode.Forced, blocking = true) + + //collect 2 more times for good measure, + // See for example: https://github.com/dotnet/runtime/discussions/108081 + GC.Collect() + GC.WaitForPendingFinalizers() + GC.Collect() + GC.WaitForPendingFinalizers() + Assert.False weakTcImports.IsAlive [] diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 145d9a70c3e..213ff435adf 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -7,6 +7,7 @@ namespace FSharp.Core.UnitTests.Control open System open System.Threading +open System.Threading.Tasks open FSharp.Core.UnitTests.LibraryTestFx open Xunit open FsCheck @@ -273,8 +274,7 @@ type AsyncModule() = } Async.RunSynchronously test - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.``OnCancel.RaceBetweenCancellationHandlerAndDisposingHandlerRegistration``() = let test() = use flag = new ManualResetEvent(false) @@ -297,8 +297,7 @@ type AsyncModule() = for _i = 1 to 300 do test() - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.``OnCancel.RaceBetweenCancellationAndDispose``() = let mutable flag = 0 let cts = new System.Threading.CancellationTokenSource() @@ -316,8 +315,7 @@ type AsyncModule() = :? System.OperationCanceledException -> () Assert.AreEqual(1, flag) - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.``OnCancel.CancelThatWasSignalledBeforeRunningTheComputation``() = let test() = let cts = new System.Threading.CancellationTokenSource() @@ -379,23 +377,25 @@ type AsyncModule() = [] member _.``AwaitWaitHandle.DisposedWaitHandle2``() = - let wh = new System.Threading.ManualResetEvent(false) - let barrier = new System.Threading.ManualResetEvent(false) + let wh = new ManualResetEvent(false) + let started = new ManualResetEventSlim(false) - let test = async { - let! timeout = Async.AwaitWaitHandle(wh, 10000) - Assert.False(timeout, "Timeout expected") - barrier.Set() |> ignore + let test = + async { + started.Set() + let! timeout = Async.AwaitWaitHandle(wh, 5000) + Assert.False(timeout, "Timeout expected") } - Async.Start test - - // await 3 secs then dispose waithandle - nothing should happen - let timeout = wait barrier 3000 - Assert.False(timeout, "Barrier was reached too early") - dispose wh - - let ok = wait barrier 10000 - if not ok then Assert.Fail("Async computation was not completed in given time") + |> Async.StartAsTask + + task { + started.Wait() + // Wait a moment then dispose waithandle - nothing should happen + do! Task.Delay 500 + Assert.False(test.IsCompleted, "Test completed too early") + dispose wh + do! test + } [] member _.``RunSynchronously.NoThreadJumpsAndTimeout``() = @@ -467,22 +467,24 @@ type AsyncModule() = [] member _.``error on one workflow should cancel all others``() = - let counter = - async { - let mutable counter = 0 - let job i = async { - if i = 55 then failwith "boom" - else - do! Async.Sleep 1000 - counter <- counter + 1 - } - - let! _ = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch - do! Async.Sleep 5000 - return counter - } |> Async.RunSynchronously + task { + use failOnlyOne = new Semaphore(0, 1) + let mutable cancelled = 0 + let mutable started = 0 + + let job i = async { + Interlocked.Increment &started |> ignore + use! holder = Async.OnCancel (fun () -> Interlocked.Increment &cancelled |> ignore) + do! failOnlyOne |> Async.AwaitWaitHandle |> Async.Ignore + failwith "boom" + } - Assert.AreEqual(0, counter) + let test = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch |> Async.Ignore |> Async.StartAsTask + do! Task.Delay 100 + failOnlyOne.Release() |> ignore + do! test + Assert.Equal(started - 1, cancelled) + } [] member _.``AwaitWaitHandle.ExceptionsAfterTimeout``() = @@ -641,7 +643,6 @@ type AsyncModule() = member _.``Parallel with maxDegreeOfParallelism`` () = let mutable i = 1 let action j = async { - do! Async.Sleep 1 Assert.Equal(j, i) i <- i + 1 } diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 950432ccc8e..1b15be8fa98 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -54,16 +54,20 @@ type AsyncType() = [] member _.AsyncRunSynchronouslyReusesThreadPoolThread() = - let action = async { async { () } |> Async.RunSynchronously } - let computation = - [| for i in 1 .. 1000 -> action |] - |> Async.Parallel + let action _ = + async { + return + async { return Thread.CurrentThread.ManagedThreadId } + |> Async.RunSynchronously + } // This test needs approximately 1000 ThreadPool threads // if Async.RunSynchronously doesn't reuse them. - // In such case TimeoutException is raised - // since ThreadPool cannot provide 1000 threads in 1 second - // (the number of threads in ThreadPool is adjusted slowly). - Async.RunSynchronously(computation, timeout = 1000) |> ignore + let usedThreads = + Seq.init 1000 action + |> Async.Parallel + |> Async.RunSynchronously + |> Set.ofArray + Assert.True(usedThreads.Count < 256, $"RunSynchronously used {usedThreads.Count} threads.") [] [] @@ -231,7 +235,8 @@ type AsyncType() = use t = Async.StartAsTask a let mutable exceptionThrown = false try - waitASec t + // waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (t.IsFaulted) @@ -269,7 +274,7 @@ type AsyncType() = // printfn "%A" t.Status let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) @@ -302,56 +307,50 @@ type AsyncType() = use t = Async.StartImmediateAsTask a let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (t.IsFaulted) Assert.True(exceptionThrown) -#if IGNORED [] - [] member _.CancellationPropagatesToImmediateTask () = let a = async { - while true do () + while true do + do! Async.Sleep 100 } use t = Async.StartImmediateAsTask a Async.CancelDefaultToken () let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) -#endif -#if IGNORED [] - [] member _.CancellationPropagatesToGroupImmediate () = let ewh = new ManualResetEvent(false) - let cancelled = ref false + let mutable cancelled = false let a = async { - use! holder = Async.OnCancel (fun _ -> cancelled := true) + use! holder = Async.OnCancel (fun _ -> cancelled <- true) ewh.Set() |> Assert.True - while true do () + while true do + do! Async.Sleep 100 } let cts = new CancellationTokenSource() let token = cts.Token use t = Async.StartImmediateAsTask(a, cancellationToken=token) -// printfn "%A" t.Status ewh.WaitOne() |> Assert.True cts.Cancel() -// printfn "%A" t.Status let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) - Assert.True(!cancelled) -#endif + Assert.True(cancelled) [] member _.TaskAsyncValue () = @@ -411,8 +410,7 @@ type AsyncType() = } Async.RunSynchronously(a) |> Assert.True - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.TaskAsyncValueCancellation () = use ewh = new ManualResetEvent(false) let cts = new CancellationTokenSource() @@ -430,9 +428,11 @@ type AsyncType() = :? TaskCanceledException -> ewh.Set() |> ignore // this is ok } - Async.Start a + let t1 = Async.StartAsTask a cts.Cancel() ewh.WaitOne(10000) |> ignore + // Don't leave unobserved background tasks, because they can crash the test run. + t1.Wait() [] member _.NonGenericTaskAsyncValue () = @@ -473,9 +473,10 @@ type AsyncType() = :? TaskCanceledException -> ewh.Set() |> ignore // this is ok } - Async.Start a + let t1 = Async.StartAsTask a cts.Cancel() ewh.WaitOne(10000) |> ignore + t1.Wait() [] member _.CancellationExceptionThrown () = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs index 4e04f64bc1f..cecfaec7590 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs @@ -5,7 +5,9 @@ namespace FSharp.Core.UnitTests.Control open System open FSharp.Core.UnitTests.LibraryTestFx open Xunit +open FSharp.Test open System.Threading +open System.Threading.Tasks type CancellationType() = @@ -229,6 +231,7 @@ type CancellationType() = } asyncs |> Async.Parallel |> Async.RunSynchronously |> ignore + // See https://github.com/dotnet/fsharp/issues/3254 [] member this.AwaitTaskCancellationAfterAsyncTokenCancellation() = let StartCatchCancellation cancellationToken (work) = @@ -262,11 +265,11 @@ type CancellationType() = let cts = new CancellationTokenSource() let tcs = System.Threading.Tasks.TaskCompletionSource<_>() - let t = + let test() = async { do! tcs.Task |> Async.AwaitTask } - |> StartAsTaskProperCancel None (Some cts.Token) + |> StartAsTaskProperCancel None (Some cts.Token) :> Task // First cancel the token, then set the task as cancelled. async { @@ -274,15 +277,31 @@ type CancellationType() = cts.Cancel() do! Async.Sleep 100 tcs.TrySetException (TimeoutException "Task timed out after token.") - |> ignore + |> ignore } |> Async.Start - try - let res = t.Wait(2000) - let msg = sprintf "Excepted TimeoutException wrapped in an AggregateException, but got %A" res - printfn "failure msg: %s" msg - Assert.Fail (msg) - with :? AggregateException as agg -> () + task { + let! agg = Assert.ThrowsAsync(test) + let inner = agg.InnerException + Assert.True(inner :? TimeoutException, $"Excepted TimeoutException wrapped in an AggregateException, but got %A{inner}") + } + + // Simpler regression test for https://github.com/dotnet/fsharp/issues/3254 + [] + member this.AwaitTaskCancellationAfterAsyncTokenCancellation2() = + let tcs = new TaskCompletionSource() + let cts = new CancellationTokenSource() + let _ = cts.Token.Register(fun () -> tcs.SetResult 42) + Assert.ThrowsAsync( fun () -> + Async.StartAsTask( + async { + cts.CancelAfter 100 + let! result = tcs.Task |> Async.AwaitTask + return result + }, + cancellationToken = cts.Token + ) + ) [] member this.Equality() = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index 904bc7dc622..f3964aaa78c 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -125,7 +125,7 @@ type MailboxProcessorType() = use mre2 = new ManualResetEventSlim(false) // https://github.com/dotnet/fsharp/issues/3337 - let cts = new CancellationTokenSource () + use cts = new CancellationTokenSource () let addMsg msg = match result with @@ -204,25 +204,24 @@ type MailboxProcessorType() = [] member this.``Receive Races with Post``() = - let receiveEv = new ManualResetEvent(false) - let postEv = new ManualResetEvent(false) - let finishedEv = new ManualResetEvent(false) + let receiveEv = new AutoResetEvent(false) + let postEv = new AutoResetEvent(false) + let finishedEv = new AutoResetEvent(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start ( fun inbox -> async { while true do - let w = receiveEv.WaitOne() - receiveEv.Reset() |> ignore + receiveEv.WaitOne() |> ignore let! (msg) = inbox.Receive () finishedEv.Set() |> ignore }) let post = async { - while true do - let r = postEv.WaitOne() - postEv.Reset() |> ignore + while not cts.IsCancellationRequested do + postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.Start + } |> Async.StartAsTask for i in 0 .. 100000 do if i % 2 = 0 then receiveEv.Set() |> ignore @@ -232,19 +231,23 @@ type MailboxProcessorType() = receiveEv.Set() |> ignore finishedEv.WaitOne() |> ignore - finishedEv.Reset() |> ignore + + cts.Cancel() + // Let the post task finish. + postEv.Set() |> ignore + post.Wait() [] member this.``Receive Races with Post on timeout``() = - let receiveEv = new ManualResetEvent(false) - let postEv = new ManualResetEvent(false) - let finishedEv = new ManualResetEvent(false) + let receiveEv = new AutoResetEvent(false) + let postEv = new AutoResetEvent(false) + let finishedEv = new AutoResetEvent(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start ( fun inbox -> async { while true do - let w = receiveEv.WaitOne() - receiveEv.Reset() |> ignore + receiveEv.WaitOne() |> ignore let! (msg) = inbox.Receive (5000) finishedEv.Set() |> ignore }) @@ -252,12 +255,11 @@ type MailboxProcessorType() = let isErrored = mb.Error |> Async.AwaitEvent |> Async.StartAsTask let post = - async { - while true do - let r = postEv.WaitOne() - postEv.Reset() |> ignore + backgroundTask { + while not cts.IsCancellationRequested do + postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.Start + } for i in 0 .. 10000 do if i % 2 = 0 then @@ -271,32 +273,35 @@ type MailboxProcessorType() = if isErrored.IsCompleted then raise <| Exception("Mailbox should not fail!", isErrored.Result) - finishedEv.Reset() |> ignore + cts.Cancel() + // Let the post task finish. + postEv.Set() |> ignore + post.Wait() [] member this.``TryReceive Races with Post on timeout``() = - let receiveEv = new ManualResetEvent(false) - let postEv = new ManualResetEvent(false) - let finishedEv = new ManualResetEvent(false) + let receiveEv = new AutoResetEvent(false) + let postEv = new AutoResetEvent(false) + let finishedEv = new AutoResetEvent(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start ( fun inbox -> async { while true do - let w = receiveEv.WaitOne() - receiveEv.Reset() |> ignore + receiveEv.WaitOne() |> ignore let! (msg) = inbox.TryReceive (5000) finishedEv.Set() |> ignore - }) + } + ) let isErrored = mb.Error |> Async.AwaitEvent |> Async.StartAsTask let post = - async { - while true do - let r = postEv.WaitOne() - postEv.Reset() |> ignore + backgroundTask { + while not cts.IsCancellationRequested do + postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.Start + } for i in 0 .. 10000 do if i % 2 = 0 then @@ -310,7 +315,9 @@ type MailboxProcessorType() = if isErrored.IsCompleted then raise <| Exception("Mailbox should not fail!", isErrored.Result) - finishedEv.Reset() |> ignore + cts.Cancel() + postEv.Set() |> ignore + post.Wait() [] member this.``After dispose is called, mailbox should stop receiving and processing messages``() = task { @@ -397,6 +404,7 @@ type MailboxProcessorType() = Assert.Equal(expectedMessagesCount, actualMessagesCount) Assert.Equal(0, actualSkipMessagesCount) Assert.Equal(0, mb.CurrentQueueLength) + } [] @@ -496,3 +504,56 @@ type MailboxProcessorType() = // If StartImmediate worked correctly, the information should be identical since // the threads should be the same. Assert.Equal(callingThreadInfo, mailboxThreadInfo) + +module MailboxProcessorType = + + [] + let TryScan () = + let tcs = TaskCompletionSource<_>() + use mailbox = + new MailboxProcessor(fun inbox -> async { + do! + inbox.TryScan( function + | Reset -> async { tcs.SetResult "Reset processed" } |> Some + | _ -> None) + |> Async.Ignore + }) + mailbox.Start() + + for i in 1 .. 100 do + mailbox.Post(Increment i) + mailbox.Post Reset + + Assert.Equal("Reset processed", tcs.Task.Result) + Assert.Equal(100, mailbox.CurrentQueueLength) + + [] + let ``TryScan with timeout`` () = + let tcs = TaskCompletionSource<_>() + use mailbox = + new MailboxProcessor(fun inbox -> + let rec loop i = async { + match! + inbox.TryScan( function + | Reset -> async { tcs.SetResult i } |> Some + | _ -> None) + with + | None -> do! loop (i + 1) + | _ -> () + } + loop 1 + ) + mailbox.DefaultTimeout <- 10 + mailbox.Start() + + let iteration = + task { + for i in 1 .. 100 do + mailbox.Post(Increment 1) + do! Task.Delay 10 + mailbox.Post Reset + + return! tcs.Task + } + + Assert.True(iteration.Result > 1, "TryScan did not timeout") diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs index 5d533b880c3..8097c2d10f5 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs @@ -236,15 +236,16 @@ type Basics() = [] member _.testNonBlocking() = printfn "Running testNonBlocking..." - let sw = Stopwatch() - sw.Start() + let allowContinue = new SemaphoreSlim(0) + let finished = new ManualResetEventSlim() let t = task { - do! Task.Yield() + do! allowContinue.WaitAsync() Thread.Sleep(100) + finished.Set() } - sw.Stop() - require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" + allowContinue.Release() |> ignore + require (not finished.IsSet) "sleep blocked caller" t.Wait() [] @@ -908,58 +909,60 @@ type Basics() = [] member _.testExceptionThrownInFinally() = printfn "running testExceptionThrownInFinally" - for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + for i in 1 .. 5 do + use stepOutside = new SemaphoreSlim(0) + use ranInitial = new ManualResetEventSlim() + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = task { try - ranInitial <- true + ranInitial.Set() do! Task.Yield() Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true + ranNext.Set() finally ranFinally <- ranFinally + 1 failtest "finally exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + require ranInitial.IsSet "didn't run initial" + require (not ranNext.IsSet) "ran next too early" try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] member _.test2ndExceptionThrownInFinally() = printfn "running test2ndExceptionThrownInFinally" for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + use ranInitial = new ManualResetEventSlim() + use continueTask = new SemaphoreSlim(0) + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = task { try - ranInitial <- true + ranInitial.Set() + do! continueTask.WaitAsync() + ranNext.Set() do! Task.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true failtest "uhoh" finally ranFinally <- ranFinally + 1 failtest "2nd exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + ranInitial.Wait() + continueTask.Release() |> ignore try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs index c811aecaa5c..7f844e99d96 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs @@ -357,15 +357,16 @@ type Basics() = [] member _.testNonBlocking() = printfn "Running testNonBlocking..." - let sw = Stopwatch() - sw.Start() + let allowContinue = new SemaphoreSlim(0) + let finished = new ManualResetEventSlim() let t = taskDynamic { - do! Task.Yield() + do! allowContinue.WaitAsync() Thread.Sleep(100) + finished.Set() } - sw.Stop() - require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" + allowContinue.Release() |> ignore + require (not finished.IsSet) "sleep blocked caller" t.Wait() [] @@ -982,58 +983,60 @@ type Basics() = [] member _.testExceptionThrownInFinally() = printfn "running testExceptionThrownInFinally" - for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + for i in 1 .. 5 do + use stepOutside = new SemaphoreSlim(0) + use ranInitial = new ManualResetEventSlim() + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = taskDynamic { try - ranInitial <- true + ranInitial.Set() do! Task.Yield() Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true + ranNext.Set() finally ranFinally <- ranFinally + 1 failtest "finally exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + require ranInitial.IsSet "didn't run initial" + require (not ranNext.IsSet) "ran next too early" try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] member _.test2ndExceptionThrownInFinally() = printfn "running test2ndExceptionThrownInFinally" for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + use ranInitial = new ManualResetEventSlim() + use continueTask = new SemaphoreSlim(0) + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = taskDynamic { try - ranInitial <- true + ranInitial.Set() + do! continueTask.WaitAsync() + ranNext.Set() do! Task.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true failtest "uhoh" finally ranFinally <- ranFinally + 1 failtest "2nd exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + ranInitial.Wait() + continueTask.Release() |> ignore try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] diff --git a/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs b/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs index 708e7e58e2e..3b83b97db7a 100644 --- a/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs +++ b/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs @@ -8,7 +8,7 @@ open FSharp.Test module AsyncTests = // Regression for FSHARP1.0:5969 // Async.StartChild: error when wait async is executed more than once - [] + [] let ``Execute Async multiple times``() = CompilerAssert.CompileExeAndRun """ @@ -24,13 +24,12 @@ let a = async { return result } |> Async.RunSynchronously -exit 0 """ // Regression for FSHARP1.0:5970 // Async.StartChild: race in implementation of ResultCell in FSharp.Core - [] + [] let ``Joining StartChild``() = CompilerAssert.CompileExeAndRun """ @@ -54,12 +53,10 @@ let r = with _ -> (0,0) -exit 0 - """ // Regression test for FSHARP1.0:6086 - [] + [] let ``Mailbox Async dot not StackOverflow``() = CompilerAssert.CompileExeAndRun """ @@ -128,12 +125,11 @@ for meet in meets do printfn "%d" meet printfn "Total: %d in %O" (Seq.sum meets) (watch.Elapsed) -exit 0 """ // Regression for FSHARP1.0:5971 - [] + [] let ``StartChild do not throw ObjectDisposedException``() = CompilerAssert.CompileExeAndRun """ @@ -142,10 +138,9 @@ module M let b = async {return 5} |> Async.StartChild printfn "%A" (b |> Async.RunSynchronously |> Async.RunSynchronously) -exit 0 """ - [] + [] let ``StartChild test Trampoline HijackLimit``() = CompilerAssert.CompileExeAndRun """ @@ -164,5 +159,4 @@ let r = () } |> Async.RunSynchronously -exit 0 """ diff --git a/tests/fsharp/core/controlMailbox/test.fsx b/tests/fsharp/core/controlMailbox/test.fsx index 98d6a7d2f31..5aa65035ecd 100644 --- a/tests/fsharp/core/controlMailbox/test.fsx +++ b/tests/fsharp/core/controlMailbox/test.fsx @@ -6,9 +6,7 @@ module Core_controlMailBox #nowarn "40" // recursive references -#if NETCOREAPP open System.Threading.Tasks -#endif let biggerThanTrampoliningLimit = 10000 @@ -49,22 +47,27 @@ let checkQuiet s x1 x2 = (test s false; log (sprintf "expected: %A, got %A" x2 x1)) -let check s x1 x2 = +let check s x1 x2 = if x1 = x2 then test s true else (test s false; log (sprintf "expected: %A, got %A" x2 x1)) +let checkAsync s (x1: Task<_>) x2 = check s x1.Result x2 + open Microsoft.FSharp.Control -open Microsoft.FSharp.Control.WebExtensions module MailboxProcessorBasicTests = + let test() = check "c32398u6: MailboxProcessor null" - (let mb1 = new MailboxProcessor(fun inbox -> async { return () }) - mb1.Start(); - 100) - 100 + ( + let mb1 = new MailboxProcessor(fun inbox -> async { return () }) + mb1.Start() + 100 + ) + + 100 check "c32398u7: MailboxProcessor Receive/PostAndReply" @@ -197,9 +200,10 @@ module MailboxProcessorBasicTests = 200 for n in [0; 1; 100; 1000; 100000 ] do - check + checkAsync (sprintf "c32398u: MailboxProcessor Post/Receive, n=%d" n) - (let received = ref 0 + (task { + let received = ref 0 let mb1 = new MailboxProcessor(fun inbox -> async { for i in 0 .. n-1 do let! _ = inbox.Receive() @@ -208,48 +212,37 @@ module MailboxProcessorBasicTests = for i in 0 .. n-1 do mb1.Post(i) while !received < n do - if !received % 100 = 0 then - printfn "received = %d" !received -#if NETCOREAPP - Task.Delay(1).Wait() -#else - System.Threading.Thread.Sleep(1) -#endif - !received) + do! Task.Yield() + return !received}) n for timeout in [0; 10] do for n in [0; 1; 100] do - check + checkAsync (sprintf "c32398u: MailboxProcessor Post/TryReceive, n=%d, timeout=%d" n timeout) - (let received = ref 0 + (task { + let received = ref 0 let mb1 = new MailboxProcessor(fun inbox -> async { while !received < n do - let! msgOpt = inbox.TryReceive(timeout=timeout) - match msgOpt with - | None -> - do if !received % 100 = 0 then - printfn "timeout!, received = %d" !received - | Some _ -> do incr received }) + match! inbox.TryReceive(timeout=timeout) with + | Some _ -> incr received + | _ -> () + }) + + mb1.Post(0) + mb1.Start(); for i in 0 .. n-1 do -#if NETCOREAPP - Task.Delay(1).Wait(); -#else - System.Threading.Thread.Sleep(1) -#endif mb1.Post(i) + do! Task.Yield() while !received < n do - if !received % 100 = 0 then - printfn "main thread: received = %d" !received -#if NETCOREAPP - Task.Delay(1).Wait(); -#else - System.Threading.Thread.Sleep(1) -#endif - !received) + do! Task.Yield() + return !received}) n + +(* Disabled for timing issues. Some replacement TryScan tests were added to FSharp.Core.UnitTests. + for i in 1..10 do for sleep in [0;1;10] do for timeout in [10;1;0] do @@ -284,8 +277,11 @@ module MailboxProcessorBasicTests = !timedOut) (Some true) - check "cf72361: MailboxProcessor TryScan wo/timeout" - (let timedOut = ref None +*) + + checkAsync "cf72361: MailboxProcessor TryScan wo/timeout" + (task { + let timedOut = ref None let mb = new MailboxProcessor(fun inbox -> async { let! result = inbox.TryScan((fun i -> if i then async { return () } |> Some else None)) @@ -298,65 +294,58 @@ module MailboxProcessorBasicTests = w.Start() while w.ElapsedMilliseconds < 100L do mb.Post(false) -#if NETCOREAPP - Task.Delay(0).Wait(); -#else - System.Threading.Thread.Sleep(0) -#endif + do! Task.Yield() let r = !timedOut mb.Post(true) - r) + return r}) None module MailboxProcessorErrorEventTests = exception Err of int let test() = // Make sure the event doesn't get raised if no error - check + checkAsync "c32398u9330: MailboxProcessor Error (0)" - (let mb1 = new MailboxProcessor(fun inbox -> async { return () }) - let res = ref 100 - mb1.Error.Add(fun _ -> res := 0) + (task { + let mb1 = new MailboxProcessor(fun inbox -> async { return () }) + mb1.Error.Add(fun _ -> failwith "unexpected error event") mb1.Start(); -#if NETCOREAPP - Task.Delay(200).Wait(); -#else - System.Threading.Thread.Sleep(200) -#endif - !res) + do! Task.Delay(200) + return 100}) 100 // Make sure the event does get raised if error - check + check "c32398u9331: MailboxProcessor Error (1)" (let mb1 = new MailboxProcessor(fun inbox -> async { failwith "fail" }) - let res = ref 0 - mb1.Error.Add(fun _ -> res := 100) + use res = new System.Threading.ManualResetEventSlim(false) + mb1.Error.Add(fun _ -> res.Set()) mb1.Start(); -#if NETCOREAPP - Task.Delay(200).Wait(); -#else - System.Threading.Thread.Sleep(200) -#endif - !res) - 100 + res.Wait() + true) + true // Make sure the event does get raised after message receive - check + checkAsync "c32398u9332: MailboxProcessor Error (2)" - (let mb1 = new MailboxProcessor(fun inbox -> - async { let! msg = inbox.Receive() - raise (Err msg) }) - let res = ref 0 - mb1.Error.Add(function Err n -> res := n | _ -> check "rwe90r - unexpected error" 0 1) - mb1.Start(); - mb1.Post 100 -#if NETCOREAPP - Task.Delay(200).Wait(); -#else - System.Threading.Thread.Sleep(200) -#endif - !res) + ( + let errorNumber = TaskCompletionSource<_>() + + let mb1 = new MailboxProcessor( fun inbox -> async { + let! msg = inbox.Receive() + raise (Err msg) + }) + + mb1.Error.Add(function + | Err n -> errorNumber.SetResult n + | _ -> + check "rwe90r - unexpected error" 0 1 ) + + mb1.Start(); + mb1.Post 100 + + errorNumber.Task + ) 100 type msg = Increment of int | Fetch of AsyncReplyChannel | Reset @@ -472,13 +461,10 @@ let test7() = let timeoutboxes str = new MailboxProcessor<'b>(fun inbox -> - async { for i in 1 .. 10 do -#if NETCOREAPP - Task.Delay(200).Wait() -#else - do System.Threading.Thread.Sleep 200 -#endif - }) + async { + for i in 1 .. 10 do + do! Async.Sleep 200 + }) // Timeout let timeout_tpar() = @@ -553,17 +539,9 @@ let timeout_para_def() = test "default timeout & PostAndAsyncReply" false with _ -> test "default timeout & PostAndAsyncReply" true -// Useful class: put "checkpoints" in the code. -// Check they are called in the right order. -type Path(str) = - let mutable current = 0 - member p.Check n = check (str + " #" + string (current+1)) n (current+1) - current <- n - - - module LotsOfMessages = let test () = + task { let N = 200000 let count = ref N @@ -586,12 +564,9 @@ module LotsOfMessages = check "celrv09ervkn" (queueLength >= logger.CurrentQueueLength) true queueLength <- logger.CurrentQueueLength -#if NETCOREAPP - Task.Delay(10).Wait() -#else - System.Threading.Thread.Sleep(10) -#endif + do! Task.Delay(10) check "celrv09ervknf3ew" logger.CurrentQueueLength 0 + } let RunAll() = MailboxProcessorBasicTests.test() @@ -608,11 +583,11 @@ let RunAll() = timeout_tpar_def() // ToDo: 7/31/2008: Disabled because of probable timing issue. QA needs to re-enable post-CTP. // Tracked by bug FSharp 1.0:2891 - //test15() + // test15() // ToDo: 7/31/2008: Disabled because of probable timing issue. QA needs to re-enable post-CTP. // Tracked by bug FSharp 1.0:2891 - //test15b() - LotsOfMessages.test() + // test15b() + LotsOfMessages.test().Wait() #if TESTS_AS_APP let RUN() = RunAll(); failures @@ -621,6 +596,9 @@ RunAll() let aa = if not failures.IsEmpty then stdout.WriteLine "Test Failed" + stdout.WriteLine() + stdout.WriteLine "failures:" + failures |> List.iter stdout.WriteLine exit 1 else stdout.WriteLine "Test Passed" diff --git a/tests/fsharp/typecheck/sigs/neg06.bsl b/tests/fsharp/typecheck/sigs/neg06.bsl index d55e3e948d2..4e28da2b6d7 100644 --- a/tests/fsharp/typecheck/sigs/neg06.bsl +++ b/tests/fsharp/typecheck/sigs/neg06.bsl @@ -10,7 +10,7 @@ neg06.fs(24,6,24,30): typecheck error FS0944: Abbreviated types cannot be given neg06.fs(27,6,27,33): typecheck error FS0942: Delegate types are always sealed -neg06.fs(31,9,31,29): typecheck error FS0945: Cannot inherit a sealed type +neg06.fs(31,17,31,27): typecheck error FS0945: Cannot inherit a sealed type neg06.fs(37,6,37,29): typecheck error FS0954: This type definition involves an immediate cyclic reference through a struct field or inheritance relation diff --git a/tests/fsharp/typecheck/sigs/neg10.bsl b/tests/fsharp/typecheck/sigs/neg10.bsl index 60e9056de56..31bcdb1882e 100644 --- a/tests/fsharp/typecheck/sigs/neg10.bsl +++ b/tests/fsharp/typecheck/sigs/neg10.bsl @@ -1,9 +1,9 @@ neg10.fsi(9,6,9,7): typecheck error FS0249: Two type definitions named 'x' occur in namespace 'N' in two parts of this assembly -neg10.fs(11,17,11,27): typecheck error FS0946: Cannot inherit from interface type. Use interface ... with instead. +neg10.fs(11,25,11,27): typecheck error FS0946: Cannot inherit from interface type. Use interface ... with instead. -neg10.fs(13,17,13,26): typecheck error FS0945: Cannot inherit a sealed type +neg10.fs(13,25,13,26): typecheck error FS0945: Cannot inherit a sealed type neg10.fs(15,22,15,32): typecheck error FS0887: The type 'C1' is not an interface type diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/StructTypes/E_StructInheritance01b.fs b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/StructTypes/E_StructInheritance01b.fs index c8771146df5..38184a2ac82 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/StructTypes/E_StructInheritance01b.fs +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/StructTypes/E_StructInheritance01b.fs @@ -2,7 +2,7 @@ // Verify error when trying to inherit from a struct type // Regression test for FSHARP1.0:2803 //FS0191: Cannot inherit from interface type -//Cannot inherit a sealed type +//Cannot inherit a sealed type type StructType = struct diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeKindInference/infer_interface002e.fs b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeKindInference/infer_interface002e.fs index 4f9a24e00a8..e5998a72c51 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeKindInference/infer_interface002e.fs +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeKindInference/infer_interface002e.fs @@ -2,10 +2,10 @@ // attribute must match inferred type //The kind of the type specified by its attributes does not match the kind implied by its definition //Structs, interfaces, enums and delegates cannot inherit from other types -//Cannot inherit from interface type\. Use interface \.\.\. with instead +//Cannot inherit from interface type\. Use interface \.\.\. with instead //The kind of the type specified by its attributes does not match the kind implied by its definition //Structs, interfaces, enums and delegates cannot inherit from other types -//Cannot inherit from interface type\. Use interface \.\.\. with instead +//Cannot inherit from interface type\. Use interface \.\.\. with instead // An interface type TK_I_003 = interface diff --git a/tests/service/data/SyntaxTree/Member/Inherit 01.fs.bsl b/tests/service/data/SyntaxTree/Member/Inherit 01.fs.bsl index e138535c113..f10dc2c0997 100644 --- a/tests/service/data/SyntaxTree/Member/Inherit 01.fs.bsl +++ b/tests/service/data/SyntaxTree/Member/Inherit 01.fs.bsl @@ -13,7 +13,8 @@ ImplFile (Unspecified, [Inherit (LongIdent (SynLongIdent ([I], [], [None])), None, - (4,4--4,13))], (4,4--4,13)), [], None, (3,5--4,13), + (4,4--4,13), { InheritKeyword = (4,4--4,11) })], + (4,4--4,13)), [], None, (3,5--4,13), { LeadingKeyword = Type (3,0--3,4) EqualsRange = Some (3,7--3,8) WithKeyword = None })], (3,0--4,13))], diff --git a/tests/service/data/SyntaxTree/Member/Inherit 03.fs.bsl b/tests/service/data/SyntaxTree/Member/Inherit 03.fs.bsl index eeab1704856..d0101bb0dd4 100644 --- a/tests/service/data/SyntaxTree/Member/Inherit 03.fs.bsl +++ b/tests/service/data/SyntaxTree/Member/Inherit 03.fs.bsl @@ -13,7 +13,8 @@ ImplFile (Unspecified, [Inherit (LongIdent (SynLongIdent ([], [], [])), None, - (4,4--4,11))], (4,4--4,11)), [], None, (3,5--4,11), + (4,4--4,11), { InheritKeyword = (4,4--4,11) })], + (4,4--4,11)), [], None, (3,5--4,11), { LeadingKeyword = Type (3,0--3,4) EqualsRange = Some (3,7--3,8) WithKeyword = None })], (3,0--4,11))], diff --git a/tests/service/data/SyntaxTree/Member/Inherit 04.fs.bsl b/tests/service/data/SyntaxTree/Member/Inherit 04.fs.bsl index 9c03baf2b56..7d0dcfc450c 100644 --- a/tests/service/data/SyntaxTree/Member/Inherit 04.fs.bsl +++ b/tests/service/data/SyntaxTree/Member/Inherit 04.fs.bsl @@ -13,7 +13,8 @@ ImplFile (Unspecified, [Inherit (LongIdent (SynLongIdent ([], [], [])), None, - (4,4--4,11))], (4,4--4,11)), [], None, (3,5--4,11), + (4,4--4,11), { InheritKeyword = (4,4--4,11) })], + (4,4--4,11)), [], None, (3,5--4,11), { LeadingKeyword = Type (3,0--3,4) EqualsRange = Some (3,7--3,8) WithKeyword = None })], (3,0--4,11)); diff --git a/tests/service/data/SyntaxTree/Member/Inherit 05.fs.bsl b/tests/service/data/SyntaxTree/Member/Inherit 05.fs.bsl index ddb47eb7ecc..ab71c976fe7 100644 --- a/tests/service/data/SyntaxTree/Member/Inherit 05.fs.bsl +++ b/tests/service/data/SyntaxTree/Member/Inherit 05.fs.bsl @@ -13,7 +13,7 @@ ImplFile (Unspecified, [Inherit (LongIdent (SynLongIdent ([], [], [])), None, - (4,4--4,11)); + (4,4--4,11), { InheritKeyword = (4,4--4,11) }); Member (SynBinding (None, Normal, false, false, [], diff --git a/tests/service/data/SyntaxTree/Member/Inherit 08.fs.bsl b/tests/service/data/SyntaxTree/Member/Inherit 08.fs.bsl index fa0211259a4..757d0a30638 100644 --- a/tests/service/data/SyntaxTree/Member/Inherit 08.fs.bsl +++ b/tests/service/data/SyntaxTree/Member/Inherit 08.fs.bsl @@ -13,7 +13,7 @@ ImplFile (Unspecified, [Inherit (LongIdent (SynLongIdent ([], [], [])), None, - (4,4--4,11)); + (4,4--4,11), { InheritKeyword = (4,4--4,11) }); Member (SynBinding (None, Normal, false, false, [],