From 9849853e69c46b46996e8c775d15661b2aba27a8 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 3 Sep 2011 18:40:14 -0400 Subject: [PATCH] A bunch more test cleanup. --- src/FunctionValues.hs | 69 +++++++++++++++++++++++++++++++++++++++- src/Misc.hs | 32 +++++++++++++++++++ src/Tests/Cube.hs | 50 +++++++++-------------------- src/Tests/Misc.hs | 20 ------------ src/Tests/Tetrahedron.hs | 56 -------------------------------- test/TestSuite.hs | 21 ++---------- 6 files changed, 118 insertions(+), 130 deletions(-) delete mode 100644 src/Tests/Misc.hs diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs index 00bb0a8..e9da25f 100644 --- a/src/FunctionValues.hs +++ b/src/FunctionValues.hs @@ -7,6 +7,7 @@ module FunctionValues ( make_values, rotate, function_values_tests, + function_values_properties, value_at ) where @@ -15,10 +16,11 @@ import Prelude hiding (LT) import Test.HUnit import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..), choose) import Assertions (assertTrue) -import Cardinal ( Cardinal(..) ) +import Cardinal ( Cardinal(..), cwx, cwy, cwz ) import Examples (trilinear) import Values (Values3D, dims, idx) @@ -314,3 +316,68 @@ function_values_tests :: Test.Framework.Test function_values_tests = testGroup "FunctionValues Tests" [ testCase "test directions" test_directions ] + + +prop_x_rotation_doesnt_affect_front :: FunctionValues -> Bool +prop_x_rotation_doesnt_affect_front fv0 = + expr1 == expr2 + where + fv1 = rotate cwx fv0 + expr1 = front fv0 + expr2 = front fv1 + +prop_x_rotation_doesnt_affect_back :: FunctionValues -> Bool +prop_x_rotation_doesnt_affect_back fv0 = + expr1 == expr2 + where + fv1 = rotate cwx fv0 + expr1 = back fv0 + expr2 = back fv1 + + +prop_y_rotation_doesnt_affect_left :: FunctionValues -> Bool +prop_y_rotation_doesnt_affect_left fv0 = + expr1 == expr2 + where + fv1 = rotate cwy fv0 + expr1 = left fv0 + expr2 = left fv1 + +prop_y_rotation_doesnt_affect_right :: FunctionValues -> Bool +prop_y_rotation_doesnt_affect_right fv0 = + expr1 == expr2 + where + fv1 = rotate cwy fv0 + expr1 = right fv0 + expr2 = right fv1 + + +prop_z_rotation_doesnt_affect_down :: FunctionValues -> Bool +prop_z_rotation_doesnt_affect_down fv0 = + expr1 == expr2 + where + fv1 = rotate cwz fv0 + expr1 = down fv0 + expr2 = down fv1 + + +prop_z_rotation_doesnt_affect_top :: FunctionValues -> Bool +prop_z_rotation_doesnt_affect_top fv0 = + expr1 == expr2 + where + fv1 = rotate cwz fv0 + expr1 = top fv0 + expr2 = top fv1 + + +function_values_properties :: Test.Framework.Test +function_values_properties = + let tp = testProperty + in + 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, + tp "y rotation doesn't affect right" prop_y_rotation_doesnt_affect_right, + tp "z rotation doesn't affect top" prop_z_rotation_doesnt_affect_top, + tp "z rotation doesn't affect down" prop_z_rotation_doesnt_affect_down ] diff --git a/src/Misc.hs b/src/Misc.hs index b9220cb..16b0ead 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -4,6 +4,11 @@ module Misc where import Data.List (intersect) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit +import Test.QuickCheck -- | The standard factorial function. See @@ -75,3 +80,30 @@ all_equal xs = disjoint :: (Eq a) => [a] -> [a] -> Bool disjoint xs ys = intersect xs ys == [] + + + +prop_factorial_greater :: Int -> Property +prop_factorial_greater n = + n <= 20 ==> factorial n >= n + + +test_flatten1 :: Assertion +test_flatten1 = + assertEqual "flatten actually works" expected_list actual_list + where + target = [[[1::Int]], [[2, 3]]] + expected_list = [1, 2, 3] + actual_list = flatten target + + +misc_tests :: Test.Framework.Test +misc_tests = + testGroup "Misc Tests" [ + testCase "flatten (1)" test_flatten1 ] + + +misc_properties :: Test.Framework.Test +misc_properties = + testGroup "Misc Properties" [ + testProperty "factorial greater" prop_factorial_greater ] diff --git a/src/Tests/Cube.hs b/src/Tests/Cube.hs index 17ea7f8..e9e21d6 100644 --- a/src/Tests/Cube.hs +++ b/src/Tests/Cube.hs @@ -398,47 +398,27 @@ prop_c_tilde_2100_rotation_correct cube = (1/192)*(FD + RD + LD + BD) --- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87. --- This test checks the actual value based on the FunctionValues of the cube. +-- | We know what (c t6 2 1 0 0) should be from Sorokina and +-- Zeilfelder, p. 87. This test checks the actual value based on +-- the FunctionValues of the cube. +-- +-- If 'prop_c_tilde_2100_rotation_correct' passes, then this test is +-- even meaningful! prop_c_tilde_2100_correct :: Cube -> Bool prop_c_tilde_2100_correct cube = - c t6 2 1 0 0 == (3/8)*int - + (1/12)*(f + r + l + b) - + (1/64)*(ft + rt + lt + bt) - + (7/48)*t + (1/48)*d + (1/96)*(fr + fl + br + bl) - + (1/192)*(fd + rd + ld + bd) + c t6 2 1 0 0 == expected where t0 = tetrahedron0 cube t6 = tetrahedron6 cube fvs = Tetrahedron.fv t0 - (Cube _ i j k _ _) = cube - f = value_at fvs (i-1) j k - b = value_at fvs (i+1) j k - l = value_at fvs i (j-1) k - r = value_at fvs i (j+1) k - d = value_at fvs i j (k-1) - t = value_at fvs i j (k+1) - fl = value_at fvs (i-1) (j-1) k - fr = value_at fvs (i-1) (j+1) k - fd = value_at fvs (i-1) j (k-1) - ft = value_at fvs (i-1) j (k+1) - bl = value_at fvs (i+1) (j-1) k - br = value_at fvs (i+1) (j+1) k - bd = value_at fvs (i+1) j (k-1) - bt = value_at fvs (i+1) j (k+1) - ld = value_at fvs i (j-1) (k-1) - lt = value_at fvs i (j-1) (k+1) - rd = value_at fvs i (j+1) (k-1) - rt = value_at fvs i (j+1) (k+1) - fld = value_at fvs (i-1) (j-1) (k-1) - flt = value_at fvs (i-1) (j-1) (k+1) - frd = value_at fvs (i-1) (j+1) (k-1) - frt = value_at fvs (i-1) (j+1) (k+1) - bld = value_at fvs (i+1) (j-1) (k-1) - blt = value_at fvs (i+1) (j-1) (k+1) - brd = value_at fvs (i+1) (j+1) (k-1) - brt = value_at fvs (i+1) (j+1) (k+1) - int = value_at fvs i j k + expected = eval fvs $ + (3/8)*I + + (1/12)*(F + R + L + B) + + (1/64)*(FT + RT + LT + BT) + + (7/48)*T + + (1/48)*D + + (1/96)*(FR + FL + BR + BL) + + (1/192)*(FD + RD + LD + BD) -- Tests to check that the correct edges are incidental. diff --git a/src/Tests/Misc.hs b/src/Tests/Misc.hs deleted file mode 100644 index fd16064..0000000 --- a/src/Tests/Misc.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Tests.Misc -where - -import Test.HUnit -import Test.QuickCheck - -import Misc - -prop_factorial_greater :: Int -> Property -prop_factorial_greater n = - n <= 20 ==> factorial n >= n - - -test_flatten1 :: Assertion -test_flatten1 = - assertEqual "flatten actually works" expected_list actual_list - where - target = [[[1::Int]], [[2, 3]]] - expected_list = [1, 2, 3] - actual_list = flatten target diff --git a/src/Tests/Tetrahedron.hs b/src/Tests/Tetrahedron.hs index ec71e3b..0d92452 100644 --- a/src/Tests/Tetrahedron.hs +++ b/src/Tests/Tetrahedron.hs @@ -286,62 +286,6 @@ prop_c1110_identity t = term3 = (3/4)*((p t 2 1 0 0) + (p t 1 2 0 0) + (p t 2 0 1 0)) term4 = (3/4)*((p t 1 0 2 0) + (p t 0 2 1 0) + (p t 0 1 2 0)) -prop_x_rotation_doesnt_affect_front :: Tetrahedron -> Bool -prop_x_rotation_doesnt_affect_front t = - expr1 == expr2 - where - fv0 = Tetrahedron.fv t - fv1 = rotate cwx (Tetrahedron.fv t) - expr1 = front fv0 - expr2 = front fv1 - -prop_x_rotation_doesnt_affect_back :: Tetrahedron -> Bool -prop_x_rotation_doesnt_affect_back t = - expr1 == expr2 - where - fv0 = Tetrahedron.fv t - fv1 = rotate cwx (Tetrahedron.fv t) - expr1 = back fv0 - expr2 = back fv1 - - -prop_y_rotation_doesnt_affect_left :: Tetrahedron -> Bool -prop_y_rotation_doesnt_affect_left t = - expr1 == expr2 - where - fv0 = Tetrahedron.fv t - fv1 = rotate cwy (Tetrahedron.fv t) - expr1 = left fv0 - expr2 = left fv1 - -prop_y_rotation_doesnt_affect_right :: Tetrahedron -> Bool -prop_y_rotation_doesnt_affect_right t = - expr1 == expr2 - where - fv0 = Tetrahedron.fv t - fv1 = rotate cwy (Tetrahedron.fv t) - expr1 = right fv0 - expr2 = right fv1 - - -prop_z_rotation_doesnt_affect_down :: Tetrahedron -> Bool -prop_z_rotation_doesnt_affect_down t = - expr1 == expr2 - where - fv0 = Tetrahedron.fv t - fv1 = rotate cwz (Tetrahedron.fv t) - expr1 = down fv0 - expr2 = down fv1 - - -prop_z_rotation_doesnt_affect_top :: Tetrahedron -> Bool -prop_z_rotation_doesnt_affect_top t = - expr1 == expr2 - where - fv0 = Tetrahedron.fv t - fv1 = rotate cwz (Tetrahedron.fv t) - expr1 = top fv0 - expr2 = top fv1 prop_swapping_vertices_doesnt_affect_coefficients1 :: Tetrahedron -> Bool prop_swapping_vertices_doesnt_affect_coefficients1 t = diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 73723c2..a3563b0 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -9,11 +9,11 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit import Test.QuickCheck (Testable ()) -import FunctionValues (functionvalues_tests) +import FunctionValues (function_values_tests, function_values_properties) +import Misc (misc_tests, misc_properties) import Tests.Cardinal import Tests.Cube as TC import Tests.Grid -import Tests.Misc import Tests.Tetrahedron as TT main :: IO () @@ -41,11 +41,6 @@ grid_tests = tc "zeros reproduced" test_zeros_reproduced ] -misc_tests :: Test.Framework.Test -misc_tests = - testGroup "Misc Tests" [ - tc "flatten (1)" test_flatten1 ] - tetrahedron_tests :: Test.Framework.Test tetrahedron_tests = testGroup "Tetrahedron Tests" [ @@ -57,10 +52,6 @@ tetrahedron_tests = tp :: Test.QuickCheck.Testable a => Test.Framework.TestName -> a -> Test.Framework.Test tp = testProperty -misc_properties :: Test.Framework.Test -misc_properties = - testGroup "Misc Properties" [ - tp "factorial greater" prop_factorial_greater ] cardinal_properties :: Test.Framework.Test cardinal_properties = @@ -195,13 +186,7 @@ tetrahedron_properties = tp "swapping_vertices_doesnt_affect_coefficients3" $ prop_swapping_vertices_doesnt_affect_coefficients3, tp "swapping_vertices_doesnt_affect_coefficients4" - $ prop_swapping_vertices_doesnt_affect_coefficients4, - 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, - tp "y rotation doesn't affect right" prop_y_rotation_doesnt_affect_right, - tp "z rotation doesn't affect top" prop_z_rotation_doesnt_affect_top, - tp "z rotation doesn't affect down" prop_z_rotation_doesnt_affect_down ] + $ prop_swapping_vertices_doesnt_affect_coefficients4 ] -- Do the slow tests last so we can stop paying attention. -- 2.43.2