From 8000fde229ec8300e5937986de4ad8aabc870899 Mon Sep 17 00:00:00 2001 From: Will Speak Date: Sat, 17 Jun 2023 18:32:55 +0100 Subject: [PATCH] Add Spec for Infinite Tail Recursion TCE means that we can run programs like this that recurse forever without having to worry about stack consumption. This program runs using all of a single core indefinitely without any memory use change. --- spec/norun/forever.scm | 4 ++++ test/Feersum.Tests/SpecTests.fs | 8 +++++--- .../Feersum.Tests/_snapshots/Parse_norun/forever.scm.json | 4 ++++ 3 files changed, 13 insertions(+), 3 deletions(-) create mode 100644 spec/norun/forever.scm create mode 100644 test/Feersum.Tests/_snapshots/Parse_norun/forever.scm.json diff --git a/spec/norun/forever.scm b/spec/norun/forever.scm new file mode 100644 index 0000000..cdb7699 --- /dev/null +++ b/spec/norun/forever.scm @@ -0,0 +1,4 @@ +(define world) +(define (hello) (world)) +(set! world (lambda () (hello))) +(hello) diff --git a/test/Feersum.Tests/SpecTests.fs b/test/Feersum.Tests/SpecTests.fs index b4367ec..b563d29 100644 --- a/test/Feersum.Tests/SpecTests.fs +++ b/test/Feersum.Tests/SpecTests.fs @@ -69,7 +69,7 @@ let private runExampleAsync host (exePath: string) = task { let! output = Task.WhenAll([| p.StandardOutput.ReadToEndAsync(); p.StandardError.ReadToEndAsync() |]) - let! exit = p.WaitForExitAsync() + let! _ = p.WaitForExitAsync() return { Output = output[0] |> normaliseEndings @@ -116,6 +116,7 @@ let rec ``spec tests compile and run`` specPath configuration = let binDir = [| specBin; options.Configuration |> string |] |> Path.Combine let shouldFail = sourcePath.Contains "fail" + let shouldRun = sourcePath.Contains "norun" |> not let mutable references = [ typeof.Assembly.Location ] @@ -167,9 +168,10 @@ let rec ``spec tests compile and run`` specPath configuration = if shouldFail then failwith "Expected compilation failure!" - let! r = runExampleAsync "dotnet" exePath + if shouldRun then + let! r = runExampleAsync "dotnet" exePath - r.ShouldMatchChildSnapshot(specName, snapSettings) + r.ShouldMatchChildSnapshot(specName, snapSettings) | diags -> if not shouldFail then failwithf "Compilation error: %A" diags diff --git a/test/Feersum.Tests/_snapshots/Parse_norun/forever.scm.json b/test/Feersum.Tests/_snapshots/Parse_norun/forever.scm.json new file mode 100644 index 0000000..eb90382 --- /dev/null +++ b/test/Feersum.Tests/_snapshots/Parse_norun/forever.scm.json @@ -0,0 +1,4 @@ +{ + "Diagnostics": [], + "Root": "PROGRAM: (0..81)\n FORM: (0..14)\n OPEN_PAREN: (0..1) \"(\"\n SYMBOL: (1..7)\n IDENTIFIER: (1..7) \"define\"\n ATMOSPHERE: (7..8) \" \"\n SYMBOL: (8..13)\n IDENTIFIER: (8..13) \"world\"\n CLOSE_PAREN: (13..14) \")\"\n ATMOSPHERE: (14..15) \"\n\"\n FORM: (15..39)\n OPEN_PAREN: (15..16) \"(\"\n SYMBOL: (16..22)\n IDENTIFIER: (16..22) \"define\"\n ATMOSPHERE: (22..23) \" \"\n FORM: (23..30)\n OPEN_PAREN: (23..24) \"(\"\n SYMBOL: (24..29)\n IDENTIFIER: (24..29) \"hello\"\n CLOSE_PAREN: (29..30) \")\"\n ATMOSPHERE: (30..31) \" \"\n FORM: (31..38)\n OPEN_PAREN: (31..32) \"(\"\n SYMBOL: (32..37)\n IDENTIFIER: (32..37) \"world\"\n CLOSE_PAREN: (37..38) \")\"\n CLOSE_PAREN: (38..39) \")\"\n ATMOSPHERE: (39..40) \"\n\"\n FORM: (40..72)\n OPEN_PAREN: (40..41) \"(\"\n SYMBOL: (41..45)\n IDENTIFIER: (41..45) \"set!\"\n ATMOSPHERE: (45..46) \" \"\n SYMBOL: (46..51)\n IDENTIFIER: (46..51) \"world\"\n ATMOSPHERE: (51..52) \" \"\n FORM: (52..71)\n OPEN_PAREN: (52..53) \"(\"\n SYMBOL: (53..59)\n IDENTIFIER: (53..59) \"lambda\"\n ATMOSPHERE: (59..60) \" \"\n FORM: (60..62)\n OPEN_PAREN: (60..61) \"(\"\n CLOSE_PAREN: (61..62) \")\"\n ATMOSPHERE: (62..63) \" \"\n FORM: (63..70)\n OPEN_PAREN: (63..64) \"(\"\n SYMBOL: (64..69)\n IDENTIFIER: (64..69) \"hello\"\n CLOSE_PAREN: (69..70) \")\"\n CLOSE_PAREN: (70..71) \")\"\n CLOSE_PAREN: (71..72) \")\"\n ATMOSPHERE: (72..73) \"\n\"\n FORM: (73..80)\n OPEN_PAREN: (73..74) \"(\"\n SYMBOL: (74..79)\n IDENTIFIER: (74..79) \"hello\"\n CLOSE_PAREN: (79..80) \")\"\n ATMOSPHERE: (80..81) \"\n\"\n" +} \ No newline at end of file