From 7d4733363592106dae081ff7e6c31690eaf81493 Mon Sep 17 00:00:00 2001 From: Harry Sarson Date: Fri, 7 Oct 2022 20:42:32 +0100 Subject: [PATCH 1/4] add downcast test api to help testrunners --- src/Elm/Kernel/Test.js | 15 ++++++++ src/Test.elm | 77 +++++++++++++++++++++++++-------------- src/Test/Fuzz.elm | 12 +++--- src/Test/Internal.elm | 61 +++++++++++++++++++++---------- src/Test/Runner.elm | 30 ++++++++++----- tests/src/RunnerTests.elm | 20 +++++++++- 6 files changed, 150 insertions(+), 65 deletions(-) diff --git a/src/Elm/Kernel/Test.js b/src/Elm/Kernel/Test.js index 1ef03633..2024ebee 100644 --- a/src/Elm/Kernel/Test.js +++ b/src/Elm/Kernel/Test.js @@ -2,6 +2,7 @@ import Elm.Kernel.Utils exposing (Tuple0) import Result exposing (Err, Ok) +import Maybe exposing (Just, Nothing) */ @@ -16,3 +17,17 @@ function _Test_runThunk(thunk) return __Result_Err(err.toString()); } } + +var _Test_elmTestSymbol = Symbol("elmTestSymbol"); + +function _Test_tagTest(test) +{ + test[__elmTestSymbol] = true; + return test; +} + +function _Test_downcastTest(value) +{ + return value && value[__elmTestSymbol] ? $elm$core$Maybe$Just(value) : $elm$core$Maybe$Nothing; +} + diff --git a/src/Test.elm b/src/Test.elm index cf0dd763..2b6609f6 100644 --- a/src/Test.elm +++ b/src/Test.elm @@ -54,6 +54,7 @@ concat tests = { description = "This `concat` has no tests in it. Let's give it some!" , reason = Invalid EmptyList } + |> Internal.wrapTest else case Internal.duplicatedName tests of @@ -66,9 +67,13 @@ concat tests = { description = String.join "\n" (List.map dupDescription <| Set.toList dups) , reason = Invalid DuplicatedName } + |> Internal.wrapTest Ok _ -> - Internal.ElmTestVariant__Batch tests + tests + |> List.map (Internal.unwrapTest) + |> Internal.Batch + |> Internal.wrapTest {-| Apply a description to a list of tests. @@ -106,12 +111,14 @@ describe untrimmedDesc tests = { description = "This `describe` has a blank description. Let's give it a useful one!" , reason = Invalid BadDescription } + |> Internal.wrapTest else if List.isEmpty tests then Internal.failNow { description = "This `describe " ++ desc ++ "` has no tests in it. Let's give it some!" , reason = Invalid EmptyList } + |> Internal.wrapTest else case Internal.duplicatedName tests of @@ -120,22 +127,28 @@ describe untrimmedDesc tests = dupDescription duped = "Contains multiple tests named '" ++ duped ++ "'. Let's rename them so we know which is which." in - Internal.ElmTestVariant__Labeled desc <| - Internal.failNow - { description = String.join "\n" (List.map dupDescription <| Set.toList dups) - , reason = Invalid DuplicatedName - } + Internal.failNow + { description = String.join "\n" (List.map dupDescription <| Set.toList dups) + , reason = Invalid DuplicatedName + } + |> Internal.Labeled desc + |> Internal.wrapTest Ok childrenNames -> if Set.member desc childrenNames then - Internal.ElmTestVariant__Labeled desc <| - Internal.failNow - { description = "The test '" ++ desc ++ "' contains a child test of the same name. Let's rename them so we know which is which." - , reason = Invalid DuplicatedName - } + Internal.failNow + { description = "The test '" ++ desc ++ "' contains a child test of the same name. Let's rename them so we know which is which." + , reason = Invalid DuplicatedName + } + |> Internal.Labeled desc + |> Internal.wrapTest else - Internal.ElmTestVariant__Labeled desc (Internal.ElmTestVariant__Batch tests) + tests + |> List.map (Internal.unwrapTest) + |> Internal.Batch + |> Internal.Labeled desc + |> Internal.wrapTest {-| Return a [`Test`](#Test) that evaluates a single @@ -159,9 +172,12 @@ test untrimmedDesc thunk = in if String.isEmpty desc then Internal.blankDescriptionFailure + |> Internal.wrapTest else - Internal.ElmTestVariant__Labeled desc (Internal.ElmTestVariant__UnitTest (\() -> [ thunk () ])) + Internal.UnitTest (\() -> [ thunk () ]) + |> Internal.Labeled desc + |> Internal.wrapTest {-| Returns a [`Test`](#Test) that is "TODO" (not yet implemented). These tests @@ -190,6 +206,7 @@ todo desc = { description = desc , reason = TODO } + |> Internal.wrapTest {-| Returns a [`Test`](#Test) that causes other tests to be skipped, and @@ -230,7 +247,7 @@ an `only` inside a `skip`, it will also get skipped. -} only : Test -> Test only = - Internal.ElmTestVariant__Only + Internal.unwrapTest >> Internal.Only >> Internal.wrapTest {-| Returns a [`Test`](#Test) that gets skipped. @@ -266,7 +283,7 @@ an `only` inside a `skip`, it will also get skipped. -} skip : Test -> Test skip = - Internal.ElmTestVariant__Skipped + Internal.unwrapTest >> Internal.Skipped >> Internal.wrapTest {-| Options [`fuzzWith`](#fuzzWith) accepts. @@ -350,37 +367,41 @@ fuzzWith options fuzzer desc getTest = { description = "Fuzz tests must have a run count of at least 1, not " ++ String.fromInt options.runs ++ "." , reason = Invalid NonpositiveFuzzCount } + |> Internal.wrapTest else - fuzzWithHelp options (Test.Fuzz.fuzzTest options.distribution fuzzer desc getTest) + fuzzWithHelp + options + (Test.Fuzz.fuzzTest options.distribution fuzzer desc getTest |> Internal.unwrapTest) + |> Internal.wrapTest -fuzzWithHelp : FuzzOptions a -> Test -> Test +fuzzWithHelp : FuzzOptions -> Test -> Test fuzzWithHelp options aTest = case aTest of - Internal.ElmTestVariant__UnitTest _ -> + Internal.UnitTest _ -> aTest - Internal.ElmTestVariant__FuzzTest run -> - Internal.ElmTestVariant__FuzzTest (\seed _ -> run seed options.runs) + Internal.FuzzTest run -> + Internal.FuzzTest (\seed _ -> run seed options.runs) - Internal.ElmTestVariant__Labeled label subTest -> - Internal.ElmTestVariant__Labeled label (fuzzWithHelp options subTest) + Internal.Labeled label subTest -> + Internal.Labeled label (fuzzWithHelp options subTest) - Internal.ElmTestVariant__Skipped subTest -> + Internal.Skipped subTest -> -- It's important to treat skipped tests exactly the same as normal, -- until after seed distribution has completed. fuzzWithHelp options subTest - |> Internal.ElmTestVariant__Only + |> Internal.Only - Internal.ElmTestVariant__Only subTest -> + Internal.Only subTest -> fuzzWithHelp options subTest - |> Internal.ElmTestVariant__Only + |> Internal.Only - Internal.ElmTestVariant__Batch tests -> + Internal.Batch tests -> tests |> List.map (fuzzWithHelp options) - |> Internal.ElmTestVariant__Batch + |> Internal.Batch {-| Take a function that produces a test, and calls it several (usually 100) times, using a randomly-generated input diff --git a/src/Test/Fuzz.elm b/src/Test/Fuzz.elm index 433238f1..122fea0c 100644 --- a/src/Test/Fuzz.elm +++ b/src/Test/Fuzz.elm @@ -12,7 +12,7 @@ import Simplify import Test.Distribution exposing (DistributionReport(..)) import Test.Distribution.Internal exposing (Distribution(..), ExpectedDistribution(..)) import Test.Expectation exposing (Expectation(..)) -import Test.Internal exposing (Test(..), blankDescriptionFailure) +import Test.Internal exposing (Test(..), TestData(..), blankDescriptionFailure) import Test.Runner.Distribution import Test.Runner.Failure exposing (InvalidReason(..), Reason(..)) @@ -27,16 +27,18 @@ fuzzTest distribution fuzzer untrimmedDesc getExpectation = in if String.isEmpty desc then blankDescriptionFailure + |> Test.Internal.wrapTest else - ElmTestVariant__Labeled desc <| validatedFuzzTest fuzzer getExpectation distribution - + validatedFuzzTest fuzzer getExpectation distribution + |> Labeled desc + |> Test.Internal.wrapTest {-| Knowing that the fuzz test isn't obviously invalid, run the test and package up the results. -} -validatedFuzzTest : Fuzzer a -> (a -> Expectation) -> Distribution a -> Test +validatedFuzzTest : Fuzzer a -> (a -> Expectation) -> Distribution a -> TestData validatedFuzzTest fuzzer getExpectation distribution = - ElmTestVariant__FuzzTest + FuzzTest (\seed runs -> let runResult : RunResult diff --git a/src/Test/Internal.elm b/src/Test/Internal.elm index 2ed68810..93b85a8b 100644 --- a/src/Test/Internal.elm +++ b/src/Test/Internal.elm @@ -1,36 +1,45 @@ -module Test.Internal exposing (Test(..), blankDescriptionFailure, duplicatedName, failNow, toString) +module Test.Internal exposing (Test, TestData(..), blankDescriptionFailure, duplicatedName, failNow, toString, wrapTest, unwrapTest) import Random import Set exposing (Set) import Test.Expectation exposing (Expectation) import Test.Runner.Failure exposing (InvalidReason(..), Reason(..)) +import Elm.Kernel.Test -{-| All variants of this type has the `ElmTestVariant__` prefix so that +{-| All variants of this type has the `` prefix so that node-test-runner can recognize them in the compiled JavaScript. This lets us add more variants here without having to update the runner. -For more information, see +For more information, see +-} +type TestData + = UnitTest (() -> List Expectation) + | FuzzTest (Random.Seed -> Int -> List Expectation) + | Labeled String TestData + | Skipped TestData + | Only TestData + | Batch (List TestData) + + +{-| Newtype wrapper around TestData. + +**MUST only be constructed by the kernel -} type Test - = ElmTestVariant__UnitTest (() -> List Expectation) - | ElmTestVariant__FuzzTest (Random.Seed -> Int -> List Expectation) - | ElmTestVariant__Labeled String Test - | ElmTestVariant__Skipped Test - | ElmTestVariant__Only Test - | ElmTestVariant__Batch (List Test) + = Wrapped TestData {-| Create a test that always fails for the given reason and description. -} -failNow : { description : String, reason : Reason } -> Test +failNow : { description : String, reason : Reason } -> TestData failNow record = - ElmTestVariant__UnitTest + UnitTest (\() -> [ Test.Expectation.fail record ]) -blankDescriptionFailure : Test +blankDescriptionFailure : TestData blankDescriptionFailure = failNow { description = "This test has a blank description. Let's give it a useful one!" @@ -41,25 +50,25 @@ blankDescriptionFailure = duplicatedName : List Test -> Result (Set String) (Set String) duplicatedName tests = let - names : Test -> List String + names : TestData -> List String names test = case test of - ElmTestVariant__Labeled str _ -> + Labeled str _ -> [ str ] - ElmTestVariant__Batch subtests -> + Batch subtests -> List.concatMap names subtests - ElmTestVariant__UnitTest _ -> + UnitTest _ -> [] - ElmTestVariant__FuzzTest _ -> + FuzzTest _ -> [] - ElmTestVariant__Skipped subTest -> + Skipped subTest -> names subTest - ElmTestVariant__Only subTest -> + Only subTest -> names subTest accumDuplicates : String -> ( Set String, Set String ) -> ( Set String, Set String ) @@ -71,7 +80,9 @@ duplicatedName tests = ( dups, Set.insert newName uniques ) ( dupsAccum, uniquesAccum ) = - List.concatMap names tests + tests + |> List.map (\(Wrapped td) -> td) + |> List.concatMap names |> List.foldl accumDuplicates ( Set.empty, Set.empty ) in if Set.isEmpty dupsAccum then @@ -84,3 +95,13 @@ duplicatedName tests = toString : a -> String toString = Elm.Kernel.Debug.toString + + +wrapTest : TestData -> Test +wrapTest td = + Elm.Kernel.Test.tagTest (Wrapped td) + + +unwrapTest : Test -> TestData +unwrapTest (Wrapped t) = + t diff --git a/src/Test/Runner.elm b/src/Test/Runner.elm index 8094b3bc..b3ecd6e9 100644 --- a/src/Test/Runner.elm +++ b/src/Test/Runner.elm @@ -4,6 +4,7 @@ module Test.Runner exposing , getDistributionReport , formatLabels , Simplifiable, fuzz, simplify + , downcastTest ) {-| This is an "experts only" module that exposes functions needed to run and @@ -38,6 +39,10 @@ These functions give you the ability to run fuzzers separate of running fuzz tes @docs Simplifiable, fuzz, simplify +## Test collection helper functions + +@docs DowncastTest + -} import Bitwise @@ -229,21 +234,21 @@ Some design notes: -} distributeSeeds : Int -> Random.Seed -> Test -> Distribution -distributeSeeds = - distributeSeedsHelp False +distributeSeeds runs seed test = + distributeSeedsHelp False runs seed (Internal.unwrapTest test) -distributeSeedsHelp : Bool -> Int -> Random.Seed -> Test -> Distribution +distributeSeedsHelp : Bool -> Int -> Random.Seed -> Internal.TestData -> Distribution distributeSeedsHelp hashed runs seed test = case test of - Internal.ElmTestVariant__UnitTest aRun -> + Internal.UnitTest aRun -> { seed = seed , all = [ Runnable (Thunk (\_ -> aRun ())) ] , only = [] , skipped = [] } - Internal.ElmTestVariant__FuzzTest aRun -> + Internal.FuzzTest aRun -> let ( firstSeed, nextSeed ) = Random.step Random.independentSeed seed @@ -254,7 +259,7 @@ distributeSeedsHelp hashed runs seed test = , skipped = [] } - Internal.ElmTestVariant__Labeled description subTest -> + Internal.Labeled description subTest -> -- This fixes https://github.com/elm-community/elm-test/issues/192 -- The first time we hit a Labeled, we want to use the hash of -- that label, along with the original seed, as our starting @@ -307,7 +312,7 @@ distributeSeedsHelp hashed runs seed test = , skipped = List.map (Labeled description) next.skipped } - Internal.ElmTestVariant__Skipped subTest -> + Internal.Skipped subTest -> let -- Go through the motions in order to obtain the seed, but then -- move everything to skipped. @@ -320,7 +325,7 @@ distributeSeedsHelp hashed runs seed test = , skipped = next.all } - Internal.ElmTestVariant__Only subTest -> + Internal.Only subTest -> let next = distributeSeedsHelp hashed runs seed subTest @@ -328,11 +333,11 @@ distributeSeedsHelp hashed runs seed test = -- `only` all the things! { next | only = next.all } - Internal.ElmTestVariant__Batch tests -> + Internal.Batch tests -> List.foldl (batchDistribute hashed runs) (emptyDistribution seed) tests -batchDistribute : Bool -> Int -> Test -> Distribution -> Distribution +batchDistribute : Bool -> Int -> Internal.TestData -> Distribution -> Distribution batchDistribute hashed runs test prev = let next = @@ -537,3 +542,8 @@ simplify getExpectation ( value, Simplifiable { randomRun, fuzzer } ) = , fuzzer = fuzzer } ) + + +downcastTest: a -> Maybe Test +downcastTest = + Elm.Kernel.Test.downcastTest \ No newline at end of file diff --git a/tests/src/RunnerTests.elm b/tests/src/RunnerTests.elm index 6f66cf58..85f84bb7 100644 --- a/tests/src/RunnerTests.elm +++ b/tests/src/RunnerTests.elm @@ -12,7 +12,9 @@ import Test.Runner.Failure all : Test all = Test.concat - [ fromTest ] + [ fromTest + , helperTests + ] toSeededRunners : Test -> SeededRunners @@ -202,7 +204,7 @@ fromTest = |> Expect.equal (Just { given = Nothing - , description = "This test failed because it threw an exception: \"Error: TODO in module `RunnerTests` on line 197\n\ncrash\"" + , description = "This test failed because it threw an exception: \"Error: TODO in module `RunnerTests` on line 199\n\ncrash\"" , reason = Test.Runner.Failure.Custom } ) @@ -219,3 +221,17 @@ fromTest = passing : Test passing = test "A passing test" expectPass + + +helperTests : Test +helperTests = + describe "Tests for runner helper functions" + [ test "correctly finds tests" <| + \() -> + Test.Runner.downcastTest passing + |> Expect.equal (Just passing) + , test "correctly ignores non-tests" <| + \() -> + Test.Runner.downcastTest 67 + |> Expect.equal Nothing + ] \ No newline at end of file From 19dd14c51656e3b9ead246d4873eb9a4d6858b60 Mon Sep 17 00:00:00 2001 From: Harry Sarson Date: Fri, 7 Oct 2022 20:51:21 +0100 Subject: [PATCH 2/4] fix docs --- src/Test/Internal.elm | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/Test/Internal.elm b/src/Test/Internal.elm index 93b85a8b..de7c4165 100644 --- a/src/Test/Internal.elm +++ b/src/Test/Internal.elm @@ -7,13 +7,6 @@ import Test.Runner.Failure exposing (InvalidReason(..), Reason(..)) import Elm.Kernel.Test -{-| All variants of this type has the `` prefix so that -node-test-runner can recognize them in the compiled JavaScript. This lets us -add more variants here without having to update the runner. - -For more information, see - --} type TestData = UnitTest (() -> List Expectation) | FuzzTest (Random.Seed -> Int -> List Expectation) @@ -23,9 +16,10 @@ type TestData | Batch (List TestData) -{-| Newtype wrapper around TestData. +{-| Newtype wrapper around TestData so that +node-test-runner can recognize them in the compiled JavaScript. -**MUST only be constructed by the kernel +**MUST** only be constructed by the kernel -} type Test = Wrapped TestData From 57af4c3d01ea9c10ce97e51711b3de4e77689026 Mon Sep 17 00:00:00 2001 From: Harry Sarson Date: Fri, 7 Oct 2022 20:52:38 +0100 Subject: [PATCH 3/4] add trailing whitespace --- src/Test/Internal.elm | 1 + tests/src/RunnerTests.elm | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Test/Internal.elm b/src/Test/Internal.elm index de7c4165..35e26c92 100644 --- a/src/Test/Internal.elm +++ b/src/Test/Internal.elm @@ -99,3 +99,4 @@ wrapTest td = unwrapTest : Test -> TestData unwrapTest (Wrapped t) = t + diff --git a/tests/src/RunnerTests.elm b/tests/src/RunnerTests.elm index 85f84bb7..3230411f 100644 --- a/tests/src/RunnerTests.elm +++ b/tests/src/RunnerTests.elm @@ -234,4 +234,5 @@ helperTests = \() -> Test.Runner.downcastTest 67 |> Expect.equal Nothing - ] \ No newline at end of file + ] + From 88ad50a79d5ddd194e39df807f7b6b7ebae77c2d Mon Sep 17 00:00:00 2001 From: Harry Sarson Date: Sat, 15 Oct 2022 18:40:28 +0100 Subject: [PATCH 4/4] fix errors after rebase --- src/Elm/Kernel/Test.js | 4 ++-- src/Test.elm | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Elm/Kernel/Test.js b/src/Elm/Kernel/Test.js index 2024ebee..f971dfd3 100644 --- a/src/Elm/Kernel/Test.js +++ b/src/Elm/Kernel/Test.js @@ -22,12 +22,12 @@ var _Test_elmTestSymbol = Symbol("elmTestSymbol"); function _Test_tagTest(test) { - test[__elmTestSymbol] = true; + test[_Test_elmTestSymbol] = true; return test; } function _Test_downcastTest(value) { - return value && value[__elmTestSymbol] ? $elm$core$Maybe$Just(value) : $elm$core$Maybe$Nothing; + return value && value[_Test_elmTestSymbol] ? $elm$core$Maybe$Just(value) : $elm$core$Maybe$Nothing; } diff --git a/src/Test.elm b/src/Test.elm index 2b6609f6..fd4f5a65 100644 --- a/src/Test.elm +++ b/src/Test.elm @@ -376,7 +376,7 @@ fuzzWith options fuzzer desc getTest = |> Internal.wrapTest -fuzzWithHelp : FuzzOptions -> Test -> Test +fuzzWithHelp : FuzzOptions a -> Internal.TestData -> Internal.TestData fuzzWithHelp options aTest = case aTest of Internal.UnitTest _ ->