Skip to content

Commit 43dc18a

Browse files
safesparrowsafesparrow
committed
Cleanup tests & namespaces. Basic compile test not working.
1 parent 991bf61 commit 43dc18a

21 files changed

Lines changed: 1339 additions & 1363 deletions

‎tests/ParallelTypeCheckingTests/Code/ASTVisit.fs‎

Lines changed: 1182 additions & 1177 deletions
Large diffs are not rendered by default.

‎tests/ParallelTypeCheckingTests/Code/DepResolving.fs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,14 @@
1-
module FSharp.Compiler.Service.Tests2.DepResolving
1+
module ParallelTypeCheckingTests.DepResolving
22
#nowarn "1182"
33
#nowarn "40"
44

55
open System
66
open System.Collections.Generic
7-
open FSharp.Compiler.Service.Tests
8-
open FSharp.Compiler.Service.Tests.FileInfoGathering
9-
open FSharp.Compiler.Service.Tests.Graph
10-
open FSharp.Compiler.Service.Tests.Types
11-
open FSharp.Compiler.Service.Tests2.ASTVisit
7+
open ParallelTypeCheckingTests
8+
open ParallelTypeCheckingTests.FileInfoGathering
9+
open ParallelTypeCheckingTests.Graph
10+
open ParallelTypeCheckingTests.Types
11+
open ParallelTypeCheckingTests.ASTVisit
1212
open FSharp.Compiler.Syntax
1313

1414
let log (msg : string) =

‎tests/ParallelTypeCheckingTests/Code/FileInfoGathering.fs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
/// Allows extracting necessary data from a sequence of project source files
2-
module FSharp.Compiler.Service.Tests.FileInfoGathering
2+
module ParallelTypeCheckingTests.FileInfoGathering
33

44
open System.Collections.Generic
5-
open FSharp.Compiler.Service.Tests.Types
6-
open FSharp.Compiler.Service.Tests.Utils
7-
open FSharp.Compiler.Service.Tests2
5+
open ParallelTypeCheckingTests.Types
6+
open ParallelTypeCheckingTests.Utils
7+
open ParallelTypeCheckingTests
88
open FSharp.Compiler.Syntax
99

1010
let internal gatherBackingInfo (files : SourceFiles) : Files =
@@ -48,7 +48,7 @@ type FileData =
4848

4949
let private gatherFileData (ast : ParsedInput) : ExtractedData =
5050
let moduleRefs, containsModuleAbbreviations = ASTVisit.findModuleRefs ast
51-
let tops = ASTVisit.topModuleOrNamespaces ast
51+
let tops = TopModulesExtraction.topModuleOrNamespaces ast
5252
// TODO As a perf optimisation we can skip top-level ids scanning for FsiBacked .fs files
5353
// However, it is unlikely to give a noticable speedup due to parallelism (citation needed)
5454
{

‎tests/ParallelTypeCheckingTests/Code/Graph.fs‎

Lines changed: 13 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,17 @@
1-
module FSharp.Compiler.Service.Tests.Graph
1+
module ParallelTypeCheckingTests.Graph
22
#nowarn "1182"
33
#nowarn "40"
44

55
open System.Collections.Generic
6-
open FSharp.Compiler.Service.Tests.Utils
6+
open System.Drawing.Drawing2D
7+
open ParallelTypeCheckingTests.Utils
78

89
/// <summary> DAG of files </summary>
910
type Graph<'Node> = IReadOnlyDictionary<'Node, 'Node[]>
1011

1112
module Graph =
1213

14+
/// Create entries for nodes that don't have any dependencies but are mentioned as dependencies themselves
1315
let fillEmptyNodes<'Node when 'Node : equality> (graph : Graph<'Node>) : Graph<'Node> =
1416
let missingNodes =
1517
graph.Values
@@ -25,6 +27,7 @@ module Graph =
2527
x
2628
|> Dictionary<_,_> |> fun x -> x :> IReadOnlyDictionary<_,_>
2729

30+
/// Create a transitive closure of the graph
2831
let transitive<'Node when 'Node : equality> (graph : Graph<'Node>) : Graph<'Node> =
2932
let rec calcTransitiveEdges =
3033
fun (node : 'Node) ->
@@ -43,29 +46,24 @@ module Graph =
4346
|> Seq.map (fun node -> node, calcTransitiveEdges node)
4447
|> readOnlyDict
4548

49+
/// Create a reverse of the graph
4650
let reverse (originalGraph : Graph<'Node>) : Graph<'Node> =
4751
originalGraph
4852
// Collect all edges
4953
|> Seq.collect (fun (KeyValue(idx, deps)) -> deps |> Array.map (fun dep -> idx, dep))
5054
// Group dependants of the same dependencies together
51-
|> Seq.groupBy (fun (idx, dep) -> dep)
55+
|> Seq.groupBy (fun (_idx, dep) -> dep)
5256
// Construct reversed graph
5357
|> Seq.map (fun (dep, edges) -> dep, edges |> Seq.map fst |> Seq.toArray)
54-
|> dict
55-
// Add nodes that are missing due to having no dependants
56-
|> fun graph ->
57-
originalGraph
58-
|> Seq.map (fun (KeyValue(idx, deps)) ->
59-
match graph.TryGetValue idx with
60-
| true, dependants -> idx, dependants
61-
| false, _ -> idx, [||]
62-
)
6358
|> readOnlyDict
64-
65-
let print (graph : Graph<'Node>) : unit =
59+
|> fillEmptyNodes
60+
61+
let printCustom (graph : Graph<'Node>) (printer : 'Node -> string) : unit =
6662
printfn "Graph:"
6763
let join (xs : string[]) =
6864
System.String.Join(", ", xs)
6965
graph
70-
|> Seq.iter (fun (KeyValue(file, deps)) -> printfn $"{file} -> {deps |> Array.map (fun d -> d.ToString()) |> join}")
66+
|> Seq.iter (fun (KeyValue(file, deps)) -> printfn $"{file} -> {deps |> Array.map printer |> join}")
67+
68+
let print (graph : Graph<'Node>) : unit = printCustom graph (fun node -> node.ToString())
7169

‎tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs‎

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
11
/// Parallel processing of graph of work items with dependencies
2-
module FSharp.Compiler.Service.Tests.GraphProcessing
2+
module ParallelTypeCheckingTests.GraphProcessing
33

44
open System.Collections.Generic
55
open System.Threading
6-
open FSharp.Compiler.Service.Tests.Graph
6+
open ParallelTypeCheckingTests.Graph
77

88
/// Used for processing
99
type NodeInfo<'Item> =
@@ -253,9 +253,4 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item : equality
253253
Array.append fileResults [|fileResult|], state
254254
) ([||], emptyState)
255255

256-
let x = nodesArray[22]
257-
let _y = x.Info
258-
let _z = x.Result |> Option.get
259-
let _a = x.InputState |> Option.get
260-
let _b = x.ProcessedDepsCount
261256
finals, state

‎tests/ParallelTypeCheckingTests/Code/Parallel.fs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module FSharp.Compiler.Service.Tests.Parallel
1+
module ParallelTypeCheckingTests.Parallel
22
#nowarn "1182"
33
open System
44
open System.Collections.Concurrent
@@ -61,7 +61,7 @@ let processInParallelUsingMailbox
6161
=
6262
let processedCountLock = Object()
6363
let mutable processedCount = 0
64-
let agent = threadingLimitAgent 10 ct
64+
let agent = threadingLimitAgent parallelism ct
6565
let rec processItem item =
6666
async {
6767
let! toSchedule = work item
@@ -70,7 +70,6 @@ let processInParallelUsingMailbox
7070
toSchedule |> Array.iter (fun x -> agent.Post(Start(processItem x)))
7171
}
7272
firstItems |> Array.iter (fun x -> agent.Post(Start(processItem x)))
73-
()
7473

7574
// TODO Could replace with MailboxProcessor+Tasks/Asyncs instead of BlockingCollection + Threads
7675
// See http://www.fssnip.net/nX/title/Limit-degree-of-parallelism-using-an-agent

‎tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs‎

Lines changed: 8 additions & 61 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module FSharp.Compiler.Service.Tests.ParallelTypeChecking
1+
module ParallelTypeCheckingTests.ParallelTypeChecking
22
#nowarn "1182"
33
open System.Collections.Concurrent
44
open System.Collections.Generic
@@ -11,12 +11,12 @@ open FSharp.Compiler.CompilerImports
1111
open FSharp.Compiler.DiagnosticsLogger
1212
open FSharp.Compiler.NameResolution
1313
open FSharp.Compiler.ParseAndCheckInputs
14-
open FSharp.Compiler.Service.Tests.FileInfoGathering
15-
open FSharp.Compiler.Service.Tests.Graph
16-
open FSharp.Compiler.Service.Tests.Types
17-
open FSharp.Compiler.Service.Tests.Utils
18-
open FSharp.Compiler.Service.Tests2
19-
open FSharp.Compiler.Service.Tests2.DepResolving
14+
open ParallelTypeCheckingTests.FileInfoGathering
15+
open ParallelTypeCheckingTests.Graph
16+
open ParallelTypeCheckingTests.Types
17+
open ParallelTypeCheckingTests.Utils
18+
open ParallelTypeCheckingTests
19+
open ParallelTypeCheckingTests.DepResolving
2020
open FSharp.Compiler.Syntax
2121
open FSharp.Compiler.TcGlobals
2222
open FSharp.Compiler.Text
@@ -28,26 +28,6 @@ open Newtonsoft.Json
2828

2929
type FileGraph = Graph<File>
3030

31-
let calcFileGraph (_files : SourceFiles) : FileGraph =
32-
// TODO Use DepResolving.fs
33-
failwith ""
34-
35-
// TODO Use real things
36-
type State = string
37-
type FinalFileResult = string
38-
type SingleResult = State -> FinalFileResult * State
39-
40-
// TODO Use the real thing
41-
let typeCheckFile (file : File) (_state : State) : SingleResult
42-
=
43-
fun (state : State) ->
44-
let res = file.Idx.Idx
45-
res.ToString(), $"{state}+{res}"
46-
47-
// TODO Use the real thing
48-
let folder (state : State) (result : SingleResult): FinalFileResult * State =
49-
result state
50-
5131
module internal Real =
5232

5333
// Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input
@@ -267,10 +247,6 @@ module internal Real =
267247
partialResults |> Array.toList, tcState
268248
)
269249

270-
271-
272-
273-
274250
module internal Nojaf =
275251
type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
276252

@@ -663,33 +639,4 @@ module internal Nojaf =
663639
let x = tcState.CreatesGeneratedProvidedTypes || (createsGeneratedProvidedTypesFlags |> List.exists id)
664640
let tcState = tcState.WithCreatesGeneratedProvidedTypes x
665641
results, tcState)
666-
667-
668-
669-
670-
671-
672-
let typeCheckGraph (graph : FileGraph) : FinalFileResult[] * State =
673-
let parallelism = 4 // cpu count?
674-
GraphProcessing.processGraph
675-
graph
676-
typeCheckFile
677-
folder
678-
""
679-
(fun _ -> true)
680-
parallelism
681-
682-
let typeCheckGraph2 (graph : FileGraph) : FinalFileResult[] * State =
683-
let parallelism = 4 // cpu count?
684-
GraphProcessing.processGraph
685-
graph
686-
typeCheckFile
687-
folder
688-
""
689-
(fun _ -> true)
690-
parallelism
691-
692-
let typeCheck (files : SourceFiles) : FinalFileResult[] * State =
693-
let graph = calcFileGraph files
694-
let state = typeCheckGraph graph
695-
state
642+

‎tests/ParallelTypeCheckingTests/Code/Types.fs‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
1-
module FSharp.Compiler.Service.Tests.Types
1+
module ParallelTypeCheckingTests.Types
22

3-
open FSharp.Compiler.Service.Tests.Utils
3+
open ParallelTypeCheckingTests.Utils
44
open FSharp.Compiler.Syntax
5-
type AST = FSharp.Compiler.Syntax.ParsedInput
5+
type AST = ParsedInput
66

77
type FileType =
88
| Sig
@@ -40,6 +40,7 @@ type ASTOrX =
4040
| AST ast -> ast.FileName
4141
| X fsi -> fsi + "x"
4242

43+
/// Basic data about a parsed source file with extra information needed for graph processing
4344
[<CustomEquality; CustomComparison>]
4445
type File =
4546
{
@@ -64,8 +65,6 @@ type File =
6465
| :? File as f -> x.Idx.Idx.CompareTo f.Idx.Idx
6566
| _ -> 0
6667

67-
// TODO Please make this sane
68-
member this.IsFake = this.Code = ""
6968
static member FakeFs (idx : FileIdx) (fsi : string) : File =
7069
{
7170
Idx = idx

‎tests/ParallelTypeCheckingTests/Code/Utils.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module FSharp.Compiler.Service.Tests.Utils
1+
module ParallelTypeCheckingTests.Utils
22

33
#nowarn "40"
44

‎tests/ParallelTypeCheckingTests/ParallelTypeCheckingTests.fsproj‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -40,12 +40,13 @@
4040
<Compile Include="Tests\TestASTVisit.fs" />
4141
<Compile Include="Tests\TestDepResolving.fs" />
4242
<Compile Include="Tests\Utils.fs" />
43-
<Compile Include="Tests\GraphResolvingAndProcessing.fs" />
44-
<Compile Include="Tests\CompilationTests.fs" />
43+
<Compile Include="Tests\AssemblySetUp.fs" />
44+
<Compile Include="Tests\TestGraphProcessing.fs" />
45+
<Compile Include="Tests\TestCompilation.fs" />
4546
<Content Include="Tests\DiamondArgs.txt" />
46-
<Content Include="Tests\FCSArgs.txt" />
47-
<Compile Include="Tests\CompilationFromArgsTests.fs" />
48-
<Compile Include="Tests\Setup.fs" />
47+
<Content Include="Tests\FCS.txt" />
48+
<Compile Include="Tests\TestCompilationFromCmdlineArgs.fs" />
49+
<Compile Include="Tests\TestGraph.fs" />
4950
<Compile Include="Program.fs" />
5051
<Content Include="Docs.md" />
5152
</ItemGroup>

0 commit comments

Comments
 (0)