[bug#35929] [PATCH] tests: hackage: avoid mock, and extract test data

[bug#35929] [PATCH] tests: hackage: avoid mock, and extract test data

[Robert Vollmert]

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 | 135 ++++++++++++++++++++++------------------------
 1 file changed, 63 insertions(+), 72 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 0efad0638d..a6d039afaa 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -155,93 +155,84 @@ 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 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 "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 "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)
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH] tests: hackage: avoid mock, and extract test data

[Ludovic Courtès]

Hi Robert,

Robert Vollmert <rob@vllmrt.net> skribis:

> +(define* (eval-test-with-cabal test-cabal package-pattern #:key (cabal-environment '()))
> +  (define port (open-input-string test-cabal))
> +  (match (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)
> +    (package-pattern #t)

This pattern matches anything and binds the result to ‘package-pattern’:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (let ((pattern '(a b)))
		       (match '(1 2 3) (pattern pattern)))
$9 = (1 2 3)
--8<---------------cut here---------------end--------------->8---

No more test failures!  :-)

The change you propose is a good idea but it needs to be implemented
using a macro:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (define-syntax-rule (match-pattern obj pattern)
		       (match obj
			 (pattern #t)
			 (_       #f)))
scheme@(guile-user)> (match-pattern '(1 2 3) (a b c))
$14 = #t
scheme@(guile-user)> (match-pattern '(1 2 3) (a b))
$15 = #f
scheme@(guile-user)> (match-pattern '(7 7) (a a))
$16 = #t
scheme@(guile-user)> (match-pattern '(1 2) (a a))
$17 = #f
--8<---------------cut here---------------end--------------->8---

HTH!

Ludo’.

[bug#35929] [PATCH] tests: hackage: avoid mock, and extract test data

[Robert Vollmert]

> On 29. May 2019, at 23:16, Ludovic Courtès <ludo@gnu.org> wrote:
> Robert Vollmert <rob@vllmrt.net> skribis:
> 
>> +(define* (eval-test-with-cabal test-cabal package-pattern #:key (cabal-environment '()))
>> +  (define port (open-input-string test-cabal))
>> +  (match (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)
>> +    (package-pattern #t)
> 
> This pattern matches anything and binds the result to ‘package-pattern’:
> 
> --8<---------------cut here---------------start------------->8---
> scheme@(guile-user)> (let ((pattern '(a b)))
> 		       (match '(1 2 3) (pattern pattern)))
> $9 = (1 2 3)
> --8<---------------cut here---------------end--------------->8---
> 
> No more test failures!  :-)
> 
> The change you propose is a good idea but it needs to be implemented
> using a macro:

Thanks, I’ll look into it. My first macro. :)

[bug#35929] [PATCH] tests: hackage: avoid mock, and extract test data

[Robert Vollmert]

> On 29. May 2019, at 23:16, Ludovic Courtès <ludo@gnu.org> wrote:
> --8<---------------cut here---------------start------------->8---
> scheme@(guile-user)> (define-syntax-rule (match-pattern obj pattern)
> 		       (match obj
> 			 (pattern #t)
> 			 (_       #f)))
> scheme@(guile-user)> (match-pattern '(1 2 3) (a b c))
> $14 = #t
> scheme@(guile-user)> (match-pattern '(1 2 3) (a b))
> $15 = #f
> scheme@(guile-user)> (match-pattern '(7 7) (a a))
> $16 = #t
> scheme@(guile-user)> (match-pattern '(1 2) (a a))
> $17 = #f
> --8<---------------cut here---------------end--------------->8—

Hmm, I can’t quite get this to work. I’d like to supply a name for
the pattern, so I can reuse it across test cases, and I’m currently
at a loss for how to do tha:

scheme@(ice-9 match)> (define pattern '(a b c))
scheme@(ice-9 match)> (match-pattern '(a 2) pattern)
$30 = #t

This makes sense, because the pattern is the literal pattern, not whatever
pattern would evaluate to.

I’ve also tried things like

scheme@(ice-9 match)> (define-syntax-rule (pattern) (a b c))

thinking that the pattern definition should happen at macro level, too,
but can’t get that to work either… Do you have further hints?

…

I did manage to get things to work using eval, will send a revised
patch.

Thanks,
Robert

[bug#35929] [PATCH] tests: hackage: avoid mock, and extract test data

[Ludovic Courtès]

Hi,

Robert Vollmert <rob@vllmrt.net> skribis:

>> On 29. May 2019, at 23:16, Ludovic Courtès <ludo@gnu.org> wrote:
>> --8<---------------cut here---------------start------------->8---
>> scheme@(guile-user)> (define-syntax-rule (match-pattern obj pattern)
>> 		       (match obj
>> 			 (pattern #t)
>> 			 (_       #f)))
>> scheme@(guile-user)> (match-pattern '(1 2 3) (a b c))
>> $14 = #t
>> scheme@(guile-user)> (match-pattern '(1 2 3) (a b))
>> $15 = #f
>> scheme@(guile-user)> (match-pattern '(7 7) (a a))
>> $16 = #t
>> scheme@(guile-user)> (match-pattern '(1 2) (a a))
>> $17 = #f
>> --8<---------------cut here---------------end--------------->8—
>
> Hmm, I can’t quite get this to work. I’d like to supply a name for
> the pattern, so I can reuse it across test cases, and I’m currently
> at a loss for how to do tha:
>
> scheme@(ice-9 match)> (define pattern '(a b c))
> scheme@(ice-9 match)> (match-pattern '(a 2) pattern)
> $30 = #t

Indeed, ‘match’ expects patterns to be literals.  So you cannot do:

  (define pattern …)

and then use that pattern in ‘match’ clauses.

If you wanted to do that, you would need to define a “procedural”
variant of ‘match’, which is not terribly difficult either, but it’s a
different beast.

> I did manage to get things to work using eval, will send a revised
> patch.

Please don’t use ‘eval’; there’s a saying that “eval is evil”, because
basically anything can happen when calling out to ‘eval’.

So as it turns out, I realize that the factorization you wanted to make
is not all that easy to achieve.  Perhaps adding a procedural pattern
matcher, which would be similar to ‘equal?’ except that it would ignore
the sha256, synopsis, and description, is the right way to go.

HTH!

Ludo’.

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

[Robert Vollmert]

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 --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)
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH 2/2] tests: hackage: Don't mock hackage-fetch.

[Robert Vollmert]

* tests/hackage.scm: Pass a string input port to tests instead of
mocking hackage download.
---
 tests/hackage.scm | 12 ++++--------
 1 file changed, 4 insertions(+), 8 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index c50c0cc094..f87e548177 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -163,14 +163,10 @@ library
     (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-pattern
-     (hackage->guix-package "foo" #:cabal-environment cabal-environment)
-     package-pattern)))
+  (define port (open-input-string test-cabal))
+  (match-pattern
+    (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)
+    package-pattern))
 
 (define ghc-foo-pattern
   '('package
-- 
2.20.1 (Apple Git-117)

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

[Robert Vollmert]

* tests/hackage.scm: Import result pattern matching via syntax rule.
---
 tests/hackage.scm | 149 +++++++++++++++++++++++-----------------------
 1 file changed, 74 insertions(+), 75 deletions(-)

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)
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH 2/2] tests: hackage: Don't mock hackage-fetch.

[Robert Vollmert]

* tests/hackage.scm: Pass a string input port to tests instead of
mocking hackage download.
---
 tests/hackage.scm | 12 ++++--------
 1 file changed, 4 insertions(+), 8 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index c73a28c1f5..ee9cd6bc2d 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -158,14 +158,10 @@ library
 (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 port (open-input-string test-cabal))
+    (match (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)
+      (pattern #t)
+      (x       (pk 'fail x #f)))))
 
 (define test-cabal-ghc-foo
   (make-cabal-import-test
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH 1/3] tests: hackage: Factor out package pattern.

[Robert Vollmert]

* tests/hackage.scm: Import result pattern matching via helper.
---
 tests/hackage.scm | 133 +++++++++++++++++++++++-----------------------
 1 file changed, 66 insertions(+), 67 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 0efad0638d..41e3b2dcd3 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 '()))
+(define-syntax-rule (define-package-matcher name pattern)
+  (define* (name obj)
+    (match obj
+      (pattern #t)
+      (x       (pk 'fail x #f)))))
+
+(define-package-matcher match-ghc-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-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 matcher #: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)))))
+   (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment))))
 
 (test-assert "hackage->guix-package test 1"
-  (eval-test-with-cabal test-cabal-1))
+  (eval-test-with-cabal test-cabal-1 match-ghc-foo))
 
 (test-assert "hackage->guix-package test 2"
-  (eval-test-with-cabal test-cabal-2))
+  (eval-test-with-cabal test-cabal-2 match-ghc-foo))
 
 (test-assert "hackage->guix-package test 3"
-  (eval-test-with-cabal test-cabal-3
+  (eval-test-with-cabal test-cabal-3 match-ghc-foo
                         #: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 match-ghc-foo
                         #: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 match-ghc-foo
                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 
+(define-package-matcher match-ghc-foo-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 match-ghc-foo-6))
 
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH 2/3] tests: hackage: Don't mock hackage-fetch.

[Robert Vollmert]

* tests/hackage.scm: Pass a string input port to tests instead of
mocking hackage download.
---
 tests/hackage.scm | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 41e3b2dcd3..1b4800164e 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -186,12 +186,8 @@ library
     ('license 'bsd-3)))
 
 (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
-  (mock
-   ((guix import hackage) hackage-fetch
-    (lambda (name-version)
-      (call-with-input-string test-cabal
-        read-cabal)))
-   (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment))))
+  (define port (open-input-string test-cabal))
+  (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
 
 (test-assert "hackage->guix-package test 1"
   (eval-test-with-cabal test-cabal-1 match-ghc-foo))
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH 3/3] tests: Indent hackage tests

[Robert Vollmert]

* tests/hackage.scm: Reindent using etc/indent-code.el.
---
 tests/hackage.scm | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/tests/hackage.scm b/tests/hackage.scm
index 1b4800164e..e5f3d6caed 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -242,19 +242,19 @@ library
   (match (call-with-input-string test-read-cabal-1 read-cabal)
     ((("name" ("test-me"))
       ('section 'library
-               (('if ('flag "base4point8")
-                    (("build-depends" ("base >= 4.8 && < 5")))
-                    (('if ('flag "base4")
-                         (("build-depends" ("base >= 4 && < 4.8")))
-                         (('if ('flag "base3")
-                              (("build-depends" ("base >= 3 && < 4")))
-                              (("build-depends" ("base < 3"))))))))
-                ('if ('or ('flag "base4point8")
-                          ('and ('flag "base4") ('flag "base3")))
-                    (("build-depends" ("random")))
-                    ())
-                ("build-depends" ("containers"))
-                ("exposed-modules" ("Test.QuickCheck.Exception")))))
+                (('if ('flag "base4point8")
+                      (("build-depends" ("base >= 4.8 && < 5")))
+                      (('if ('flag "base4")
+                            (("build-depends" ("base >= 4 && < 4.8")))
+                            (('if ('flag "base3")
+                                  (("build-depends" ("base >= 3 && < 4")))
+                                  (("build-depends" ("base < 3"))))))))
+                 ('if ('or ('flag "base4point8")
+                           ('and ('flag "base4") ('flag "base3")))
+                      (("build-depends" ("random")))
+                      ())
+                 ("build-depends" ("containers"))
+                 ("exposed-modules" ("Test.QuickCheck.Exception")))))
      #t)
     (x (pk 'fail x #f))))
 
-- 
2.20.1 (Apple Git-117)

[bug#35929] [PATCH 1/3] tests: hackage: Factor out package pattern.

[Robert Vollmert]

This seems to be a nicer solution than previously.

> On 31. May 2019, at 23:22, Robert Vollmert <rob@vllmrt.net> wrote:
> 
> * tests/hackage.scm: Import result pattern matching via helper.
> ---
> tests/hackage.scm | 133 +++++++++++++++++++++++-----------------------
> 1 file changed, 66 insertions(+), 67 deletions(-)
> 
> diff --git a/tests/hackage.scm b/tests/hackage.scm
> index 0efad0638d..41e3b2dcd3 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 '()))
> +(define-syntax-rule (define-package-matcher name pattern)
> +  (define* (name obj)
> +    (match obj
> +      (pattern #t)
> +      (x       (pk 'fail x #f)))))
> +
> +(define-package-matcher match-ghc-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-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 matcher #: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)))))
> +   (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment))))
> 
> (test-assert "hackage->guix-package test 1"
> -  (eval-test-with-cabal test-cabal-1))
> +  (eval-test-with-cabal test-cabal-1 match-ghc-foo))
> 
> (test-assert "hackage->guix-package test 2"
> -  (eval-test-with-cabal test-cabal-2))
> +  (eval-test-with-cabal test-cabal-2 match-ghc-foo))
> 
> (test-assert "hackage->guix-package test 3"
> -  (eval-test-with-cabal test-cabal-3
> +  (eval-test-with-cabal test-cabal-3 match-ghc-foo
>                         #: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 match-ghc-foo
>                         #: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 match-ghc-foo
>                         #:cabal-environment '(("impl" . "ghc-7.8"))))
> 
> +(define-package-matcher match-ghc-foo-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 match-ghc-foo-6))
> 
> (test-assert "read-cabal test 1"
>   (match (call-with-input-string test-read-cabal-1 read-cabal)
> -- 
> 2.20.1 (Apple Git-117)
> 

bug#35929: [PATCH 1/3] tests: hackage: Factor out package pattern.

[Ludovic Courtès]

Hello,

Robert Vollmert <rob@vllmrt.net> skribis:

> This seems to be a nicer solution than previously.

Indeed.  Applied all three patches, thank you!

Ludo’.