From 716761b051b27d78bf1f374ac287a94b14cc2bca Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Sat, 18 May 2019 04:58:18 +0200
Subject: [PATCH 04/11] tests: hackage: avoid mock, and extract test data

This is partially in order to make tests depend less on the
implementation of `hackage-fetch`, in preparation for hackage
revision import.

* tests/hackage.scm: Provide cabal input port directly, instead
of mocking hackage-fetch. And make cabal tests more explicit and
consistent by defining package pattern per test.
---
 tests/hackage.scm | 141 +++++++++++++++++++++-------------------------
 1 file changed, 65 insertions(+), 76 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 733d540c20..5f47e909c6 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -188,101 +188,90 @@ 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-impl "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 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)))
+
+(define* (eval-test-with-cabal test-cabal package-pattern #:key (cabal-environment '()))
+  (define port (open-input-string test-cabal))
+  (match (hackage->guix-package-impl "foo" #:port port #:cabal-environment cabal-environment)
+    (package-pattern #t)
+    (x               (pk 'fail x #f))))
 
 (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-impl "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 "hackage->guix-package test 7"
-  (eval-test-with-cabal test-cabal-7
-                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+  (eval-test-with-cabal test-cabal-7 ghc-foo-pattern))
 
 (test-assert "hackage->guix-package test 8"
-  (eval-test-with-cabal test-cabal-8
-                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+  (eval-test-with-cabal test-cabal-8 ghc-foo-pattern))
 
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
-- 
2.21.0

