Skip to content

Commit bddc912

Browse files
committed
Fable test update
1 parent 099be25 commit bddc912

File tree

7 files changed

+219
-96
lines changed

7 files changed

+219
-96
lines changed

fcs/fcs-fable/test/Platform.fs

Lines changed: 22 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,14 @@
1-
module Platform
1+
module Fable.Compiler.Platform
22

3-
#if DOTNET_FILE_SYSTEM
3+
let __dirname = "."
4+
5+
#if DOTNET_FILE_SYSTEM && !FABLE_COMPILER
46

57
open System.IO
68

79
let readAllBytes (filePath: string) = File.ReadAllBytes(filePath)
810
let readAllText (filePath: string) = File.ReadAllText(filePath, System.Text.Encoding.UTF8)
9-
let writeAllText (filePath: string) (text:string) = File.WriteAllText(filePath, text)
11+
let writeAllText (filePath: string) (text: string) = File.WriteAllText(filePath, text)
1012

1113
let measureTime (f: 'a -> 'b) x =
1214
let sw = System.Diagnostics.Stopwatch.StartNew()
@@ -15,12 +17,12 @@ let measureTime (f: 'a -> 'b) x =
1517
sw.ElapsedMilliseconds, res
1618

1719
let normalizeFullPath (path: string) =
18-
System.IO.Path.GetFullPath(path).Replace('\\', '/')
20+
Path.GetFullPath(path).Replace('\\', '/')
1921

2022
let getRelativePath (pathFrom: string) (pathTo: string) =
21-
System.IO.Path.GetRelativePath(pathFrom, pathTo).Replace('\\', '/')
23+
Path.GetRelativePath(pathFrom, pathTo).Replace('\\', '/')
2224

23-
#else // !DOTNET_FILE_SYSTEM
25+
#else
2426

2527
open Fable.Core.JsInterop
2628

@@ -37,13 +39,13 @@ type private IPath =
3739
abstract resolve: string -> string
3840
abstract relative: string * string -> string
3941

40-
let private File: IFileSystem = importAll "fs"
42+
let private FileSystem: IFileSystem = importAll "fs"
4143
let private Process: IProcess = importAll "process"
4244
let private Path: IPath = importAll "path"
4345

44-
let readAllBytes (filePath: string) = File.readFileSync(filePath)
45-
let readAllText (filePath: string) = File.readFileSync(filePath, "utf8").TrimStart('\uFEFF')
46-
let writeAllText (filePath: string) (text:string) = File.writeFileSync(filePath, text)
46+
let readAllBytes (filePath: string) = FileSystem.readFileSync(filePath)
47+
let readAllText (filePath: string) = FileSystem.readFileSync(filePath, "utf8").TrimStart('\uFEFF')
48+
let writeAllText (filePath: string) (text: string) = FileSystem.writeFileSync(filePath, text)
4749

4850
let measureTime (f: 'a -> 'b) x =
4951
let startTime = Process.hrtime()
@@ -67,11 +69,21 @@ module Path =
6769
else (path1.TrimEnd [|'\\';'/'|]) + "/"
6870
path1 + (path2.TrimStart [|'\\';'/'|])
6971

72+
let ChangeExtension (path: string, ext: string) =
73+
let i = path.LastIndexOf(".")
74+
if i < 0 then path
75+
else path.Substring(0, i) + ext
76+
7077
let GetFileName (path: string) =
7178
let normPath = path.Replace("\\", "/").TrimEnd('/')
7279
let i = normPath.LastIndexOf("/")
7380
normPath.Substring(i + 1)
7481

82+
let GetFileNameWithoutExtension (path: string) =
83+
let path = GetFileName path
84+
let i = path.LastIndexOf(".")
85+
path.Substring(0, i)
86+
7587
let GetDirectoryName (path: string) =
7688
let normPath = path.Replace("\\", "/")
7789
let i = normPath.LastIndexOf("/")
Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
module Fable.Compiler.ProjectParser
2+
3+
open Fable.Compiler.Platform
4+
open System.Collections.Generic
5+
open System.Text.RegularExpressions
6+
7+
let (|Regex|_|) (pattern: string) (input: string) =
8+
let m = Regex.Match(input, pattern)
9+
if m.Success then
10+
let mutable groups = []
11+
for i = m.Groups.Count - 1 downto 0 do
12+
groups <- m.Groups.[i].Value::groups
13+
Some groups
14+
else None
15+
16+
let parseCompilerOptions projectText =
17+
18+
// get project type
19+
let m = Regex.Match(projectText, @"<OutputType[^>]*>([^<]*)<\/OutputType[^>]*>")
20+
let target = if m.Success then m.Groups.[1].Value.Trim().ToLowerInvariant() else ""
21+
22+
// get warning level
23+
let m = Regex.Match(projectText, @"<WarningLevel[^>]*>([^<]*)<\/WarningLevel[^>]*>")
24+
let warnLevel = if m.Success then m.Groups.[1].Value.Trim() else ""
25+
26+
// get treat warnings as errors
27+
let m = Regex.Match(projectText, @"<TreatWarningsAsErrors[^>]*>([^<]*)<\/TreatWarningsAsErrors[^>]*>")
28+
let treatWarningsAsErrors = m.Success && m.Groups.[1].Value.Trim().ToLowerInvariant() = "true"
29+
30+
// get conditional defines
31+
let defines =
32+
Regex.Matches(projectText, @"<DefineConstants[^>]*>([^<]*)<\/DefineConstants[^>]*>")
33+
|> Seq.collect (fun m -> m.Groups.[1].Value.Split(';'))
34+
|> Seq.append ["FABLE_COMPILER"]
35+
|> Seq.map (fun s -> s.Trim())
36+
|> Seq.distinct
37+
|> Seq.except ["$(DefineConstants)"; ""]
38+
|> Seq.toArray
39+
40+
// get disabled warnings
41+
let nowarns =
42+
Regex.Matches(projectText, @"<NoWarn[^>]*>([^<]*)<\/NoWarn[^>]*>")
43+
|> Seq.collect (fun m -> m.Groups.[1].Value.Split(';'))
44+
|> Seq.map (fun s -> s.Trim())
45+
|> Seq.distinct
46+
|> Seq.except ["$(NoWarn)"; ""]
47+
|> Seq.toArray
48+
49+
// get warnings as errors
50+
let warnAsErrors =
51+
Regex.Matches(projectText, @"<WarningsAsErrors[^>]*>([^<]*)<\/WarningsAsErrors[^>]*>")
52+
|> Seq.collect (fun m -> m.Groups.[1].Value.Split(';'))
53+
|> Seq.map (fun s -> s.Trim())
54+
|> Seq.distinct
55+
|> Seq.except ["$(WarningsAsErrors)"; ""]
56+
|> Seq.toArray
57+
58+
// get other flags
59+
let otherFlags =
60+
Regex.Matches(projectText, @"<OtherFlags[^>]*>([^<]*)<\/OtherFlags[^>]*>")
61+
|> Seq.collect (fun m -> m.Groups.[1].Value.Split(' '))
62+
|> Seq.map (fun s -> s.Trim())
63+
|> Seq.distinct
64+
|> Seq.except ["$(OtherFlags)"; ""]
65+
|> Seq.toArray
66+
67+
let otherOptions = [|
68+
if target.Length > 0 then
69+
yield "--target:" + target
70+
if warnLevel.Length > 0 then
71+
yield "--warn:" + warnLevel
72+
if treatWarningsAsErrors then
73+
yield "--warnaserror+"
74+
for d in defines do yield "-d:" + d
75+
for n in nowarns do yield "--nowarn:" + n
76+
for e in warnAsErrors do yield "--warnaserror:" + e
77+
for o in otherFlags do yield o
78+
|]
79+
otherOptions
80+
81+
let parseProjectScript projectPath =
82+
let projectFileName = Path.GetFileName projectPath
83+
let projectText = readAllText projectPath
84+
let projectDir = Path.GetDirectoryName projectPath
85+
let dllRefs, srcFiles =
86+
(([||], [||]), projectText.Split('\n'))
87+
||> Array.fold (fun (dllRefs, srcFiles) line ->
88+
let line = line.Trim()
89+
match line.Trim() with
90+
| Regex @"^#r\s+""(.*?)""$" [_;path]
91+
when not(path.EndsWith("Fable.Core.dll")) ->
92+
Array.append [|Path.Combine(projectDir, path)|] dllRefs, srcFiles
93+
| Regex @"^#load\s+""(.*?)""$" [_;path] ->
94+
dllRefs, Array.append [|Path.Combine(projectDir, path)|] srcFiles
95+
| _ -> dllRefs, srcFiles)
96+
let projectRefs = [||]
97+
let sourceFiles = Array.append srcFiles [|Path.GetFileName projectPath|]
98+
let otherOptions = [| "--define:FABLE_COMPILER" |]
99+
(projectFileName, dllRefs, projectRefs, sourceFiles, otherOptions)
100+
101+
let parseProjectFile projectPath =
102+
let projectFileName = Path.GetFileName projectPath
103+
let projectText = readAllText projectPath
104+
105+
// remove all comments
106+
let projectText = Regex.Replace(projectText, @"<!--[\s\S]*?-->", "")
107+
108+
// get project references
109+
let projectRefs =
110+
Regex.Matches(projectText, @"<ProjectReference\s+[^>]*Include\s*=\s*(""[^""]*|'[^']*)")
111+
|> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim().Replace("\\", "/"))
112+
|> Seq.toArray
113+
114+
// replace some variables
115+
let projectText = projectText.Replace(@"$(MSBuildProjectDirectory)", __dirname)
116+
let m = Regex.Match(projectText, @"<FSharpSourcesRoot[^>]*>([^<]*)<\/FSharpSourcesRoot[^>]*>")
117+
let sourcesRoot = if m.Success then m.Groups.[1].Value.Replace("\\", "/") else ""
118+
let projectText = projectText.Replace(@"$(FSharpSourcesRoot)", sourcesRoot)
119+
120+
// get source files
121+
let sourceFilesRegex = @"<Compile\s+[^>]*Include\s*=\s*(""[^""]*|'[^']*)"
122+
let sourceFiles =
123+
Regex.Matches(projectText, sourceFilesRegex)
124+
|> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim().Replace("\\", "/"))
125+
|> Seq.toArray
126+
127+
let dllRefs = [||]
128+
let otherOptions = parseCompilerOptions projectText
129+
(projectFileName, dllRefs, projectRefs, sourceFiles, otherOptions)
130+
131+
let makeHashSetIgnoreCase () =
132+
let equalityComparerIgnoreCase =
133+
{ new IEqualityComparer<string> with
134+
member __.Equals(x, y) = x.ToLowerInvariant() = y.ToLowerInvariant()
135+
member __.GetHashCode(x) = hash (x.ToLowerInvariant()) }
136+
HashSet<string>(equalityComparerIgnoreCase)
137+
138+
let dedupProjectRefs (projSet: HashSet<string>) projectRefs =
139+
let newRefs = projectRefs |> Array.filter (fun x -> projSet.Contains(x) |> not)
140+
projSet.UnionWith(newRefs)
141+
newRefs
142+
143+
let dedupFileNames (fileSet: HashSet<string>) fileNames =
144+
let padName (fileName: string) =
145+
let pos = fileName.LastIndexOf(".")
146+
let nm = if pos < 0 then fileName else fileName.Substring(0, pos)
147+
let ext = if pos < 0 then "" else fileName.Substring(pos)
148+
nm + "_" + ext
149+
let rec dedup fileName =
150+
if fileSet.Contains(fileName) then
151+
dedup (padName fileName)
152+
else
153+
fileSet.Add(fileName) |> ignore
154+
fileName
155+
fileNames |> Array.map dedup
156+
157+
let rec parseProject (projSet: HashSet<string>) (projectPath: string) =
158+
let (projectFileName, dllRefs, projectRefs, sourceFiles, otherOptions) =
159+
if projectPath.EndsWith(".fsx")
160+
then parseProjectScript projectPath
161+
else parseProjectFile projectPath
162+
163+
let projectFileDir = Path.GetDirectoryName projectPath
164+
let isAbsolutePath (path: string) = path.StartsWith("/") || path.IndexOf(":") = 1
165+
let makePath path =
166+
if isAbsolutePath path then path
167+
else Path.Combine(projectFileDir, path)
168+
|> normalizeFullPath
169+
170+
let sourcePaths = sourceFiles |> Array.map makePath
171+
let sourceTexts = sourcePaths |> Array.map readAllText
172+
173+
// parse and combine all referenced projects into one big project
174+
let parsedProjects = projectRefs |> Array.map makePath |> dedupProjectRefs projSet |> Array.map (parseProject projSet)
175+
let sourcePaths = sourcePaths |> Array.append (parsedProjects |> Array.collect (fun (_,_,x,_,_) -> x))
176+
let sourceTexts = sourceTexts |> Array.append (parsedProjects |> Array.collect (fun (_,_,_,x,_) -> x))
177+
let otherOptions = otherOptions |> Array.append (parsedProjects |> Array.collect (fun (_,_,_,_,x) -> x))
178+
179+
(projectFileName, dllRefs, sourcePaths, sourceTexts, otherOptions |> Array.distinct)

fcs/fcs-fable/test/bench.fs

Lines changed: 8 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -1,88 +1,12 @@
1-
module App
1+
module Fable.Compiler.App
22

3-
open System.Text.RegularExpressions
43
open FSharp.Compiler.SourceCodeServices
5-
open Platform
4+
open Fable.Compiler.Platform
5+
open Fable.Compiler.ProjectParser
66

77
let references = Metadata.references_core
88
let metadataPath = "/temp/repl/metadata2/" // .NET BCL binaries
99

10-
let parseProjectFile projectPath =
11-
let projectFileName = Path.GetFileName projectPath
12-
let projectText = readAllText projectPath
13-
14-
// remove all comments
15-
let projectText = Regex.Replace(projectText, @"<!--[\s\S]*?-->", "")
16-
17-
// get conditional defines
18-
let definesRegex = @"<DefineConstants[^>]*>([^<]*)<\/DefineConstants[^>]*>"
19-
let defines =
20-
Regex.Matches(projectText, definesRegex)
21-
|> Seq.collect (fun m -> m.Groups.[1].Value.Split(';'))
22-
|> Seq.append ["FABLE_COMPILER"]
23-
|> Seq.map (fun s -> s.Trim())
24-
|> Seq.distinct
25-
|> Seq.except ["$(DefineConstants)"; ""]
26-
|> Seq.toArray
27-
28-
// get project references
29-
let projectRefsRegex = @"<ProjectReference\s+[^>]*Include\s*=\s*(""[^""]*|'[^']*)"
30-
let projectRefs =
31-
Regex.Matches(projectText, projectRefsRegex)
32-
|> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim().Replace("\\", "/"))
33-
|> Seq.toArray
34-
35-
// replace some variables
36-
let projectText = projectText.Replace(@"$(MSBuildProjectDirectory)", ".")
37-
let m = Regex.Match(projectText, @"<FSharpSourcesRoot[^>]*>([^<]*)<\/FSharpSourcesRoot[^>]*>")
38-
let sourcesRoot = if m.Success then m.Groups.[1].Value.Replace("\\", "/") else ""
39-
let projectText = projectText.Replace(@"$(FSharpSourcesRoot)", sourcesRoot)
40-
41-
// get source files
42-
let sourceFilesRegex = @"<Compile\s+[^>]*Include\s*=\s*(""[^""]*|'[^']*)"
43-
let sourceFiles =
44-
Regex.Matches(projectText, sourceFilesRegex)
45-
|> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim().Replace("\\", "/"))
46-
|> Seq.toArray
47-
48-
(projectFileName, projectRefs, sourceFiles, defines)
49-
50-
let rec parseProject projectPath =
51-
let (projectFileName, projectRefs, sourceFiles, defines) = parseProjectFile projectPath
52-
53-
let projectFileDir = Path.GetDirectoryName projectPath
54-
let isAbsolutePath (path: string) = path.StartsWith("/") || path.IndexOf(":") = 1
55-
let makePath path = if isAbsolutePath path then path else Path.Combine(projectFileDir, path)
56-
57-
let fileNames = sourceFiles |> Array.map (fun path -> path |> makePath |> normalizeFullPath)
58-
let sources = sourceFiles |> Array.map (fun path -> path |> makePath |> readAllText)
59-
60-
let parsedProjects = projectRefs |> Array.map makePath |> Array.map parseProject
61-
let fileNames = fileNames |> Array.append (parsedProjects |> Array.collect (fun (_,x,_,_) -> x))
62-
let sources = sources |> Array.append (parsedProjects |> Array.collect (fun (_,_,x,_) -> x))
63-
let defines = defines |> Array.append (parsedProjects |> Array.collect (fun (_,_,_,x) -> x))
64-
65-
(projectFileName, fileNames, sources, defines |> Array.distinct)
66-
67-
let dedupFileNames fileNames =
68-
let comparerIgnoreCase =
69-
{ new System.Collections.Generic.IEqualityComparer<string> with
70-
member __.Equals(x, y) = x.ToLowerInvariant() = y.ToLowerInvariant()
71-
member __.GetHashCode(x) = hash (x.ToLowerInvariant()) }
72-
let nameSet = System.Collections.Generic.HashSet<string>(comparerIgnoreCase)
73-
let padName (name: string) =
74-
let pos = name.LastIndexOf(".")
75-
let nm = if pos < 0 then name else name.Substring(0, pos)
76-
let ext = if pos < 0 then "" else name.Substring(pos)
77-
nm + "_" + ext
78-
let rec dedup name =
79-
if nameSet.Contains(name) then
80-
dedup (padName name)
81-
else
82-
nameSet.Add(name) |> ignore
83-
name
84-
fileNames |> Array.map dedup
85-
8610
let printErrors showWarnings (errors: FSharpErrorInfo[]) =
8711
let isWarning (e: FSharpErrorInfo) =
8812
e.Severity = FSharpErrorSeverity.Warning
@@ -100,14 +24,16 @@ let printErrors showWarnings (errors: FSharpErrorInfo[]) =
10024

10125
let parseFiles projectPath outDir optimized =
10226
// parse project
103-
let (projectFileName, fileNames, sources, defines) = parseProject projectPath
27+
let projSet = makeHashSetIgnoreCase ()
28+
let (projectFileName, dllRefs, fileNames, sources, otherOptions) = parseProject projSet projectPath
10429

10530
// dedup file names
106-
let fileNames = dedupFileNames fileNames
31+
let fileSet = makeHashSetIgnoreCase ()
32+
let fileNames = dedupFileNames fileSet fileNames
10733

10834
// create checker
10935
let readAllBytes dllName = readAllBytes (metadataPath + dllName)
110-
let createChecker () = InteractiveChecker.Create(references, readAllBytes, defines, optimize=false)
36+
let createChecker () = InteractiveChecker.Create(references, readAllBytes, otherOptions)
11137
let ms0, checker = measureTime createChecker ()
11238
printfn "--------------------------------------------"
11339
printfn "InteractiveChecker created in %d ms" ms0

fcs/fcs-fable/test/fcs-fable-bench.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
<ItemGroup>
1414
<Compile Include="Metadata.fs"/>
1515
<Compile Include="Platform.fs"/>
16+
<Compile Include="ProjectParser.fs"/>
1617
<Compile Include="bench.fs"/>
1718
</ItemGroup>
1819

fcs/fcs-fable/test/package.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@
1313
"bench-dotnet": "dotnet run -c Release -p fcs-fable-bench.fsproj ../fcs-fable.fsproj"
1414
},
1515
"devDependencies": {
16-
"@babel/core": "^7.2.0",
16+
"@babel/core": "^7.3.4",
1717
"@babel/plugin-transform-modules-commonjs": "^7.2.0",
18-
"fable-splitter": "2.0.2"
18+
"fable-splitter": "^2.1.5"
1919
}
2020
}

fcs/fcs-fable/test/test.fs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
1-
module App
1+
module Fable.Compiler.App
22

33
open FSharp.Compiler
44
open FSharp.Compiler.SourceCodeServices
5-
open Platform
5+
open Fable.Compiler.Platform
66

77
let references = Metadata.references_core
88
let metadataPath = "/temp/repl/metadata2/" // .NET BCL binaries

0 commit comments

Comments
 (0)