Skip to content

Commit

Permalink
Cleanup. Generate fsc args for FCS and ComponentTests projects. Add a…
Browse files Browse the repository at this point in the history
… script for preparing the codebase
  • Loading branch information
safesparrow committed Nov 7, 2022
1 parent 2a6451b commit 0d5f07b
Show file tree
Hide file tree
Showing 18 changed files with 178 additions and 123 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@ open System
open System.Collections.Generic
open ParallelTypeCheckingTests
open ParallelTypeCheckingTests.FileInfoGathering
open ParallelTypeCheckingTests.Graph
open ParallelTypeCheckingTests.Types
open FSharp.Compiler.Syntax

Expand All @@ -30,12 +29,13 @@ type DepsResult =
Files : FileData[]
Graph : DepsGraph
}
with member this.Edges() = this.Graph |> Graph.collectEdges

type References = Reference seq

/// Algorithm for automatically detecting (lack of) file dependencies based on their AST contents
[<RequireQualifiedAccess>]
module internal AutomatedDependencyResolving =
module internal DependencyResolution =

/// Eg. 'A' and 'B' in "module A.B"
type ModuleSegment = string
Expand Down Expand Up @@ -142,20 +142,22 @@ module internal AutomatedDependencyResolving =
printfn $"{backed.Length} backed files found"
let filesWithModuleAbbreviations =
nodes
|> Array.filter (fun n -> n.Data.Abbreviations |> Array.exists (function Abbreviation.ModuleAbbreviation _ -> true | _ -> false))
|> Array.filter (fun n ->
n.Data.Abbreviations
|> Array.exists (function Abbreviation.ModuleAbbreviation -> true | _ -> false))

let trie = buildTrie nodes

let fsiFiles =
nodes
|> Array.filter (fun f -> f.File.Name.EndsWith ".fsi")
|> Array.filter (fun f -> match f.File.AST with | ASTOrX.AST (ParsedInput.SigFile _) -> true | _ -> false)

let processFile (node : FileData) =
let deps =
let fsiDep =
if node.File.FsiBacked then
nodes
|> Array.find (fun x -> x.File.Name = node.File.Name + "i")
|> Array.find (fun x -> x.File.QualifiedName = node.File.QualifiedName)
|> fun x -> [|x|]
else
[||]
Expand Down Expand Up @@ -239,7 +241,7 @@ module internal AutomatedDependencyResolving =
reachable
|> Seq.collect (fun node -> node.Files)
// TODO Temporary - Add all nodes
|> Seq.append nodes
// |> Seq.append nodes
// If not, then the below is not necessary.
// Assume that this file depends on all files that have any module abbreviations
// TODO Handle module abbreviations in a better way
Expand Down
6 changes: 2 additions & 4 deletions tests/ParallelTypeCheckingTests/Code/FileInfoGathering.fs
Original file line number Diff line number Diff line change
Expand Up @@ -14,12 +14,10 @@ let internal gatherBackingInfo (files : SourceFiles) : Files =
let fsiBacked =
match f.AST with
| ParsedInput.SigFile _ ->
// TODO Use QualifiedNameOfFile
seenSigFiles.Add f.AST.FileName |> ignore
seenSigFiles.Add f.QualifiedName |> ignore
false
| ParsedInput.ImplFile _ ->
let fsiName = System.IO.Path.ChangeExtension(f.QualifiedName, "fsi")
let fsiBacked = seenSigFiles.Contains fsiName
let fsiBacked = seenSigFiles.Contains f.QualifiedName
fsiBacked
{
Idx = FileIdx.make i
Expand Down
9 changes: 7 additions & 2 deletions tests/ParallelTypeCheckingTests/Code/Graph.fs
Original file line number Diff line number Diff line change
@@ -1,16 +1,21 @@
module ParallelTypeCheckingTests.Graph
namespace ParallelTypeCheckingTests
#nowarn "1182"
#nowarn "40"

open System.Collections.Generic
open System.Drawing.Drawing2D
open ParallelTypeCheckingTests.Utils

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

module Graph =

let collectEdges<'Node when 'Node : equality> (graph : Graph<'Node>) : ('Node * 'Node)[] =
let graph : IReadOnlyDictionary<'Node, 'Node[]> = graph
graph
|> Seq.collect (fun (KeyValue(node, deps)) -> deps |> Array.map (fun dep -> node, dep))
|> Seq.toArray

/// Create entries for nodes that don't have any dependencies but are mentioned as dependencies themselves
let fillEmptyNodes<'Node when 'Node : equality> (graph : Graph<'Node>) : Graph<'Node> =
let missingNodes =
Expand Down
1 change: 0 additions & 1 deletion tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@ module ParallelTypeCheckingTests.GraphProcessing

open System.Collections.Generic
open System.Threading
open ParallelTypeCheckingTests.Graph

/// Used for processing
type NodeInfo<'Item> =
Expand Down
11 changes: 4 additions & 7 deletions tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,6 @@
#nowarn "1182"
open System.Collections.Concurrent
open System.Collections.Generic
open System.Threading
open FSharp.Compiler
open FSharp.Compiler.CheckBasics
open FSharp.Compiler.CheckDeclarations
Expand All @@ -12,7 +11,6 @@ open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.NameResolution
open FSharp.Compiler.ParseAndCheckInputs
open ParallelTypeCheckingTests.FileInfoGathering
open ParallelTypeCheckingTests.Graph
open ParallelTypeCheckingTests.Types
open ParallelTypeCheckingTests.Utils
open ParallelTypeCheckingTests
Expand All @@ -21,7 +19,6 @@ open FSharp.Compiler.Syntax
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Text
open FSharp.Compiler.TypedTree
open Internal.Utilities.Collections
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
open Newtonsoft.Json
Expand Down Expand Up @@ -70,12 +67,12 @@ let CheckMultipleInputsInParallel
|> List.map (fun ast -> ast.FileName, ast)
|> readOnlyDict
|> ConcurrentDictionary<_,_>
let graph = DepResolving.AutomatedDependencyResolving.detectFileDependencies sourceFiles
let graph = DepResolving.DependencyResolution.detectFileDependencies sourceFiles

let mutable nextIdx = (graph.Files |> Array.map (fun f -> f.File.Idx.Idx) |> Array.max) + 1
let fakeX (idx : FileIdx) (fsi : string) : FileData =
let fakeX (idx : FileIdx) (fsi : File) : FileData =
{
File = File.FakeFs idx fsi
File = File.FakeFs idx fsi.QualifiedName
Data =
{
Tops = [||]
Expand All @@ -91,7 +88,7 @@ let CheckMultipleInputsInParallel
|> Array.map (fun fsi ->
let idx = FileIdx.make nextIdx
nextIdx <- nextIdx + 1
fsi.File, fakeX idx fsi.File.Name
fsi.File, fakeX idx fsi.File
)
|> readOnlyDict

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,7 @@ let CheckMultipleInputsInParallel
|> List.toArray
|> Array.mapi (fun i inp -> { Idx = FileIdx.make i; AST = inp }: SourceFile)

AutomatedDependencyResolving.detectFileDependencies sourceFiles
DependencyResolution.detectFileDependencies sourceFiles

do ()

Expand Down
9 changes: 7 additions & 2 deletions tests/ParallelTypeCheckingTests/Code/Types.fs
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ type SourceFile =
| _ -> false
override this.GetHashCode () = this.Idx.GetHashCode()
override this.ToString() = this.Idx.ToString()
member this.QualifiedName = this.AST.FileName
member this.QualifiedName = this.AST.QualifiedName.Text

type SourceFiles = SourceFile[]

Expand All @@ -38,7 +38,11 @@ type ASTOrX =
member x.Name =
match x with
| AST ast -> ast.FileName
| X fsi -> fsi + "x"
| X qualifiedName -> qualifiedName + "x"
member x.QualifiedName =
match x with
| AST ast -> ast.QualifiedName.Text
| X qualifiedName -> qualifiedName + ".fsix"

/// Basic data about a parsed source file with extra information needed for graph processing
[<CustomEquality; CustomComparison>]
Expand All @@ -53,6 +57,7 @@ type File =
with
member this.Name = this.AST.Name // TODO Use qualified name
member this.CodeSize = this.Code.Length
member this.QualifiedName = this.AST.QualifiedName
override this.Equals other =
match other with
| :? File as f -> f.Name.Equals this.Name
Expand Down
27 changes: 14 additions & 13 deletions tests/ParallelTypeCheckingTests/ParallelTypeCheckingTests.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -28,26 +28,27 @@
<Compile Include="..\service\Common.fs">
<Link>Common.fs</Link>
</Compile>
<Compile Include="Code/Utils.fs" />
<Compile Include="Code/Types.fs" />
<Compile Include="Code/ASTVisit.fs" />
<Compile Include="Code/FileInfoGathering.fs" />
<Compile Include="Code/Graph.fs" />
<Compile Include="Code/DepResolving.fs" />
<Compile Include="Code/Parallel.fs" />
<Compile Include="Code/GraphProcessing.fs" />
<Compile Include="Code/ParallelTypeChecking.fs" />
<Compile Include="Code\Utils.fs" />
<Compile Include="Code\Types.fs" />
<Compile Include="Code\ASTVisit.fs" />
<Compile Include="Code\FileInfoGathering.fs" />
<Compile Include="Code\Graph.fs" />
<Compile Include="Code\DependencyResolution.fs" />
<Compile Include="Code\Parallel.fs" />
<Compile Include="Code\GraphProcessing.fs" />
<Compile Include="Code\ParallelTypeChecking.fs" />
<Compile Include="Code\SingleTcStateTypeChecking.fs" />
<Compile Include="Tests\TestASTVisit.fs" />
<Compile Include="Tests\TestDepResolving.fs" />
<Compile Include="Tests\Utils.fs" />
<Compile Include="Tests\AssemblySetUp.fs" />
<Compile Include="Tests\TestASTVisit.fs" />
<Compile Include="Tests\TestDependencyResolution.fs" />
<Compile Include="Tests\TestGraphProcessing.fs" />
<Compile Include="Tests\TestCompilation.fs" />
<Content Include="Tests\DiamondArgs.txt" />
<Content Include="Tests\FCS.txt" />
<Compile Include="Tests\TestCompilationFromCmdlineArgs.fs" />
<Compile Include="Tests\TestGraph.fs" />
<Content Include="Tests\FCS.args.txt" />
<Content Include="Tests\FCS.prepare.ps1" />
<Content Include="Tests\ComponentTests.args.txt" />
<Compile Include="Program.fs" />
<Content Include="Docs.md" />
</ItemGroup>
Expand Down
1 change: 1 addition & 0 deletions tests/ParallelTypeCheckingTests/Tests/.gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
.checkouts
3 changes: 1 addition & 2 deletions tests/ParallelTypeCheckingTests/Tests/AssemblySetUp.fs
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
namespace global
open NUnit.Framework
open ParallelTypeCheckingTests
open OpenTelemetry.Trace

/// One-time Otel setup for NUnit tests
Expand All @@ -10,7 +9,7 @@ type AssemblySetUp() =

[<OneTimeSetUp>]
member this.SetUp() =
tracerProvider <- TestUtils.setupOtel() |> Some
tracerProvider <- ParallelTypeCheckingTests.TestUtils.setupOtel() |> Some

[<OneTimeTearDown>]
member this.TearDown() =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@
--define:NETCOREAPP3_0_OR_GREATER
--define:NETCOREAPP3_1_OR_GREATER
--doc:$CODE_ROOT$\artifacts\obj\FSharp.Compiler.ComponentTests\Debug\net7.0\FSharp.Compiler.ComponentTests.xml
--keyfile:$PACKAGES$\microsoft.dotnet.arcade.sdk\8.0.0-beta.22520.1\tools\snk/MSFT.snk
--keyfile:$PACKAGES$\microsoft.dotnet.arcade.sdk\8.0.0-beta.22552.1\tools\snk/MSFT.snk
--publicsign+
--optimize-
--tailcalls-
Expand Down Expand Up @@ -401,6 +401,7 @@ Language\InterpolatedStringsTests.fs
Language\ComputationExpressionTests.fs
Language\CastingTests.fs
Language\NameofTests.fs
Language\ExtensionMethodTests.fs
ConstraintSolver\PrimitiveConstraints.fs
ConstraintSolver\MemberConstraints.fs
Interop\SimpleInteropTests.fs
Expand All @@ -427,4 +428,5 @@ Signatures\TestHelpers.fs
Signatures\ModuleOrNamespaceTests.fs
Signatures\RecordTests.fs
Signatures\ArrayTests.fs
Signatures\TypeTests.fs
Signatures\TypeTests.fs
FSharpChecker\CommonWorkflows.fs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@
--define:NETSTANDARD1_6_OR_GREATER
--define:NETSTANDARD2_0_OR_GREATER
--doc:$CODE_ROOT$\artifacts\obj\FSharp.Compiler.Service\Debug\netstandard2.0\FSharp.Compiler.Service.xml
--keyfile:$PACKAGES$\microsoft.dotnet.arcade.sdk\8.0.0-beta.22513.2\tools\snk/MSFT.snk
--keyfile:$PACKAGES$\microsoft.dotnet.arcade.sdk\8.0.0-beta.22552.1\tools\snk/MSFT.snk
--publicsign+
--optimize-
--resource:$CODE_ROOT$\artifacts\obj\FSharp.Compiler.Service\Debug\netstandard2.0\FSComp.resources
Expand Down Expand Up @@ -191,6 +191,7 @@
--deterministic+
--simpleresolution
--nowarn:3384
--times
--nowarn:75
--extraoptimizationloops:1
--warnon:1182
Expand Down
9 changes: 9 additions & 0 deletions tests/ParallelTypeCheckingTests/Tests/FCS.prepare.ps1
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
$commit = "3c2e73baa80170d2033b302bd6bd5d5966a5eb29"
mkdir .fcs_test
cd .fcs_test
git init
git remote add origin https://github.com/dotnet/fsharp
git fetch origin
git reset --hard $commit

./build.cmd -noVisualStudio
5 changes: 3 additions & 2 deletions tests/ParallelTypeCheckingTests/Tests/TestCompilation.fs
Original file line number Diff line number Diff line change
Expand Up @@ -128,8 +128,9 @@ type Case =
Method : Method
Project : FProject
}
with override this.ToString() =
$"{this.Method} - {this.Project}"
with
override this.ToString() =
$"{this.Method} - {this.Project}"

let compile (x : Case) =
use _ = FSharp.Compiler.Diagnostics.Activity.start "Compile codebase" ["method", x.Method.ToString()]
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,7 @@ open NUnit.Framework
open System
open FSharp.Compiler
open ParallelTypeCheckingTests
open NUnit.Framework
open ParallelTypeCheckingTests.TestUtils
open Utils

type Codebase =
{
Expand All @@ -19,9 +17,8 @@ type Codebase =

let codebases =
[|
{WorkDir = @"$CODE_ROOT$\src\compiler"; Path = $@"{__SOURCE_DIRECTORY__}\FCS.txt"; Limit = None}
// TODO Update args and uncomment
// {WorkDir = @"$CODE_ROOT$\tests\FSharp.Compiler.ComponentTests"; Path = $@"{__SOURCE_DIRECTORY__}\ComponentTests_args.txt"; Limit = None}
{ WorkDir = $@"{__SOURCE_DIRECTORY__}\.checkouts\fcs\src\compiler"; Path = $@"{__SOURCE_DIRECTORY__}\FCS.args.txt"; Limit = None }
{ WorkDir = $@"{__SOURCE_DIRECTORY__}\.checkouts\fcs\tests\FSharp.Compiler.ComponentTests"; Path = $@"{__SOURCE_DIRECTORY__}\ComponentTests.args.txt"; Limit = None }
|]

/// A very hacky way to setup the given type-checking method - mutates static state and returns new args
Expand Down Expand Up @@ -71,6 +68,7 @@ let internal TestCompilerFromArgs (config : Args) : unit =
Environment.CurrentDirectory <- oldWorkDir

[<TestCaseSource(nameof(codebases))>]
[<Explicit("Before running these tests, you must prepare the codebase by running FCS.prepare.ps1")>]
let ``Test graph-based type-checking`` (code : Codebase) =
let config =
{
Expand Down

0 comments on commit 0d5f07b

Please sign in to comment.