diff --git a/tests/GoldenSpec/Spec.hs b/tests/GoldenSpec/Spec.hs index 3e8af85a..bca7f15e 100644 --- a/tests/GoldenSpec/Spec.hs +++ b/tests/GoldenSpec/Spec.hs @@ -4,8 +4,9 @@ module GoldenSpec.Spec (spec) where -import GoldenSpec.Util (golden, goldenAllFormats) +import GoldenSpec.Util (golden, goldenAllFormats, goldenFormat2) import Graphics.Implicit +import Graphics.Implicit.Export.OutputFormat (OutputFormat (PNG)) import Prelude import Test.Hspec ( describe, Spec ) import Graphics.Implicit.Primitives (torus, ellipsoid, cone) @@ -193,4 +194,27 @@ spec = describe "golden tests" $ do (C1 1) (Left 0) (union [circle 10]) - $ Left 40 \ No newline at end of file + $ Left 40 + + -- These two should be equal, but internally when sampled at (V2 (-1) 0) + -- the sign of the SDF differs yet they both get rendered correctly. + let funPoly = polygon [V2 0 0, V2 0 (-0.1), V2 (-2) 0, V2 0 (-1)] + rotFunPoly = rotate (2*pi) funPoly + -- + -- > getImplicit funPoly (V2 (-1) 0) + -- -4.993761694389224e-2 + -- > getBox funPoly + -- (V2 (-2.0) (-1.0),V2 0.0 0.0) + -- + -- vs + -- + -- > getImplicit rotFunPoly (V2 (-1) 0)) + -- 4.9937616943891996e-2 + -- > getBox rotFunPoly + -- (V2 (-2.0000000000000004) (-1.0),V2 0.0 4.898587196589413e-16) + -- + -- TODO(srk): investigate, see also #449 + + describe "2d" $ do + goldenFormat2 PNG "troublesome-polygon" 1 $ funPoly + goldenFormat2 PNG "troublesome-polygon-under-rotation" 1 $ rotFunPoly diff --git a/tests/GoldenSpec/Util.hs b/tests/GoldenSpec/Util.hs index 6550e0b3..7473559d 100644 --- a/tests/GoldenSpec/Util.hs +++ b/tests/GoldenSpec/Util.hs @@ -2,12 +2,12 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} -module GoldenSpec.Util (golden, goldenAllFormats, goldenFormat) where +module GoldenSpec.Util (golden, goldenAllFormats, goldenFormat, goldenFormat2) where import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) -import Graphics.Implicit (SymbolicObj3) -import Graphics.Implicit.Export (export3) +import Graphics.Implicit (SymbolicObj2, SymbolicObj3) +import Graphics.Implicit.Export (export2, export3) import Graphics.Implicit.Export.OutputFormat (OutputFormat (ASCIISTL), formats3D, formatExtension) import Prelude (IO, FilePath, Bool (True, False), String, Double, pure, (==), (>>=), (<>), ($), show) import System.Directory (getTemporaryDirectory, doesFileExist) @@ -57,6 +57,36 @@ goldenFormat fmt name resolution sym = it (name <> " (golden, format: " <> show then pure () else False `shouldBe` True +-- | Construct a golden test for rendering the given 'SymbolicObj2' at the +-- specified resolution. On the first run of this test, it will render the +-- object and cache the results. Subsequent test runs will compare their result +-- to the cached one. This is valuable for ensuring mesh generation doesn't +-- break across commits. +-- +-- The objects are cached under @tests/golden/@, with the given name. Deleting +-- this file is sufficient to update the test if changes in the mesh generation +-- are intended. +-- TODO(srk): polymorphic export would be nice, related to #446 +goldenFormat2 :: OutputFormat -> String -> Double -> SymbolicObj2 -> SpecWith () +goldenFormat2 fmt name resolution sym = it (name <> " (golden, format: " <> show fmt <> ")") $ do + (res, cached) <- liftIO $ do + temp_fp <- getTemporaryFilePath "golden" + -- Output the rendered mesh + export2 fmt resolution temp_fp sym + !res <- readFile temp_fp + let golden_fp = "./tests/golden/" <> name <> "." <> formatExtension fmt + -- Check if the cached results already exist. + doesFileExist golden_fp >>= \case + True -> pure () + -- If not, save the mesh we just created in the cache. + False -> writeFile golden_fp res + !cached <- readFile golden_fp + pure (res, cached) + -- Finally, ceck if the two meshes are equal. + if res == cached + then pure () + else False `shouldBe` True + ------------------------------------------------------------------------------ -- | Get a temporary filepath with the desired extension. On unix systems, this -- is a file under @/tmp@. Useful for tests that need to write files. diff --git a/tests/golden/troublesome-polygon-under-rotation.png b/tests/golden/troublesome-polygon-under-rotation.png new file mode 100644 index 00000000..55e9025c Binary files /dev/null and b/tests/golden/troublesome-polygon-under-rotation.png differ diff --git a/tests/golden/troublesome-polygon.png b/tests/golden/troublesome-polygon.png new file mode 100644 index 00000000..c90ffbc5 Binary files /dev/null and b/tests/golden/troublesome-polygon.png differ