From fcdcd85a03ccc25a8fd09dd78e6f8e2ce2bfb5d7 Mon Sep 17 00:00:00 2001
From: Christian Gram Kalhauge <chrg@dtu.dk>
Date: Wed, 21 Feb 2024 09:52:27 +0100
Subject: [PATCH] Update the hspec-glitter
---
flake.lock | 9 ++--
rtree-c/.hspec-failures | 2 +-
rtree-c/test/cases/main.c | 4 ++
rtree-c/test/cases/main/main.c | 3 --
.../{cases/main/pp.c => expected/main/main.c} | 0
rtree-c/test/src/ReduceCSpec.hs | 43 ++++++++-----------
6 files changed, 27 insertions(+), 34 deletions(-)
create mode 100644 rtree-c/test/cases/main.c
delete mode 100644 rtree-c/test/cases/main/main.c
rename rtree-c/test/{cases/main/pp.c => expected/main/main.c} (100%)
diff --git a/flake.lock b/flake.lock
index 22754c0..b70b5b0 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 fc74144..aed6a42 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 0000000..2cf2d12
--- /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 33c14ce..0000000
--- 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 31e87d2..0375b67 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')
--
GitLab