diff --git a/flake.lock b/flake.lock index 22754c0810e24a72f488b989015e391a7837997a..b70b5b023cc9e141d1120a1f5207af773555d078 100644 --- a/flake.lock +++ b/flake.lock @@ -43,10 +43,11 @@ "nixpkgs": "nixpkgs" }, "locked": { - "dirtyRev": "e40b8ead4d46261fccf1530507b191d9a1ef831b-dirty", - "dirtyShortRev": "e40b8ea-dirty", - "lastModified": 1708355706, - "narHash": "sha256-a7sHHhQPvDaEjmCAgiAN9OQRJMQNkFVNHzjIu0BYfAg=", + "lastModified": 1708504824, + "narHash": "sha256-q9kMpixbo9CIq3jj5fJRAq3U+j/o0ooILRD9nYKaHjs=", + "ref": "refs/heads/main", + "rev": "979d17cf356e3a336dac8820c676ec813668222c", + "revCount": 2, "type": "git", "url": "file:///Users/chrg/Develop/repos/hspec-glitter" }, diff --git a/rtree-c/.hspec-failures b/rtree-c/.hspec-failures index fc74144955831d70afd4106807a95aeadef9bfb4..aed6a42626d605dd16677e0526e976e059716286 100644 --- a/rtree-c/.hspec-failures +++ b/rtree-c/.hspec-failures @@ -1 +1 @@ -FailureReport {failureReportSeed = 860042728, failureReportMaxSuccess = 100, failureReportMaxSize = 100, failureReportMaxDiscardRatio = 10, failureReportPaths = [(["ReduceC","test/expected/main/reduction"],"should validate all reductions"),(["ReduceC","test/expected/main/reduction"],"should not have changed")]} \ No newline at end of file +FailureReport {failureReportSeed = 79465390, failureReportMaxSuccess = 100, failureReportMaxSize = 100, failureReportMaxDiscardRatio = 10, failureReportPaths = []} \ No newline at end of file diff --git a/rtree-c/test/cases/main.c b/rtree-c/test/cases/main.c new file mode 100644 index 0000000000000000000000000000000000000000..2cf2d1251ff08b11cd0683add9290ea119fccf74 --- /dev/null +++ b/rtree-c/test/cases/main.c @@ -0,0 +1,4 @@ +// A small test of basic reduction. Should not reduce. +int main() { + return 0; +} diff --git a/rtree-c/test/cases/main/main.c b/rtree-c/test/cases/main/main.c deleted file mode 100644 index 33c14ce1d76c0abf607ca769d1c3f913b0a7e421..0000000000000000000000000000000000000000 --- a/rtree-c/test/cases/main/main.c +++ /dev/null @@ -1,3 +0,0 @@ -int main() { - return 0; -} diff --git a/rtree-c/test/cases/main/pp.c b/rtree-c/test/expected/main/main.c similarity index 100% rename from rtree-c/test/cases/main/pp.c rename to rtree-c/test/expected/main/main.c diff --git a/rtree-c/test/src/ReduceCSpec.hs b/rtree-c/test/src/ReduceCSpec.hs index 31e87d297b499dbdaa541eceeaaf5177c91576e3..0375b6757602d635bedda21465d7d5bc5c242b16 100644 --- a/rtree-c/test/src/ReduceCSpec.hs +++ b/rtree-c/test/src/ReduceCSpec.hs @@ -26,38 +26,35 @@ spec = do cases <- runIO (listDirectory "test/cases") forM_ cases \cname -> do - let cfrom = "test/cases" </> cname </> "main.c" - let expected = "test/expected" </> cname - onGlitterWith - (expected </> "pp.c") - (preproc cfrom) - do - it "should be valid" \(cf, _) -> - validate cf + let cfrom = "test/cases" </> cname + + c <- runIO $ parse cfrom - it "should be parsed equally" \(cf, c) -> do - C.parseCFilePre cf >>= \case - Left err -> fail (show err) - Right c' -> c' $> () `shouldBe` c $> () + let expected = "test/expected" </> dropExtensions cname + onGlitterWith (expected </> "main.c") (\fp () -> render fp c) do + it "should be valid" . foldMap $ \cf -> do + validate cf - describe "reduction" do - it "should extract itself" \(_, c) -> do - extract (reduceC c) `shouldBe` c + it "should be parsed equally" . foldMap $ \cf -> do + C.parseCFilePre cf >>= \case + Left err -> fail (show err) + Right c' -> c' $> () `shouldBe` c $> () + + describe "reduction" do + it "should extract itself" do + extract (reduceC c) `shouldBe` c onGlitterWith (expected </> "reduction") ( \a () -> do - c <- parse cfrom createDirectoryIfMissing True a forM_ (take 20 $ iinputs (reduceC c)) \(i, c') -> do let rfile = expected </> "reduction" </> "r" <> debugShow i <.> "c" render rfile c' - pure a ) do - it "should validate all reductions" \a -> do - listDirectory a >>= mapM_ \x -> - validate (a </> x) + it "should validate all reductions" . mapM_ $ \a -> do + validate a validate :: FilePath -> IO () validate fp = do @@ -77,9 +74,3 @@ parse cfrom = do case cf of Left err -> fail (show err) Right cf' -> pure cf' - -preproc :: FilePath -> FilePath -> () -> IO (FilePath, C.CTranslUnit) -preproc cfrom cto _ = do - cf' <- parse cfrom - render cto cf' - pure (cfrom, cf')