diff mbox series

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

Message ID 20190531193629.57733-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 31, 2019, 7:36 p.m. UTC 
* tests/hackage.scm: Import result pattern matching via syntax rule.
---
 tests/hackage.scm | 149 +++++++++++++++++++++++-----------------------
 1 file changed, 74 insertions(+), 75 deletions(-)
diff mbox series

Patch

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 0efad0638d..c73a28c1f5 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -155,93 +155,92 @@  library
 
 (test-begin "hackage")
 
-(define* (eval-test-with-cabal test-cabal #: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)))))
+(define-syntax-rule (make-cabal-import-test pattern)
+  (lambda*
+      (test-cabal #: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)
+       (pattern #t)
+       (x       (pk 'fail x #f))))))
+
+(define test-cabal-ghc-foo
+  (make-cabal-import-test
+   ('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))
+  (test-cabal-ghc-foo test-cabal-1))
 
 (test-assert "hackage->guix-package test 2"
-  (eval-test-with-cabal test-cabal-2))
+  (test-cabal-ghc-foo test-cabal-2))
 
 (test-assert "hackage->guix-package test 3"
-  (eval-test-with-cabal test-cabal-3
-                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+  (test-cabal-ghc-foo test-cabal-3
+                      #:cabal-environment '(("impl" . "ghc-7.8"))))
 
 (test-assert "hackage->guix-package test 4"
-  (eval-test-with-cabal test-cabal-4
-                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+  (test-cabal-ghc-foo test-cabal-4
+                      #:cabal-environment '(("impl" . "ghc-7.8"))))
 
 (test-assert "hackage->guix-package test 5"
-  (eval-test-with-cabal test-cabal-5
-                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+  (test-cabal-ghc-foo test-cabal-5
+                      #:cabal-environment '(("impl" . "ghc-7.8"))))
+
+(define test-cabal-ghc-foo-6
+  (make-cabal-import-test
+   ('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)))))
+  (test-cabal-ghc-foo-6 test-cabal-6))
 
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)