Skip to content

Commit

Permalink
Add test suite for TCO
Browse files Browse the repository at this point in the history
  • Loading branch information
changlinli committed Dec 22, 2023
1 parent 5db6e90 commit 1026445
Show file tree
Hide file tree
Showing 7 changed files with 177 additions and 8 deletions.
7 changes: 5 additions & 2 deletions sscces/elm.json → elm-test-rs-tests/elm.json
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,16 @@
"direct": {
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0"
"elm/html": "1.0.0",
"elm-explorations/test": "2.1.2"
},
"indirect": {
"elm/json": "1.1.3",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.3"
"elm/virtual-dom": "1.0.3",
"elm/bytes": "1.0.8",
"elm/random": "1.0.0"
}
},
"test-dependencies": {
Expand Down
61 changes: 61 additions & 0 deletions elm-test-rs-tests/src/AnotherBadClosure.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,61 @@
module AnotherBadClosure exposing (anotherBadClosureTest)

-- From https://github.com/elm/compiler/issues/1813#issuecomment-535417649

import Test exposing (Test, test)
import Expect


{-| This is a tail-recursive function.
It adds upwards counting integers starting from 0 to the given list:
fDirect 4 [ 0 ] == [ 0, 1, 2, 3, 4, 0 ]
-}
fDirect : Int -> List Int -> List Int
fDirect count accum =
if count < 0 then
accum

else
fDirect (count - 1) (count :: accum)


{-| This is a slight variation of f and also tail-recursive.
If we add a closure around the reference of "count", one of
the arguments that tail-call optimization transforms into a variable,
then we get incorrect values.
List.map ((|>) ()) (f 4 [ \() -> 0 ]) == [ -1, -1, -1, -1, -1, 0 ]
-}
f : Int -> List (() -> Int) -> List (() -> Int)
f count accum =
if count < 0 then
accum

else
f (count - 1) ((\() -> count) :: accum)


{-| results in [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]
We apply `()` on all functions in the generated list, to collapse the closures.
-}
bug : List Int
bug =
List.map ((|>) ()) (f 10 [])


{-| results in [0,1,2,3,4,5,6,7,8,9,10]
-}
nobug : List Int
nobug =
fDirect 10 []


anotherBadClosureTest = test "Running a TCO version with closures that capture function arguments should equal running a TCO version without closures" <|
\_ -> bug |> Expect.equal nobug
15 changes: 15 additions & 0 deletions elm-test-rs-tests/src/TCOMiscompilation0.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
module TCOMiscompilation0 exposing (tcoMiscompilation0Test)

-- From https://github.com/elm/compiler/issues/2221#issue-972780518

import Test exposing (Test, test)
import Expect

g : Int -> (Int -> a) -> a
g value cont =
case value of
1 -> cont 1
_ -> g (value-1) (\result -> cont (result * value))

tcoMiscompilation0Test = test "TCO shouldn't result in a stack overflow for CPS" <|
\_ -> g 2 identity |> Expect.equal (g 2 identity)
55 changes: 55 additions & 0 deletions elm-test-rs-tests/src/TCOMiscompilation1.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,55 @@
module TCOMiscompilation1 exposing (tcoMiscompilation1Test)

-- https://github.com/elm/compiler/issues/2268#issuecomment-1671931317

import Test exposing (Test, test)
import Expect

type Trampoline a
= More (() -> Trampoline a)
| Done a


wrapMany : Int -> Trampoline a -> Trampoline a
wrapMany n trampoline =
if n > 0 then
wrapMany (n - 1) (More (\_ -> trampoline))

else
trampoline


run : Trampoline a -> a
run trampoline =
case trampoline of
More next ->
run (next ())

Done a ->
a

wrapManyNoBug : Int -> Trampoline a -> Trampoline a
wrapManyNoBug n trampoline =
if n > 0 then
wrapManyNoBug (n - 1) (more trampoline)

else
trampoline


more : Trampoline a -> Trampoline a
more a =
More (\_ -> a)

trampolinedValue = More(\_ -> (More (\_ -> Done 0)))

-- This should cause hanging in vanilla Elm
buggyExample = run (wrapMany 2 trampolinedValue)


-- This shouldn't hang in vanilla Elm
goodExample = run (wrapManyNoBug 2 trampolinedValue)


tcoMiscompilation1Test = test "TCO shouldn't result in a stack overflow for trampolines" <|
\_ -> buggyExample |> Expect.equal goodExample
11 changes: 11 additions & 0 deletions elm-test-rs-tests/src/TCOMiscompilation2.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
module TCOMiscompilation2 exposing (tcoMiscompilation2Test)

-- From https://github.com/elm/compiler/issues/1813#issue-365193260

import Test exposing (Test, test)
import Expect

testcase = let loop n list = if n <= 0 then list else loop (n - 1) ((\() -> n) :: list) in List.map (\f -> f()) <| loop 3 []

tcoMiscompilation2Test = test "TCO not just repeat the same value over and over again when given a trivial loop" <|
\_ -> testcase |> Expect.equal [1, 2, 3]
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
module TCOProducesBadClosures exposing (..)
module TCOProducesBadClosures exposing (tcoProducesBadClosuresTest)

import Html
import Debug
-- From https://github.com/elm/compiler/issues/2268

import Test exposing (Test, test)
import Expect

makeLazy : List a -> List (() -> a) -> List (() -> a)
makeLazy list accum =
Expand All @@ -15,8 +17,8 @@ makeLazy list accum =
tcoMakeLazy : List a -> List (() -> a) -> List (() -> a)
tcoMakeLazy list accum =
case list of
item :: items ->
tcoMakeLazy items ((\_ -> item) :: accum)
itemEscape :: items ->
tcoMakeLazy items ((\_ -> itemEscape) :: accum)

_ ->
accum
Expand All @@ -30,4 +32,6 @@ badOutput =
tcoMakeLazy [ 1, 2, 3 ] [] |> List.map (\f -> f ())


main = Html.text (Debug.toString goodOutput ++ Debug.toString badOutput)
tcoProducesBadClosuresTest = test "Running a TCO version with closures capturing local variables should equal running a TCO version without closures" <|
\_ -> badOutput |> Expect.equal goodOutput

20 changes: 20 additions & 0 deletions elm-test-rs-tests/tests/Tests.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
module Tests exposing (..)

import Test exposing (Test, describe)
import AnotherBadClosure exposing (anotherBadClosureTest)
import TCOProducesBadClosures exposing (tcoProducesBadClosuresTest)
import TCOMiscompilation0 exposing (tcoMiscompilation0Test)
-- This causes hanging in vanilla Elm, uncomment once I have a way of failing a test after it runs for too long
-- import TCOMiscompilation1 exposing (tcoMiscompilation1Test)
import TCOMiscompilation2 exposing (tcoMiscompilation2Test)


suite : Test
suite = describe "TCO tests"
[ anotherBadClosureTest
, tcoProducesBadClosuresTest
, tcoMiscompilation0Test
-- This causes hanging in vanilla Elm, uncomment once I have a way of failing a test after it runs for too long
-- , tcoMiscompilation1Test
, tcoMiscompilation2Test
]

0 comments on commit 1026445

Please sign in to comment.