src/{Cube,Tetrahedron}.hs: disable incomplete pattern warnings via pragmas.

[spline3.git] / src / Cube.hs

diff --git a/src/Cube.hs b/src/Cube.hs
index 6e33423d2da3a828257b21ab85055db58b681af8..552b141e2a2f597ce7669baa9e181259e2979a96 100644 (file)
--- a/src/Cube.hs
+++ b/src/Cube.hs
@@ -1,3 +1,8 @@
+-- The "tetrahedron" function pattern matches on the integers zero
+-- through twenty-three, but doesn't handle the "otherwise" case, for
+-- performance reasons.
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
 module Cube (
   Cube(..),
   cube_properties,
@@ -16,12 +21,16 @@ 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( arbitrary ),
+  Gen,
+  Positive( Positive ),
+  choose,
+  testProperty )
 import Cardinal (
-  Cardinal(..),
+  Cardinal(F, B, L, R, D, T, FL, FR, FD, FT,
+           BL, BR, BD, BT, LD, LT, RD, RT, I),
   ccwx,
   ccwy,
   ccwz,
@@ -32,8 +41,12 @@ import Comparisons ( (~=), (~~=) )
 import qualified Face ( Face(..), center )
 import FunctionValues ( FunctionValues, eval, rotate )
 import Misc ( all_equal, disjoint )
-import Point ( Point(..), dot )
-import Tetrahedron ( Tetrahedron(..), barycenter, c, volume )
+import Point ( Point( Point ), dot )
+import Tetrahedron (
+  Tetrahedron(Tetrahedron, function_values, v0, v1, v2, v3),
+  barycenter,
+  c,
+  volume )
 
 data Cube = Cube { i  :: !Int,
                    j  :: !Int,
@@ -56,7 +69,7 @@ instance Arbitrary Cube where
         -- these numbers don't overflow 64 bits. This number is not
         -- magic in any other sense than that it does not cause test
         -- failures, while 2^23 does.
-        coordmax = 4194304 -- 2^22
+        coordmax = 4194304 :: Int -- 2^22
         coordmin = -coordmax
 
 
@@ -135,7 +148,7 @@ center cube =
 top_face :: Cube -> Face.Face
 top_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) delta )
       v1' = cc + ( Point delta delta delta )
@@ -148,7 +161,7 @@ top_face cube = Face.Face v0' v1' v2' v3'
 back_face :: Cube -> Face.Face
 back_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) (-delta) )
       v1' = cc + ( Point delta delta (-delta) )
@@ -160,7 +173,7 @@ back_face cube = Face.Face v0' v1' v2' v3'
 down_face :: Cube -> Face.Face
 down_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) (-delta) (-delta) )
       v1' = cc + ( Point (-delta) delta (-delta) )
@@ -173,7 +186,7 @@ down_face cube = Face.Face v0' v1' v2' v3'
 front_face :: Cube -> Face.Face
 front_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) (-delta) delta )
       v1' = cc + ( Point (-delta) delta delta )
@@ -184,7 +197,7 @@ front_face cube = Face.Face v0' v1' v2' v3'
 left_face :: Cube -> Face.Face
 left_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) delta )
       v1' = cc + ( Point (-delta) (-delta) delta )
@@ -196,7 +209,7 @@ left_face cube = Face.Face v0' v1' v2' v3'
 right_face :: Cube -> Face.Face
 right_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) delta delta)
       v1' = cc + ( Point delta  delta delta )
@@ -657,9 +670,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 +1146,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 +1162,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 +1173,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 +1184,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 +1203,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,