Skip to content

Commit

Permalink
Backend: use reflectionless default build (for UWP frontend)
Browse files Browse the repository at this point in the history
It turns out that F#'s (s)printf(n) functions use reflection [1],
so UWP's CoreRT compiler/runtime is not happy about it at all [2];
then this is a workaround that uses `String.Format` underneath,
except when compiled with the a define for stricter compilation.
(Compiling with this define will still give us the compile-time
safety of sprintf vs String.Format such as checking number of
arguments and their types, but without the portability to UWP.)

[1] dotnet/corert#6055 (comment)
[2] https://stackoverflow.com/q/60350735/544947
  • Loading branch information
knocte committed Mar 17, 2020
1 parent f9798f6 commit 7c19ba4
Show file tree
Hide file tree
Showing 30 changed files with 497 additions and 131 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/macOS.yml
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ jobs:
steps:
- uses: actions/checkout@v1
- name: Run a one-line script
run: ./configure.sh && make release
run: ./configure.sh && make sanitycheck && make strict && make release

macOS_tests_unit:
runs-on: macOS-latest
Expand Down
2 changes: 1 addition & 1 deletion .github/workflows/windows.yml
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ jobs:
- uses: actions/checkout@v1
- name: Run a one-line script
shell: cmd
run: configure.bat && make.bat release
run: configure.bat && make.bat sanitycheck && make.bat strict && make.bat release

windows_tests_unit:
runs-on: windows-latest
Expand Down
14 changes: 12 additions & 2 deletions .gitlab-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,11 @@ stockmono_build:
- DEBIAN_FRONTEND=noninteractive apt-get install -y mono-complete mono-xbuild fsharp
- mono --version

- time (./configure.sh && make && make install)
- ./configure.sh
- make sanitycheck
- make strict
- make
- make install
# so that we log the version of nuget for when it works
- make nuget

Expand All @@ -44,6 +48,8 @@ stocknewmono_build:
- apt install -y make git

- ./configure.sh
- make sanitycheck
- make strict
- make
- make install

Expand Down Expand Up @@ -86,7 +92,11 @@ newmono_build:
script:
- ./scripts/install_mono_from_microsoft_deb_packages.sh

- time (./configure.sh && make && make install)
- ./configure.sh
- make sanitycheck
- make strict
- make
- make install
# so that we log the version of nuget for when it works
- make nuget

Expand Down
6 changes: 6 additions & 0 deletions Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -21,3 +21,9 @@ update-servers:

nuget:
@./scripts/make.sh nuget

sanitycheck:
@./scripts/make.sh sanitycheck

strict:
@./scripts/make.sh strict
93 changes: 93 additions & 0 deletions scripts/find.fsx
Original file line number Diff line number Diff line change
@@ -0,0 +1,93 @@
#!/usr/bin/env fsharpi

open System
open System.IO
open System.Linq

#r "System.Configuration"
#load "InfraLib/Misc.fs"
#load "InfraLib/Process.fs"
#load "InfraLib/Git.fs"
open FSX.Infrastructure
open Process

let FindInFile (file: FileInfo)
(maybeExcludeItems: Option<seq<FileSystemInfo>>)
(someStrings: seq<string>)
: unit =
let doIt () =
for line in File.ReadLines file.FullName do
for someString in someStrings do
if line.IndexOf someString >= 0 then
printfn "%s: %s" file.FullName line

match maybeExcludeItems with
| None ->
doIt ()
| Some excludeItems ->
if excludeItems.All(fun entryToExclude -> entryToExclude.FullName <> file.FullName) then
doIt ()

let rec FindExcludingDir (dir: DirectoryInfo)
(maybeExcludeItems: Option<seq<FileSystemInfo>>)
(someStrings: seq<string>)
: unit =
let doIt () =
for file in dir.GetFiles() do
if file.Extension.ToLower() <> ".dll" &&
file.Extension.ToLower() <> ".exe" &&
file.Extension.ToLower() <> ".png" then
FindInFile file maybeExcludeItems someStrings
for subFolder in dir.GetDirectories() do
if subFolder.Name <> ".git" &&
subFolder.Name <> "obj" &&
subFolder.Name <> "bin" &&
subFolder.Name <> "packages" then
FindExcludingDir subFolder maybeExcludeItems someStrings
match maybeExcludeItems with
| None ->
doIt ()
| Some excludeItems ->
if excludeItems.All(fun entryToExclude -> entryToExclude.FullName <> dir.FullName) then
doIt ()

let args = Misc.FsxArguments()

let note = "NOTE: by default, some kind of files/folders will be excluded, e.g.: .git/, packages/, bin/, obj/, *.exe, *.dll, *.png, ..."

if args.Length < 1 then
Console.Error.WriteLine "Please pass at least 1 argument, with optional flag: find.fsx [-x=someDirToExclude,someFileToExclude] someString"
Console.WriteLine note
Environment.Exit 1

let firstArg = args.[0]

let excludeParticularFileSystemEntries =
if firstArg.StartsWith "--exclude=" || firstArg.StartsWith "-x=" then
firstArg.Substring(firstArg.IndexOf("=")+1) |> Some
else
None

let startDir = Directory.GetCurrentDirectory() |> DirectoryInfo
match excludeParticularFileSystemEntries with
| None ->
let someStrings = args
FindExcludingDir startDir None someStrings
| Some excludeList ->
let someStrings = args.Skip(1)
let entriesToExclude =
excludeList.Split([|Path.PathSeparator|], StringSplitOptions.RemoveEmptyEntries)
let excludeItems =
seq {
for entry in entriesToExclude do
let dir = entry |> DirectoryInfo
let file = entry |> FileInfo
if dir.Exists then
yield dir :> FileSystemInfo
elif file.Exists then
yield file :> FileSystemInfo
else
failwithf "Directory or file '%s' doesn't exist" dir.FullName
}
FindExcludingDir startDir (Some excludeItems) someStrings

67 changes: 55 additions & 12 deletions scripts/make.fsx
Original file line number Diff line number Diff line change
Expand Up @@ -114,17 +114,22 @@ let PrintNugetVersion () =
Console.WriteLine()
failwith "nuget process' output contained errors ^"

let JustBuild binaryConfig =
let JustBuild binaryConfig maybeConstant =
let buildTool = Map.tryFind "BuildTool" buildConfigContents
if buildTool.IsNone then
failwith "A BuildTool should have been chosen by the configure script, please report this bug"

Console.WriteLine (sprintf "Building in %s mode..." (binaryConfig.ToString()))
let configOption = sprintf "/p:Configuration=%s" (binaryConfig.ToString())
let configOptions =
let defineConstantsFromBuildConfig =
match buildConfigContents |> Map.tryFind "DefineConstants" with
| Some constants -> sprintf "%s;DefineConstants=%s" configOption constants
| None -> configOption
| Some constants -> constants.Split([|";"|], StringSplitOptions.RemoveEmptyEntries) |> Seq.ofArray
| None -> Seq.empty
let allDefineConstants =
match maybeConstant with
| Some constant -> Seq.append [constant] defineConstantsFromBuildConfig
| None -> defineConstantsFromBuildConfig
let configOptions = sprintf "%s;DefineConstants=%s" configOption (String.Join(";", allDefineConstants))
let buildProcess = Process.Execute ({ Command = buildTool.Value; Arguments = configOptions }, Echo.All)
if (buildProcess.ExitCode <> 0) then
Console.Error.WriteLine (sprintf "%s build failed" buildTool.Value)
Expand All @@ -148,9 +153,9 @@ let GetPathToFrontendBinariesDir (binaryConfig: BinaryConfig) =
let GetPathToBackend () =
Path.Combine (rootDir.FullName, "src", BACKEND)

let MakeAll() =
let MakeAll maybeConstant =
let buildConfig = BinaryConfig.Debug
JustBuild buildConfig
JustBuild buildConfig maybeConstant
buildConfig

let RunFrontend (buildConfig: BinaryConfig) (maybeArgs: Option<string>) =
Expand Down Expand Up @@ -186,10 +191,10 @@ let RunFrontend (buildConfig: BinaryConfig) (maybeArgs: Option<string>) =
let maybeTarget = GatherTarget (Misc.FsxArguments(), None)
match maybeTarget with
| None ->
MakeAll() |> ignore
MakeAll None |> ignore

| Some("release") ->
JustBuild BinaryConfig.Release
JustBuild BinaryConfig.Release None

| Some "nuget" ->
Console.WriteLine "This target is for debugging purposes."
Expand All @@ -205,7 +210,7 @@ match maybeTarget with
let version = Misc.GetCurrentVersion(rootDir).ToString()

let release = BinaryConfig.Release
JustBuild release
JustBuild release None
let binDir = "bin"
Directory.CreateDirectory(binDir) |> ignore

Expand Down Expand Up @@ -258,7 +263,7 @@ match maybeTarget with
| _ ->
let nunitVersion = "2.7.1"
if not nugetExe.Exists then
MakeAll () |> ignore
MakeAll None |> ignore

let nugetInstallCommand =
{
Expand All @@ -285,7 +290,7 @@ match maybeTarget with

| Some("install") ->
let buildConfig = BinaryConfig.Release
JustBuild buildConfig
JustBuild buildConfig None

let destDirUpperCase = Environment.GetEnvironmentVariable "DESTDIR"
let destDirLowerCase = Environment.GetEnvironmentVariable "DestDir"
Expand Down Expand Up @@ -313,7 +318,7 @@ match maybeTarget with
failwith "Unexpected chmod failure, please report this bug"

| Some("run") ->
let buildConfig = MakeAll()
let buildConfig = MakeAll None
RunFrontend buildConfig None
|> ignore

Expand All @@ -327,6 +332,44 @@ match maybeTarget with
let proc2 = RunFrontend buildConfig (Some "--update-servers-stats")
Environment.Exit proc2.ExitCode

| Some "strict" ->
MakeAll <| Some "STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME"
|> ignore

| Some "sanitycheck" ->
let FindOffendingPrintfUsage () =
let findScript = Path.Combine(rootDir.FullName, "scripts", "find.fsx")
let fsxRunner =
match Misc.GuessPlatform() with
| Misc.Platform.Windows ->
Path.Combine(rootDir.FullName, "scripts", "fsi.bat")
| _ ->
let fsxRunnerEnvVar = Environment.GetEnvironmentVariable "FsxRunner"
if String.IsNullOrEmpty fsxRunnerEnvVar then
failwith "FsxRunner env var should have been passed to make.sh"
fsxRunnerEnvVar
let excludeFolders =
String.Format("scripts{0}" +
"src{1}GWallet.Frontend.Console{0}" +
"src{1}GWallet.Backend.Tests{0}" +
"src{1}GWallet.Backend{1}FSharpUtil.fs",
Path.PathSeparator, Path.DirectorySeparatorChar)

let proc =
{
Command = fsxRunner
Arguments = sprintf "%s --exclude=%s %s"
findScript
excludeFolders
"printf failwithf"
}
let findProc = Process.SafeExecute (proc, Echo.All)
if findProc.Output.StdOut.Trim().Length > 0 then
Console.Error.WriteLine "Illegal usage of printf/printfn/sprintf/sprintfn/failwithf detected"
Environment.Exit 1

FindOffendingPrintfUsage()

| Some(someOtherTarget) ->
Console.Error.WriteLine("Unrecognized target: " + someOtherTarget)
Environment.Exit 2
2 changes: 1 addition & 1 deletion scripts/make.sh
Original file line number Diff line number Diff line change
Expand Up @@ -6,4 +6,4 @@ if [ ! -f "$BUILD_CONFIG" ]; then
echo "ERROR: configure hasn't been run yet, run ./configure.sh first" >&2 && exit 1
fi
source "$BUILD_CONFIG"
$FsxRunner ./scripts/make.fsx "$@"
FsxRunner=$FsxRunner $FsxRunner ./scripts/make.fsx "$@"
79 changes: 79 additions & 0 deletions src/GWallet.Backend.Tests/FSharpUtil.fs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,18 @@ open GWallet.Backend
type UnexpectedTaskCanceledException(message: string, innerException) =
inherit TaskCanceledException (message, innerException)

type TypeWithStringOverridenManually =
| FOO
| BAR
override self.ToString() =
match self with
| FOO -> "FOO"
| BAR -> "BAR"

type TypeWithNoToStringOverriden =
| FOO
| BAR

[<TestFixture>]
type FSharpUtilCoverage() =

Expand Down Expand Up @@ -50,3 +62,70 @@ type FSharpUtilCoverage() =
| None -> failwith "should find sibling 2 too"
| Some ex ->
Assert.That(Object.ReferenceEquals(ex, innerEx2), Is.True)

[<Test>]
member __.``converts fsharp's print syntax to String-Format (basic)``() =
let basicStr = "%s"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat basicStr, Is.EqualTo "{0}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 basicStr "foo", Is.EqualTo "foo")

let basicInt1 = "%i"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat basicInt1, Is.EqualTo "{0}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 basicInt1 1, Is.EqualTo "1")

let basicInt2 = "%d"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat basicInt2, Is.EqualTo "{0}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 basicInt2 2, Is.EqualTo "2")

let moreChars = "[%s]"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat moreChars, Is.EqualTo "[{0}]")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 moreChars "foo", Is.EqualTo "[foo]")

let twoStrings = "%s-%s"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat twoStrings, Is.EqualTo "{0}-{1}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF2 twoStrings "foo" "bar", Is.EqualTo "foo-bar")

let twoElementsWithDifferentTypes = "%s-%i"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat twoElementsWithDifferentTypes, Is.EqualTo "{0}-{1}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF2 twoElementsWithDifferentTypes "foo" 1,
Is.EqualTo "foo-1")

let twoElementsWithDifferentTypesWithInverseOrder = "%i-%s"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat twoElementsWithDifferentTypesWithInverseOrder,
Is.EqualTo "{0}-{1}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF2 twoElementsWithDifferentTypesWithInverseOrder 1 "foo",
Is.EqualTo "1-foo")

let advancedEscaping = "%f%% done"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat advancedEscaping, Is.EqualTo "{0}% done")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 advancedEscaping 0.1, Is.EqualTo "0.1% done")

[<Test>]
member __.``converts fsharp's print syntax to String-Format (advanced I)``() =
let advanced = "%A"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat advanced, Is.EqualTo "{0}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 advanced TypeWithStringOverridenManually.FOO,
Is.EqualTo "FOO")

let advanced2 = "%Ax%A"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat advanced2, Is.EqualTo "{0}x{1}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF2 advanced2
TypeWithStringOverridenManually.FOO
TypeWithStringOverridenManually.BAR,
Is.EqualTo "FOOxBAR")

[<Test>]
[<Ignore "NOTE: this test fails with old F# versions (stockmono, stocknewmono CI lanes), passes with new versions (newmono lane)">]
member __.``converts fsharp's print syntax to String-Format (advanced II)``() =
let advanced = "%A"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat advanced, Is.EqualTo "{0}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF1 advanced TypeWithNoToStringOverriden.FOO,
Is.EqualTo "FOO")

let advanced2 = "%Ax%A"
Assert.That(FSharpUtil.ReflectionlessPrint.ToStringFormat advanced2, Is.EqualTo "{0}x{1}")
Assert.That(FSharpUtil.ReflectionlessPrint.SPrintF2 advanced2
TypeWithNoToStringOverriden.FOO
TypeWithNoToStringOverriden.BAR,
Is.EqualTo "FOOxBAR")

Loading

0 comments on commit 7c19ba4

Please sign in to comment.