From a499efdb0e215ac424fe7c38a52430daebefc22b Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 16 Apr 2015 19:45:21 -0400 Subject: [PATCH] Switch to Tasty for testing. --- spline3.cabal | 47 ++++++++++++++---------------- src/Assertions.hs | 11 +++++-- src/Cardinal.hs | 22 +++++++------- src/Cube.hs | 35 +++++++++++----------- src/FunctionValues.hs | 16 +++++------ src/Grid.hs | 42 +++++++++++++++------------ src/Misc.hs | 16 +++++------ src/Point.hs | 2 +- src/Tetrahedron.hs | 29 ++++++++++--------- test/TestSuite.hs | 67 +++++++++++++++---------------------------- 10 files changed, 136 insertions(+), 151 deletions(-) diff --git a/spline3.cabal b/spline3.cabal index f2dcd5d..4154e89 100644 --- a/spline3.cabal +++ b/spline3.cabal @@ -29,19 +29,18 @@ flag LLVM executable spline3 build-depends: base < 5, - cmdargs == 0.10.*, - filepath == 1.*, - MissingH == 1.*, - repa == 3.3.*, - repa-algorithms == 3.3.*, - repa-io == 3.3.*, - vector == 0.10.*, + cmdargs >= 0.10, + filepath >= 1, + MissingH >= 1, + repa >= 3.3, + repa-algorithms >= 3.3, + repa-io >= 3.3, + vector >= 0.10, -- Additional test dependencies. - HUnit == 1.2.*, - QuickCheck == 2.*, - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - test-framework-quickcheck2 == 0.3.* + tasty >= 0.8, + tasty-hunit >= 0.8, + tasty-quickcheck >= 0.8.1 + main-is: Main.hs @@ -94,7 +93,7 @@ test-suite doctests build-depends: base < 5, -- Additional test dependencies. - doctest == 0.9.* + doctest >= 0.9 -- It's not entirely clear to me why I have to reproduce all of this. ghc-options: @@ -122,19 +121,17 @@ test-suite testsuite main-is: TestSuite.hs build-depends: base < 5, - cmdargs == 0.10.*, - filepath == 1.*, - MissingH == 1.*, - repa == 3.3.*, - repa-algorithms == 3.3.*, - repa-io == 3.3.*, - vector == 0.10.*, + cmdargs >= 0.10, + filepath >= 1, + MissingH >= 1, + repa >= 3.3, + repa-algorithms >= 3.3, + repa-io >= 3.3, + vector >= 0.10, -- Additional test dependencies. - HUnit == 1.2.*, - QuickCheck == 2.*, - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - test-framework-quickcheck2 == 0.3.* + tasty >= 0.8, + tasty-hunit >= 0.8, + tasty-quickcheck >= 0.8.1 -- It's not entirely clear to me why I have to reproduce all of this. ghc-options: diff --git a/src/Assertions.hs b/src/Assertions.hs index 023cf65..f6152d7 100644 --- a/src/Assertions.hs +++ b/src/Assertions.hs @@ -8,7 +8,7 @@ module Assertions ( where import Control.Monad ( unless ) -import Test.HUnit ( +import Test.Tasty.HUnit ( Assertion, assertBool, assertFailure ) @@ -17,8 +17,12 @@ import Comparisons ( (~=) ) -- | An HUnit assertion that wraps the almost_equals function. Stolen --- from the definition of 'assertEqual' in Test\/HUnit\/Base.hs. -assertAlmostEqual :: String -> Double -> Double -> Assertion +-- from the definition of 'assertEqual' in Test\/Tasty\/HUnit\/Orig.hs. +-- +assertAlmostEqual :: String -- ^ The message prefix + -> Double -- ^ The expected value + -> Double -- ^ The actual value + -> Assertion assertAlmostEqual preface expected actual = unless (actual ~= expected) (assertFailure msg) where msg = (if null preface then "" else preface ++ "\n") ++ @@ -27,5 +31,6 @@ assertAlmostEqual preface expected actual = -- | It's asinine that this doesn't exist already. +-- assertTrue :: String -> Bool -> Assertion assertTrue = assertBool diff --git a/src/Cardinal.hs b/src/Cardinal.hs index 300c340..d4f94e3 100644 --- a/src/Cardinal.hs +++ b/src/Cardinal.hs @@ -24,13 +24,13 @@ where import Control.Monad (liftM, liftM2) import Prelude hiding (LT) - -import Test.HUnit (Assertion, assertEqual) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) - -import Test.QuickCheck (Arbitrary(..), Property, (==>), oneof) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( Assertion, assertEqual, testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Property, (==>), + oneof, + testProperty ) data Cardinal = F -- ^ Front @@ -440,17 +440,17 @@ prop_four_ccwz_is_identity c = (ccwz . ccwz . ccwz . ccwz) c == c -cardinal_tests :: Test.Framework.Test +cardinal_tests :: TestTree cardinal_tests = - testGroup "Cardinal Tests" [ + testGroup "Cardinal tests" [ testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ] -cardinal_properties :: Test.Framework.Test +cardinal_properties :: TestTree cardinal_properties = let tp = testProperty in - testGroup "Cardinal Properties" [ + testGroup "Cardinal properties" [ tp "ccwx rotation changes direction" prop_ccwx_rotation_changes_direction, tp "cwx rotation changes direction" prop_cwx_rotation_changes_direction, tp "ccwy rotation changes direction" prop_ccwy_rotation_changes_direction, diff --git a/src/Cube.hs b/src/Cube.hs index 6e33423..c793c1b 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -16,10 +16,13 @@ import qualified Data.Vector as V ( snoc, unsafeIndex) import Prelude hiding ( LT ) -import Test.Framework ( Test, testGroup ) -import Test.Framework.Providers.QuickCheck2 ( testProperty ) -import Test.QuickCheck ( Arbitrary(..), Gen, Positive(..), choose ) - +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Gen, + Positive(..), + choose, + testProperty ) import Cardinal ( Cardinal(..), ccwx, @@ -657,9 +660,7 @@ find_containing_tetrahedron cube p = --- Tests - --- Quickcheck tests. +-- * Tests prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool prop_opposite_octant_tetrahedra_disjoint1 cube = @@ -1135,9 +1136,9 @@ prop_t7_shares_edge_with_t20 cube = t20 = tetrahedron cube 20 -p79_26_properties :: Test.Framework.Test +p79_26_properties :: TestTree p79_26_properties = - testGroup "p. 79, Section (2.6) Properties" [ + testGroup "p. 79, Section (2.6) properties" [ testProperty "c0120 identity1" prop_c0120_identity1, testProperty "c0120 identity2" prop_c0120_identity2, testProperty "c0120 identity3" prop_c0120_identity3, @@ -1151,9 +1152,9 @@ p79_26_properties = testProperty "c1200 identity1" prop_c1200_identity1, testProperty "c2100 identity1" prop_c2100_identity1] -p79_27_properties :: Test.Framework.Test +p79_27_properties :: TestTree p79_27_properties = - testGroup "p. 79, Section (2.7) Properties" [ + testGroup "p. 79, Section (2.7) properties" [ testProperty "c0102 identity1" prop_c0102_identity1, testProperty "c0201 identity1" prop_c0201_identity1, testProperty "c0300 identity2" prop_c0300_identity2, @@ -1162,9 +1163,9 @@ p79_27_properties = testProperty "c2100 identity2" prop_c2100_identity2 ] -p79_28_properties :: Test.Framework.Test +p79_28_properties :: TestTree p79_28_properties = - testGroup "p. 79, Section (2.8) Properties" [ + testGroup "p. 79, Section (2.8) properties" [ testProperty "c3000 identity" prop_c3000_identity, testProperty "c2010 identity" prop_c2010_identity, testProperty "c2001 identity" prop_c2001_identity, @@ -1173,9 +1174,9 @@ p79_28_properties = testProperty "c1011 identity" prop_c1011_identity ] -edge_incidence_tests :: Test.Framework.Test +edge_incidence_tests :: TestTree edge_incidence_tests = - testGroup "Edge Incidence Tests" [ + testGroup "Edge incidence tests" [ testProperty "t0 shares edge with t6" prop_t0_shares_edge_with_t6, testProperty "t0 shares edge with t1" prop_t0_shares_edge_with_t1, testProperty "t0 shares edge with t3" prop_t0_shares_edge_with_t3, @@ -1192,9 +1193,9 @@ edge_incidence_tests = testProperty "t6 shares edge with t7" prop_t6_shares_edge_with_t7, testProperty "t7 shares edge with t20" prop_t7_shares_edge_with_t20 ] -cube_properties :: Test.Framework.Test +cube_properties :: TestTree cube_properties = - testGroup "Cube Properties" [ + testGroup "Cube properties" [ p79_26_properties, p79_27_properties, p79_28_properties, diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs index 5332462..5c44dc5 100644 --- a/src/FunctionValues.hs +++ b/src/FunctionValues.hs @@ -15,11 +15,9 @@ module FunctionValues ( where import Prelude hiding ( LT ) -import Test.HUnit ( Assertion ) -import Test.Framework ( Test, testGroup ) -import Test.Framework.Providers.HUnit ( testCase ) -import Test.Framework.Providers.QuickCheck2 ( testProperty ) -import Test.QuickCheck ( Arbitrary(..), choose ) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( Assertion, testCase ) +import Test.Tasty.QuickCheck ( Arbitrary(..), choose, testProperty ) import Assertions ( assertTrue ) import Cardinal ( Cardinal(..), cwx, cwy, cwz ) @@ -371,9 +369,9 @@ test_directions = back_right_top fvs == 15] -function_values_tests :: Test.Framework.Test +function_values_tests :: TestTree function_values_tests = - testGroup "FunctionValues Tests" + testGroup "FunctionValues tests" [ testCase "test directions" test_directions ] @@ -429,11 +427,11 @@ prop_z_rotation_doesnt_affect_top fv0 = expr2 = top fv1 -function_values_properties :: Test.Framework.Test +function_values_properties :: TestTree function_values_properties = let tp = testProperty in - testGroup "FunctionValues Properties" [ + testGroup "FunctionValues properties" [ tp "x rotation doesn't affect front" prop_x_rotation_doesnt_affect_front, tp "x rotation doesn't affect back" prop_x_rotation_doesnt_affect_back, tp "y rotation doesn't affect left" prop_y_rotation_doesnt_affect_left, diff --git a/src/Grid.hs b/src/Grid.hs index b40f655..f9a5972 100644 --- a/src/Grid.hs +++ b/src/Grid.hs @@ -3,6 +3,7 @@ -- function used to build the interpolation. module Grid ( cube_at, + grid_properties, grid_tests, slow_tests, zoom ) @@ -15,17 +16,17 @@ import Data.Array.Repa ( computeUnboxedP, fromListUnboxed ) import Data.Array.Repa.Operators.Traversal ( unsafeTraverse ) -import Test.HUnit ( Assertion, assertEqual ) -import Test.Framework ( Test, testGroup ) -import Test.Framework.Providers.HUnit ( testCase ) -import Test.Framework.Providers.QuickCheck2 ( testProperty ) -import Test.QuickCheck ( - (==>), +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( Assertion, assertEqual, testCase ) +import Test.Tasty.QuickCheck ( Arbitrary(..), Gen, Property, + (==>), choose, - vectorOf ) + vectorOf, + testProperty ) + import Assertions ( assertAlmostEqual, assertTrue ) import Comparisons ( (~=) ) import Cube ( @@ -38,7 +39,7 @@ import FunctionValues ( make_values, value_at ) import Point ( Point(..) ) import ScaleFactor ( ScaleFactor ) import Tetrahedron ( - Tetrahedron(v0,v1,v2,v3), + Tetrahedron( v0, v1, v2, v3 ), c, polynomial ) import Values ( Values3D, dims, empty3d, zoom_shape ) @@ -152,7 +153,7 @@ zoom v3d scale_factor -- We also verify that the four vertices on face0 of the cube are -- in the correct location. -- -trilinear_c0_t0_tests :: Test.Framework.Test +trilinear_c0_t0_tests :: TestTree trilinear_c0_t0_tests = testGroup "trilinear c0 t0" [testGroup "coefficients" @@ -462,9 +463,9 @@ prop_c0300_identity g = -- | All of the properties from Section (2.9), p. 80. These require a -- grid since they refer to two adjacent cubes. -p80_29_properties :: Test.Framework.Test +p80_29_properties :: TestTree p80_29_properties = - testGroup "p. 80, Section (2.9) Properties" [ + testGroup "p. 80, Section (2.9) properties" [ testProperty "c0120 identity" prop_c0120_identity, testProperty "c0111 identity" prop_c0111_identity, testProperty "c0201 identity" prop_c0201_identity, @@ -473,19 +474,22 @@ p80_29_properties = testProperty "c0300 identity" prop_c0300_identity ] -grid_tests :: Test.Framework.Test +grid_tests :: TestTree grid_tests = - testGroup "Grid Tests" [ - trilinear_c0_t0_tests, - p80_29_properties, - testProperty "cube indices within bounds" - prop_cube_indices_never_go_out_of_bounds ] + testGroup "Grid tests" [ trilinear_c0_t0_tests ] + +grid_properties :: TestTree +grid_properties = + testGroup "Grid properties" + [ p80_29_properties, + testProperty "cube indices within bounds" + prop_cube_indices_never_go_out_of_bounds ] -- Do the slow tests last so we can stop paying attention. -slow_tests :: Test.Framework.Test +slow_tests :: TestTree slow_tests = - testGroup "Slow Tests" [ + testGroup "Slow tests" [ testCase "trilinear reproduced" test_trilinear_reproduced, testCase "trilinear9x9x9 reproduced" test_trilinear9x9x9_reproduced, testCase "zeros reproduced" test_zeros_reproduced ] diff --git a/src/Misc.hs b/src/Misc.hs index 09773bf..e6cd07e 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -14,11 +14,9 @@ module Misc ( where import qualified Data.Vector as V ( Vector, elem, empty, filter ) -import Test.Framework ( Test, testGroup ) -import Test.Framework.Providers.HUnit ( testCase ) -import Test.Framework.Providers.QuickCheck2 ( testProperty ) -import Test.HUnit ( Assertion, assertEqual ) -import Test.QuickCheck ( Property, (==>) ) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( Assertion, assertEqual, testCase ) +import Test.Tasty.QuickCheck ( Property, (==>), testProperty ) -- | The standard factorial function. See @@ -116,13 +114,13 @@ test_flatten1 = actual_list = flatten target -misc_tests :: Test.Framework.Test +misc_tests :: TestTree misc_tests = - testGroup "Misc Tests" [ + testGroup "Misc tests" [ testCase "flatten (1)" test_flatten1 ] -misc_properties :: Test.Framework.Test +misc_properties :: TestTree misc_properties = - testGroup "Misc Properties" [ + testGroup "Misc properties" [ testProperty "factorial greater" prop_factorial_greater ] diff --git a/src/Point.hs b/src/Point.hs index 0e29d59..8b720cf 100644 --- a/src/Point.hs +++ b/src/Point.hs @@ -6,7 +6,7 @@ module Point ( scale ) where -import Test.QuickCheck ( Arbitrary(..) ) +import Test.Tasty.QuickCheck ( Arbitrary(..) ) -- | Represents a point in three dimensions. We use a custom type (as diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index 8e9acd3..e63f96b 100644 --- a/src/Tetrahedron.hs +++ b/src/Tetrahedron.hs @@ -16,11 +16,14 @@ where import Data.Vector ( singleton, snoc ) import qualified Data.Vector as V ( sum ) -import Test.Framework ( Test, testGroup ) -import Test.Framework.Providers.HUnit ( testCase ) -import Test.Framework.Providers.QuickCheck2 ( testProperty ) -import Test.HUnit (Assertion, assertEqual) -import Test.QuickCheck ( Arbitrary(..), Gen, Property, (==>) ) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( Assertion, assertEqual, testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Gen, + Property, + (==>), + testProperty ) import Comparisons ( (~=) ) import FunctionValues ( FunctionValues(..), empty_values ) @@ -321,7 +324,7 @@ b3 t point = (volume inner_tetrahedron) / (precomputed_volume t) -- | Check the volume of a particular tetrahedron (computed by hand) -- Its vertices are in clockwise order, so the volume should be -- negative. -tetrahedron1_geometry_tests :: Test.Framework.Test +tetrahedron1_geometry_tests :: TestTree tetrahedron1_geometry_tests = testGroup "tetrahedron1 geometry" [ testCase "volume1" volume1 ] @@ -347,7 +350,7 @@ tetrahedron1_geometry_tests = -- | Check the volume of a particular tetrahedron (computed by hand) -- Its vertices are in counter-clockwise order, so the volume should -- be positive. -tetrahedron2_geometry_tests :: Test.Framework.Test +tetrahedron2_geometry_tests :: TestTree tetrahedron2_geometry_tests = testGroup "tetrahedron2 geometry" [ testCase "volume1" volume1 ] @@ -494,17 +497,17 @@ prop_swapping_vertices_doesnt_affect_coefficients4 t = -tetrahedron_tests :: Test.Framework.Test +tetrahedron_tests :: TestTree tetrahedron_tests = - testGroup "Tetrahedron Tests" [ + testGroup "Tetrahedron tests" [ tetrahedron1_geometry_tests, tetrahedron2_geometry_tests ] -p78_24_properties :: Test.Framework.Test +p78_24_properties :: TestTree p78_24_properties = - testGroup "p. 78, Section (2.4) Properties" [ + testGroup "p. 78, Section (2.4) properties" [ testProperty "c3000 identity" prop_c3000_identity, testProperty "c2100 identity" prop_c2100_identity, testProperty "c1110 identity" prop_c1110_identity] @@ -556,9 +559,9 @@ p78_24_properties = -tetrahedron_properties :: Test.Framework.Test +tetrahedron_properties :: TestTree tetrahedron_properties = - testGroup "Tetrahedron Properties" [ + testGroup "Tetrahedron properties" [ p78_24_properties, testProperty "b0_v0_always_unity" prop_b0_v0_always_unity, testProperty "b0_v1_always_zero" prop_b0_v1_always_zero, diff --git a/test/TestSuite.hs b/test/TestSuite.hs index bac18ec..f1a8523 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,53 +1,32 @@ module Main where -import Data.Monoid (mempty) -import Test.Framework ( - RunnerOptions(), - Test, - TestName, - TestOptions(), - defaultMainWithOpts, - testGroup - ) -import Test.Framework.Options -import Test.Framework.Runners.Options -import Test.Framework.Providers.API (TestName) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit -import Test.QuickCheck (Testable ()) +import Test.Tasty ( TestTree, defaultMain, localOption, testGroup ) +import Test.Tasty.QuickCheck ( QuickCheckTests(..) ) -import Cardinal (cardinal_tests, cardinal_properties) -import Cube (cube_properties) -import FunctionValues (function_values_tests, function_values_properties) -import Grid (grid_tests, slow_tests) -import Misc (misc_tests, misc_properties) -import Tetrahedron (tetrahedron_tests, tetrahedron_properties) +import Cardinal ( cardinal_tests, cardinal_properties ) +import Cube ( cube_properties ) +import FunctionValues ( function_values_tests, function_values_properties ) +import Grid ( grid_properties, grid_tests, slow_tests ) +import Misc ( misc_tests, misc_properties ) +import Tetrahedron ( tetrahedron_tests, tetrahedron_properties ) main :: IO () main = do - let empty_test_opts = mempty :: TestOptions - let my_test_opts = empty_test_opts { - topt_maximum_generated_tests = Just 500 - } + defaultMain $ localOption (QuickCheckTests 500) tests - let empty_runner_opts = mempty :: RunnerOptions - let my_runner_opts = empty_runner_opts { - ropt_test_options = Just my_test_opts - } - defaultMainWithOpts tests my_runner_opts - - -tests :: [Test.Framework.Test] -tests = [ cardinal_tests, - function_values_tests, - grid_tests, - misc_tests, - tetrahedron_tests, - cube_properties, - tetrahedron_properties, - misc_properties, - cardinal_properties, - slow_tests ] +tests :: TestTree +tests = + testGroup "All tests" + [ cardinal_tests, + function_values_tests, + grid_tests, + misc_tests, + tetrahedron_tests, + grid_properties, + cube_properties, + tetrahedron_properties, + misc_properties, + cardinal_properties, + slow_tests ] -- 2.43.2