| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> |
| 3 | ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> |
| 4 | ;;; |
| 5 | ;;; This file is part of GNU Guix. |
| 6 | ;;; |
| 7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 8 | ;;; under the terms of the GNU General Public License as published by |
| 9 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 10 | ;;; your option) any later version. |
| 11 | ;;; |
| 12 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | ;;; GNU General Public License for more details. |
| 16 | ;;; |
| 17 | ;;; You should have received a copy of the GNU General Public License |
| 18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 19 | |
| 20 | (define-module (test-opam) |
| 21 | #:use-module (guix import opam) |
| 22 | #:use-module (guix base32) |
| 23 | #:use-module (gcrypt hash) |
| 24 | #:use-module (guix tests) |
| 25 | #:use-module ((guix build syscalls) #:select (mkdtemp!)) |
| 26 | #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which)) |
| 27 | #:use-module ((guix utils) #:select (call-with-temporary-output-file)) |
| 28 | #:use-module (srfi srfi-1) |
| 29 | #:use-module (srfi srfi-64) |
| 30 | #:use-module (web uri) |
| 31 | #:use-module (ice-9 match) |
| 32 | #:use-module (ice-9 peg)) |
| 33 | |
| 34 | (define test-opam-file |
| 35 | "opam-version: \"2.0\" |
| 36 | version: \"1.0.0\" |
| 37 | maintainer: \"Alice Doe\" |
| 38 | authors: [ |
| 39 | \"Alice Doe\" |
| 40 | \"John Doe\" |
| 41 | ] |
| 42 | homepage: \"https://example.org/\" |
| 43 | bug-reports: \"https://example.org/bugs\" |
| 44 | dev-repo: \"https://example.org/git\" |
| 45 | build: [ |
| 46 | [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"] |
| 47 | ] |
| 48 | build-test: [ |
| 49 | [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"] |
| 50 | ] |
| 51 | depends: [ |
| 52 | \"alcotest\" {test & >= \"0.7.2\"} |
| 53 | \"ocamlbuild\" {build & >= \"0.9.2\"} |
| 54 | \"zarith\" {>= \"0.7\"} |
| 55 | ] |
| 56 | synopsis: \"Some example package\" |
| 57 | description: \"\"\" |
| 58 | This package is just an example.\"\"\" |
| 59 | license: \"BSD-3-Clause\" |
| 60 | url { |
| 61 | src: \"https://example.org/foo-1.0.0.tar.gz\" |
| 62 | checksum: \"md5=74c6e897658e820006106f45f736381f\" |
| 63 | }") |
| 64 | |
| 65 | (define test-source-hash |
| 66 | "") |
| 67 | |
| 68 | (define test-repo |
| 69 | (mkdtemp! "/tmp/opam-repo.XXXXXX")) |
| 70 | |
| 71 | (test-begin "opam") |
| 72 | |
| 73 | (test-assert "opam->guix-package" |
| 74 | (mock ((guix import utils) url-fetch |
| 75 | (lambda (url file-name) |
| 76 | (match url |
| 77 | ("https://example.org/foo-1.0.0.tar.gz" |
| 78 | (begin |
| 79 | (mkdir-p "foo-1.0.0") |
| 80 | (system* "tar" "czvf" file-name "foo-1.0.0/") |
| 81 | (delete-file-recursively "foo-1.0.0") |
| 82 | (set! test-source-hash |
| 83 | (call-with-input-file file-name port-sha256)))) |
| 84 | (_ (error "Unexpected URL: " url))))) |
| 85 | (let ((my-package (string-append test-repo |
| 86 | "/packages/foo/foo.1.0.0"))) |
| 87 | (mkdir-p my-package) |
| 88 | (with-output-to-file (string-append my-package "/opam") |
| 89 | (lambda _ |
| 90 | (format #t "~a" test-opam-file)))) |
| 91 | (match (opam->guix-package "foo" #:repo (list test-repo)) |
| 92 | (('package |
| 93 | ('name "ocaml-foo") |
| 94 | ('version "1.0.0") |
| 95 | ('source ('origin |
| 96 | ('method 'url-fetch) |
| 97 | ('uri "https://example.org/foo-1.0.0.tar.gz") |
| 98 | ('sha256 |
| 99 | ('base32 |
| 100 | (? string? hash))))) |
| 101 | ('build-system 'ocaml-build-system) |
| 102 | ('propagated-inputs |
| 103 | ('quasiquote |
| 104 | (("ocaml-zarith" ('unquote 'ocaml-zarith))))) |
| 105 | ('native-inputs |
| 106 | ('quasiquote |
| 107 | (("ocaml-alcotest" ('unquote 'ocaml-alcotest)) |
| 108 | ("ocamlbuild" ('unquote 'ocamlbuild))))) |
| 109 | ('home-page "https://example.org/") |
| 110 | ('synopsis "Some example package") |
| 111 | ('description "This package is just an example.") |
| 112 | ('license 'license:bsd-3)) |
| 113 | (string=? (bytevector->nix-base32-string |
| 114 | test-source-hash) |
| 115 | hash)) |
| 116 | (x |
| 117 | (pk 'fail x #f))))) |
| 118 | |
| 119 | ;; Test the opam file parser |
| 120 | ;; We fold over some test cases. Each case is a pair of the string to parse and the |
| 121 | ;; expected result. |
| 122 | (define (test-opam-syntax name pattern test-cases) |
| 123 | (test-assert name |
| 124 | (fold (lambda (test acc) |
| 125 | (display test) (newline) |
| 126 | (match test |
| 127 | ((str . expected) |
| 128 | (and acc |
| 129 | (let ((result (peg:tree (match-pattern pattern str)))) |
| 130 | (if (equal? result expected) |
| 131 | #t |
| 132 | (pk 'fail (list str result expected) #f))))))) |
| 133 | #t test-cases))) |
| 134 | |
| 135 | (test-opam-syntax |
| 136 | "parse-strings" string-pat |
| 137 | '(("" . #f) |
| 138 | ("\"hello\"" . (string-pat "hello")) |
| 139 | ("\"hello world\"" . (string-pat "hello world")) |
| 140 | ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\"")) |
| 141 | ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)")) |
| 142 | ("\"今日は\"" . (string-pat "今日は")))) |
| 143 | |
| 144 | (test-opam-syntax |
| 145 | "parse-multiline-strings" multiline-string |
| 146 | '(("" . #f) |
| 147 | ("\"\"\"hello\"\"\"" . (multiline-string "hello")) |
| 148 | ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!")) |
| 149 | ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!")))) |
| 150 | |
| 151 | (test-opam-syntax |
| 152 | "parse-lists" list-pat |
| 153 | '(("" . #f) |
| 154 | ("[]" . list-pat) |
| 155 | ("[make]" . (list-pat (var "make"))) |
| 156 | ("[\"make\"]" . (list-pat (string-pat "make"))) |
| 157 | ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c"))) |
| 158 | ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c"))) |
| 159 | ;; complex lists |
| 160 | ("[(a & b)]" . (list-pat (choice-pat (group-pat (var "a") (var "b"))))) |
| 161 | ("[(a | b & c)]" . (list-pat (choice-pat (var "a") (group-pat (var "b") (var "c"))))) |
| 162 | ("[a (b | c) d]" . (list-pat (var "a") (choice-pat (var "b") (var "c")) (var "d"))))) |
| 163 | |
| 164 | (test-opam-syntax |
| 165 | "parse-dicts" dict |
| 166 | '(("" . #f) |
| 167 | ("{}" . dict) |
| 168 | ("{a: \"b\"}" . (dict (record "a" (string-pat "b")))) |
| 169 | ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d")))))) |
| 170 | |
| 171 | (test-opam-syntax |
| 172 | "parse-conditions" condition |
| 173 | '(("" . #f) |
| 174 | ("{}" . #f) |
| 175 | ("{build}" . (condition-var "build")) |
| 176 | ("{>= \"0.2.0\"}" . (condition-greater-or-equal |
| 177 | (condition-string "0.2.0"))) |
| 178 | ("{>= \"0.2.0\" & test}" . (condition-and |
| 179 | (condition-greater-or-equal |
| 180 | (condition-string "0.2.0")) |
| 181 | (condition-var "test"))) |
| 182 | ("{>= \"0.2.0\" | build}" . (condition-or |
| 183 | (condition-greater-or-equal |
| 184 | (condition-string "0.2.0")) |
| 185 | (condition-var "build"))) |
| 186 | ("{ = \"1.0+beta19\" }" . (condition-eq |
| 187 | (condition-string "1.0+beta19"))))) |
| 188 | |
| 189 | (test-opam-syntax |
| 190 | "parse-comment" list-pat |
| 191 | '(("" . #f) |
| 192 | ("[#comment\n]" . list-pat))) |
| 193 | |
| 194 | (test-end "opam") |