diff --git a/src/Elm/Kernel/Test.js b/src/Elm/Kernel/Test.js index 1ef03633..f971dfd3 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[_Test_elmTestSymbol] = true; + return test; +} + +function _Test_downcastTest(value) +{ + 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 cf0dd763..fd4f5a65 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 a -> Internal.TestData -> Internal.TestData 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..35e26c92 100644 --- a/src/Test/Internal.elm +++ b/src/Test/Internal.elm @@ -1,36 +1,39 @@ -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 -node-test-runner can recognize them in the compiled JavaScript. This lets us -add more variants here without having to update the runner. +type TestData + = UnitTest (() -> List Expectation) + | FuzzTest (Random.Seed -> Int -> List Expectation) + | Labeled String TestData + | Skipped TestData + | Only TestData + | Batch (List TestData) -For more information, see <https://github.com/elm-explorations/test/pull/153> +{-| Newtype wrapper around TestData so that +node-test-runner can recognize them in the compiled JavaScript. + +**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 +44,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 +74,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 +89,14 @@ 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..3230411f 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,18 @@ 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 + ] +