1+ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+ namespace FSharp.Compiler.ComponentTests.Miscellaneous.FsharpSuiteMigrated
4+
5+ open System
6+ open System.IO
7+ open Xunit
8+ open FSharp.Test
9+ open FSharp.Test .Compiler
10+ open FSharp.Test .ScriptHelpers
11+
12+
13+
14+ module Configuration =
15+ let supportedNames = set [ " testlib.fsi" ; " testlib.fs" ; " test.mli" ; " test.ml" ; " test.fsi" ; " test.fs" ; " test2.fsi" ; " test2.fs" ; " test.fsx" ; " test2.fsx" ]
16+
17+ module ScriptRunner =
18+ open Internal.Utilities .Library
19+
20+ let private createEngine ( args , version ) =
21+ let scriptingEnv = getSessionForEval args version
22+ scriptingEnv.Eval """
23+ let errorStringWriter = new System.IO.StringWriter()
24+ let oldConsoleError = System.Console.Error
25+ System.Console.SetError(errorStringWriter)
26+ let exit (code:int) =
27+ System.Console.SetError(oldConsoleError)
28+ if code=0 then
29+ ()
30+ else failwith $"Script called function 'exit' with code={code} and collected in stderr: {errorStringWriter.ToString()}" """ |> ignore
31+ scriptingEnv
32+
33+ let defaultDefines =
34+ [
35+ #if NETCOREAPP
36+ " NETCOREAPP"
37+ #endif
38+ ]
39+
40+ let runScriptFile version ( cu : CompilationUnit ) =
41+ let cu = cu |> withDefines defaultDefines
42+ match cu with
43+ | FS fsSource ->
44+ File.Delete( " test.ok" )
45+ let engine = createEngine ( fsSource.Options |> Array.ofList, version)
46+ let res = evalScriptFromDiskInSharedSession engine cu
47+ match res with
48+ | CompilationResult.Failure _ -> res
49+ | CompilationResult.Success s ->
50+ if File.Exists( " test.ok" ) then
51+ res
52+ else
53+ failwith $" Results looked correct, but 'test.ok' file was not created. Result: %A "
54+
55+ | _ -> failwith $" Compilation unit other than fsharp is not supported, cannot process %A "
56+
57+ /// This test file was created by porting over (slower) FsharpSuite.Tests
58+ /// In order to minimize human error, the test definitions have been copy-pasted and this adapter provides implementations of the test functions
59+ module TestFrameworkAdapter =
60+ open FSharp.Test .Compiler .Assertions .TextBasedDiagnosticAsserts
61+
62+ type ExecutionMode =
63+ | FSC_ DEBUG
64+ | FSC_ OPTIMIZED
65+ | FSI
66+ | COMPILED_ EXE_ APP
67+ | NEG_ TEST_ BUILD of testName : string
68+
69+ let baseFolder = Path.Combine(__ SOURCE_ DIRECTORY__, " .." , " .." , " fsharp" ) |> Path.GetFullPath
70+
71+ let diffNegativeBaseline ( cr : CompilationUnit ) absFolder testName _version =
72+ let expectedFiles = Directory.GetFiles( absFolder, testName + " .*" )
73+ let baselines =
74+ [ for f in expectedFiles do
75+ match Path.GetExtension( f) with
76+ | " .bsl" -> cr, f
77+ | " .vsbsl" -> cr |> withOptions [ " --test:ContinueAfterParseFailure" ], f
78+ | _ -> () ]
79+ [ for compilationUnit, baseline in baselines do
80+ compilationUnit
81+ |> typecheck
82+ |> withResultsMatchingFile baseline ]
83+ |> List.head
84+
85+
86+ let adjustVersion version bonusArgs =
87+ match version with
88+ | LangVersion.V47 -> " 4.7" , bonusArgs
89+ | LangVersion.V50 -> " 5.0" , bonusArgs
90+ | LangVersion.V60 -> " 6.0" , bonusArgs
91+ | LangVersion.V70 -> " 7.0" , bonusArgs
92+ | LangVersion.Preview -> " preview" , bonusArgs
93+ | LangVersion.Latest -> " latest" , bonusArgs
94+ | LangVersion.SupportsMl -> " 5.0" , " --mlcompatibility" :: bonusArgs
95+
96+
97+ let singleTestBuildAndRunAuxVersion ( folder : string ) bonusArgs mode langVersion =
98+ let absFolder = Path.Combine( baseFolder, folder)
99+ let supportedNames , files =
100+ match mode with
101+ | NEG_ TEST_ BUILD testName ->
102+ let nameSet =
103+ Configuration.supportedNames
104+ .Add( testName+ " .fsx" )
105+ .Add( testName+ " .fs" )
106+ .Add( testName+ " .fsi" )
107+ .Add( testName+ " -pre.fs" )
108+ let files = Directory.GetFiles( absFolder, " *.fs*" ) |> Array.filter( fun n -> nameSet.Contains( Path.GetFileName( n)))
109+ nameSet, files
110+ | _ -> Configuration.supportedNames, Directory.GetFiles( absFolder, " test*.fs*" )
111+
112+ let mainFile , otherFiles =
113+ match files.Length with
114+ | 0 -> Directory.GetFiles( absFolder, " *.ml" ) |> Array.exactlyOne, [||]
115+ | 1 -> files |> Array.exactlyOne, [||]
116+ | _ ->
117+ let mainFile , dependencies =
118+ files
119+ |> Array.filter ( fun n -> supportedNames.Contains( Path.GetFileName( n)))
120+ // Convention in older FsharpSuite: test2 goes last, longer names like testlib before test, .fsi before .fs on equal filenames
121+ |> Array.sortBy ( fun n -> n.Contains( " test2" ), - n.IndexOf( '.' ), n.EndsWith( " .fsi" ) |> not )
122+ |> Array.splitAt 1
123+
124+ mainFile[ 0 ], dependencies
125+
126+ let version , bonusArgs = adjustVersion langVersion bonusArgs
127+
128+ FsFromPath mainFile
129+ |> withAdditionalSourceFiles [ for f in otherFiles -> SourceFromPath f]
130+ |> withLangVersion version
131+ |> fun cu ->
132+ match mode with
133+ | FSC_ DEBUG | FSC_ OPTIMIZED | FSI | COMPILED_ EXE_ APP ->
134+ cu
135+ |> ignoreWarnings
136+ |> withOptions ([ " --nowarn:0988;3370" ] @ bonusArgs)
137+ | NEG_ TEST_ BUILD _ ->
138+ cu |>
139+ withOptions ([ " --vserrors" ; " --maxerrors:10000" ; " --warnaserror" ; " --warn:3" ; " --nowarn:20;21;1178;52" ] @ bonusArgs)
140+ |> fun cu ->
141+ match mode with
142+ | FSC_ DEBUG ->
143+ cu
144+ |> withDebug
145+ |> withNoOptimize
146+ |> ScriptRunner.runScriptFile langVersion
147+ |> shouldSucceed
148+ | FSC_ OPTIMIZED ->
149+ cu
150+ |> withOptimize
151+ |> withNoDebug
152+ |> ScriptRunner.runScriptFile langVersion
153+ |> shouldSucceed
154+ | FSI ->
155+ cu
156+ |> ScriptRunner.runScriptFile langVersion
157+ |> shouldSucceed
158+ | COMPILED_ EXE_ APP ->
159+ cu
160+ |> withDefines ( " TESTS_AS_APP" :: ScriptRunner.defaultDefines)
161+ |> compileExeAndRun
162+ |> shouldSucceed
163+ | NEG_ TEST_ BUILD testName -> diffNegativeBaseline ( cu |> withName mainFile) absFolder testName langVersion
164+
165+ |> ignore< CompilationResult>
166+
167+
168+ let singleTestBuildAndRunAux folder bonusArgs mode = singleTestBuildAndRunAuxVersion folder bonusArgs mode LangVersion.Latest
169+ let singleTestBuildAndRunVersion folder mode version = singleTestBuildAndRunAuxVersion folder [] mode version
170+ let singleTestBuildAndRun folder mode = singleTestBuildAndRunVersion folder mode LangVersion.Latest
171+
172+ let singleVersionedNegTestAux folder bonusArgs version testName =
173+ singleTestBuildAndRunAuxVersion folder bonusArgs ( NEG_ TEST_ BUILD testName) version
174+ let singleVersionedNegTest ( folder : string ) ( version : LangVersion ) ( testName : string ) =
175+ singleVersionedNegTestAux folder [] version testName
176+ let singleNegTest folder testName = singleVersionedNegTest folder LangVersion.Latest testName
0 commit comments