diff mbox series

[bug#35929,1/2] tests: hackage: Factor out package pattern.

Message ID 20190530114601.31038-1-rob@vllmrt.net
State Accepted
Headers show
Series [bug#35929,1/2] tests: hackage: Factor out package pattern. | expand

Checks

Context Check Description
cbaines/applying patch fail Apply failed

Commit Message

Robert Vollmert May 30, 2019, 11:46 a.m. UTC 
I don't understand how/if this is possible on a macro level, and
didn't find other facilities for runtime pattern matching than
eval. Works, though! And if there's no better way, it should be
fine for tests.

* tests/hackage.scm: Import result pattern matching via eval.
---
 tests/hackage.scm | 136 +++++++++++++++++++++++-----------------------
 1 file changed, 69 insertions(+), 67 deletions(-)
diff mbox series

Patch

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 0efad0638d..c50c0cc094 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -155,93 +155,95 @@  library
 
 (test-begin "hackage")
 
-(define* (eval-test-with-cabal test-cabal #:key (cabal-environment '()))
+(define* (match-pattern obj pattern)
+  (eval
+    `(match ',obj
+       (,pattern #t)
+       (x        (pk 'fail x #f)))
+    (interaction-environment)))
+
+(define* (eval-test-with-cabal test-cabal package-pattern #:key (cabal-environment '()))
   (mock
    ((guix import hackage) hackage-fetch
     (lambda (name-version)
       (call-with-input-string test-cabal
         read-cabal)))
-   (match (hackage->guix-package "foo" #:cabal-environment cabal-environment)
-     (('package
-        ('name "ghc-foo")
-        ('version "1.0.0")
-        ('source
-         ('origin
-           ('method 'url-fetch)
-           ('uri ('string-append
-                  "https://hackage.haskell.org/package/foo/foo-"
-                  'version
-                  ".tar.gz"))
-           ('sha256
-            ('base32
-             (? string? hash)))))
-        ('build-system 'haskell-build-system)
-        ('inputs
-         ('quasiquote
-          (("ghc-http" ('unquote 'ghc-http))
-           ("ghc-mtl" ('unquote 'ghc-mtl)))))
-        ('home-page "http://test.org")
-        ('synopsis (? string?))
-        ('description (? string?))
-        ('license 'bsd-3))
-      #t)
-     (x
-      (pk 'fail x #f)))))
+   (match-pattern
+     (hackage->guix-package "foo" #:cabal-environment cabal-environment)
+     package-pattern)))
+
+(define ghc-foo-pattern
+  '('package
+     ('name "ghc-foo")
+     ('version "1.0.0")
+     ('source
+      ('origin
+        ('method 'url-fetch)
+        ('uri ('string-append
+               "https://hackage.haskell.org/package/foo/foo-"
+               'version
+               ".tar.gz"))
+        ('sha256
+         ('base32
+          (? string? hash)))))
+     ('build-system 'haskell-build-system)
+     ('inputs
+      ('quasiquote
+       (("ghc-http" ('unquote 'ghc-http))
+        ("ghc-mtl" ('unquote 'ghc-mtl)))))
+     ('home-page "http://test.org")
+     ('synopsis (? string?))
+     ('description (? string?))
+     ('license 'bsd-3)))
 
 (test-assert "hackage->guix-package test 1"
-  (eval-test-with-cabal test-cabal-1))
+  (eval-test-with-cabal test-cabal-1 ghc-foo-pattern))
 
 (test-assert "hackage->guix-package test 2"
-  (eval-test-with-cabal test-cabal-2))
+  (eval-test-with-cabal test-cabal-2 ghc-foo-pattern))
 
 (test-assert "hackage->guix-package test 3"
-  (eval-test-with-cabal test-cabal-3
+  (eval-test-with-cabal test-cabal-3 ghc-foo-pattern
                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 
 (test-assert "hackage->guix-package test 4"
-  (eval-test-with-cabal test-cabal-4
+  (eval-test-with-cabal test-cabal-4 ghc-foo-pattern
                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 
 (test-assert "hackage->guix-package test 5"
-  (eval-test-with-cabal test-cabal-5
+  (eval-test-with-cabal test-cabal-5 ghc-foo-pattern
                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 
+(define ghc-foo-pattern-6
+  '('package
+     ('name "ghc-foo")
+     ('version "1.0.0")
+     ('source
+      ('origin
+        ('method 'url-fetch)
+        ('uri ('string-append
+               "https://hackage.haskell.org/package/foo/foo-"
+               'version
+               ".tar.gz"))
+        ('sha256
+         ('base32
+          (? string? hash)))))
+     ('build-system 'haskell-build-system)
+     ('inputs
+      ('quasiquote
+       (("ghc-b" ('unquote 'ghc-b))
+        ("ghc-http" ('unquote 'ghc-http))
+        ("ghc-mtl" ('unquote 'ghc-mtl)))))
+     ('native-inputs
+      ('quasiquote
+       (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
+     ('home-page "http://test.org")
+     ('synopsis (? string?))
+     ('description (? string?))
+     ('license 'bsd-3)))
+
 (test-assert "hackage->guix-package test 6"
-  (mock
-   ((guix import hackage) hackage-fetch
-    (lambda (name-version)
-      (call-with-input-string test-cabal-6
-        read-cabal)))
-   (match (hackage->guix-package "foo")
-     (('package
-        ('name "ghc-foo")
-        ('version "1.0.0")
-        ('source
-         ('origin
-           ('method 'url-fetch)
-           ('uri ('string-append
-                  "https://hackage.haskell.org/package/foo/foo-"
-                  'version
-                  ".tar.gz"))
-           ('sha256
-            ('base32
-             (? string? hash)))))
-        ('build-system 'haskell-build-system)
-        ('inputs
-         ('quasiquote
-          (("ghc-b" ('unquote 'ghc-b))
-           ("ghc-http" ('unquote 'ghc-http))
-           ("ghc-mtl" ('unquote 'ghc-mtl)))))
-        ('native-inputs
-         ('quasiquote
-          (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
-        ('home-page "http://test.org")
-        ('synopsis (? string?))
-        ('description (? string?))
-        ('license 'bsd-3))
-      #t)
-     (x
-      (pk 'fail x #f)))))
+  (eval-test-with-cabal test-cabal-6 ghc-foo-pattern-6))
 
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)