Merge branch 'master' into core-updates

1 files changed, 152 insertions, 73 deletions

diff --git a/tests/opam.scm b/tests/opam.scm
index a1320abfdc..e0ec5ef3d4 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -21,98 +21,177 @@
   #:use-module (guix base32)
   #:use-module (gcrypt hash)
   #:use-module (guix tests)
+  #:use-module ((guix build syscalls) #:select (mkdtemp!))
   #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which))
+  #:use-module ((guix utils) #:select (call-with-temporary-output-file))
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module (web uri)
-  #:use-module (ice-9 match))
-
-(define test-url-file
-  "http: \"https://example.org/foo-1.0.0.tar.gz\"
-checksum: \"ac8920f39a8100b94820659bc2c20817\"")
-
-(define test-source-hash
-  "")
-
-(define test-urls
-  "repo ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/url ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/opam ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/descr ac8920f39a8100b94820659bc2c20817 0o644")
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 peg))
 
 (define test-opam-file
-"opam-version: 1.2
+"opam-version: \"2.0\"
+  version: \"1.0.0\"
 maintainer: \"Alice Doe\"
-authors: \"Alice Doe, John Doe\"
+authors: [
+  \"Alice Doe\"
+  \"John Doe\"
+]
 homepage: \"https://example.org/\"
 bug-reports: \"https://example.org/bugs\"
-license: \"MIT\"
 dev-repo: \"https://example.org/git\"
 build: [
-  \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"
+  [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"]
 ]
 build-test: [
-  \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"
+  [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"]
 ]
 depends: [
   \"alcotest\" {test & >= \"0.7.2\"}
   \"ocamlbuild\" {build & >= \"0.9.2\"}
-]")
+  \"zarith\" {>= \"0.7\"}
+]
+synopsis: \"Some example package\"
+description: \"\"\"
+This package is just an example.\"\"\"
+url {
+  src: \"https://example.org/foo-1.0.0.tar.gz\"
+  checksum: \"md5=74c6e897658e820006106f45f736381f\"
+}")
+
+(define test-source-hash
+  "")
+
+(define test-repo
+  (mkdtemp! "/tmp/opam-repo.XXXXXX"))
 
 (test-begin "opam")
 
 (test-assert "opam->guix-package"
-  ;; Replace network resources with sample data.
-    (mock ((guix import utils) url-fetch
-           (lambda (url file-name)
-             (match url
-               ("https://example.org/foo-1.0.0.tar.gz"
-                (begin
-                  (mkdir-p "foo-1.0.0")
-                  (system* "tar" "czvf" file-name "foo-1.0.0/")
-                  (delete-file-recursively "foo-1.0.0")
-                  (set! test-source-hash
-                    (call-with-input-file file-name port-sha256))))
-               (_ (error "Unexpected URL: " url)))))
-          (mock ((guix http-client) http-fetch/cached
-                 (lambda (url . rest)
-                   (match (uri->string url)
-                     ("https://opam.ocaml.org/urls.txt"
-                      (values (open-input-string test-urls)
-                              (string-length test-urls)))
-                     (_ (error "Unexpected URL: " url)))))
-                (mock ((guix http-client) http-fetch
-                       (lambda (url . rest)
-                         (match url
-                           ("https://opam.ocaml.org/packages/foo/foo.1.0.0/url"
-                            (values (open-input-string test-url-file)
-                                    (string-length test-url-file)))
-                           ("https://opam.ocaml.org/packages/foo/foo.1.0.0/opam"
-                            (values (open-input-string test-opam-file)
-                                    (string-length test-opam-file)))
-                           (_ (error "Unexpected URL: " url)))))
-                      (match (opam->guix-package "foo")
-                        (('package
-                           ('name "ocaml-foo")
-                           ('version "1.0.0")
-                           ('source ('origin
-                                      ('method 'url-fetch)
-                                      ('uri "https://example.org/foo-1.0.0.tar.gz")
-                                      ('sha256
-                                       ('base32
-                                        (? string? hash)))))
-                           ('build-system 'ocaml-build-system)
-                           ('inputs
-                            ('quasiquote
-                             (("ocamlbuild" ('unquote 'ocamlbuild))
-                              ("ocaml-alcotest" ('unquote 'ocaml-alcotest)))))
-                           ('home-page "https://example.org/")
-                           ('synopsis "")
-                           ('description "")
-                           ('license 'license:expat))
-                         (string=? (bytevector->nix-base32-string
-                                    test-source-hash)
-                                   hash))
-                        (x
-                         (pk 'fail x #f)))))))
+  (mock ((guix import utils) url-fetch
+         (lambda (url file-name)
+           (match url
+             ("https://example.org/foo-1.0.0.tar.gz"
+              (begin
+                (mkdir-p "foo-1.0.0")
+                (system* "tar" "czvf" file-name "foo-1.0.0/")
+                (delete-file-recursively "foo-1.0.0")
+                (set! test-source-hash
+                  (call-with-input-file file-name port-sha256))))
+             (_ (error "Unexpected URL: " url)))))
+      (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
+        (mkdir-p my-package)
+        (with-output-to-file (string-append my-package "/opam")
+          (lambda _
+            (format #t "~a" test-opam-file))))
+      (mock ((guix import opam) get-opam-repository
+             (lambda _
+               test-repo))
+        (match (opam->guix-package "foo")
+          (('package
+             ('name "ocaml-foo")
+             ('version "1.0.0")
+             ('source ('origin
+                        ('method 'url-fetch)
+                        ('uri "https://example.org/foo-1.0.0.tar.gz")
+                        ('sha256
+                         ('base32
+                          (? string? hash)))))
+             ('build-system 'ocaml-build-system)
+             ('inputs
+              ('quasiquote
+               (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+             ('native-inputs
+              ('quasiquote
+               (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+                ("ocamlbuild" ('unquote 'ocamlbuild)))))
+             ('home-page "https://example.org/")
+             ('synopsis "Some example package")
+             ('description "This package is just an example.")
+             ('license #f))
+           (string=? (bytevector->nix-base32-string
+                      test-source-hash)
+                     hash))
+          (x
+           (pk 'fail x #f))))))
+
+;; Test the opam file parser
+;; We fold over some test cases. Each case is a pair of the string to parse and the
+;; expected result.
+(test-assert "parse-strings"
+  (fold (lambda (test acc)
+          (display test) (newline)
+          (and acc
+               (let ((result (peg:tree (match-pattern (@@ (guix import opam) string-pat) (car test)))))
+                 (if (equal? result (cdr test))
+                   #t
+                   (pk 'fail (list (car test) result (cdr test)) #f)))))
+    #t '(("" . #f)
+         ("\"hello\"" . (string-pat "hello"))
+         ("\"hello world\"" . (string-pat "hello world"))
+         ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\""))
+         ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
+         ("\"今日は\"" . (string-pat "今日は")))))
+
+(test-assert "parse-multiline-strings"
+  (fold (lambda (test acc)
+          (display test) (newline)
+          (and acc
+               (let ((result (peg:tree (match-pattern (@@ (guix import opam) multiline-string) (car test)))))
+                 (if (equal? result (cdr test))
+                   #t
+                   (pk 'fail (list (car test) result (cdr test)) #f)))))
+    #t '(("" . #f)
+         ("\"\"\"hello\"\"\"" . (multiline-string "hello"))
+         ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!"))
+         ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!")))))
+
+(test-assert "parse-lists"
+  (fold (lambda (test acc)
+          (and acc
+               (let ((result (peg:tree (match-pattern (@@ (guix import opam) list-pat) (car test)))))
+                 (if (equal? result (cdr test))
+                   #t
+                   (pk 'fail (list (car test) result (cdr test)) #f)))))
+    #t '(("" . #f)
+         ("[]" . list-pat)
+         ("[make]" . (list-pat (var "make")))
+         ("[\"make\"]" . (list-pat (string-pat "make")))
+         ("[\n  a\n  b\n  c]" . (list-pat (var "a") (var "b") (var "c")))
+         ("[a   b     \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c"))))))
+
+(test-assert "parse-dicts"
+  (fold (lambda (test acc)
+          (and acc
+               (let ((result (peg:tree (match-pattern (@@ (guix import opam) dict) (car test)))))
+                 (if (equal? result (cdr test))
+                   #t
+                   (pk 'fail (list (car test) result (cdr test)) #f)))))
+    #t '(("" . #f)
+         ("{}" . dict)
+         ("{a: \"b\"}" . (dict (record "a" (string-pat "b"))))
+         ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d")))))))
+
+(test-assert "parse-conditions"
+  (fold (lambda (test acc)
+          (and acc
+               (let ((result (peg:tree (match-pattern (@@ (guix import opam) condition) (car test)))))
+                 (if (equal? result (cdr test))
+                   #t
+                   (pk 'fail (list (car test) result (cdr test)) #f)))))
+    #t '(("" . #f)
+         ("{}" . #f)
+         ("{build}" . (condition-var "build"))
+         ("{>= \"0.2.0\"}" . (condition-greater-or-equal
+                               (condition-string "0.2.0")))
+         ("{>= \"0.2.0\" & test}" . (condition-and
+                                      (condition-greater-or-equal
+                                        (condition-string "0.2.0"))
+                                      (condition-var "test")))
+         ("{>= \"0.2.0\" | build}" . (condition-or
+                                      (condition-greater-or-equal
+                                        (condition-string "0.2.0"))
+                                      (condition-var "build"))))))
 
 (test-end "opam")