ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 14:16:55 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: opam: Factorize tests.

Browse source 
* tests/opam.scm: Remove duplicate code.
This commit is contained in:
Julien Lepiller 2020-10-02 00:16:10 +02:00
parent 1aa9f2cfde
commit ad05537e32
No known key found for this signature in database
GPG key ID: 53D457B2D636EE82
1 changed files with 58 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

130
tests/opam.scm
View file

@ -116,81 +116,67 @@ (define test-repo
;; Test the opam file parser ;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the ;; We fold over some test cases. Each case is a pair of the string to parse and the
;; expected result. ;; expected result.
(test-assert "parse-strings" (define (test-opam-syntax name pattern test-cases)
(fold (lambda (test acc) (test-assert name
(display test) (newline) (fold (lambda (test acc)
(and acc (display test) (newline)
(let ((result (peg:tree (match-pattern string-pat (car test))))) (match test
(if (equal? result (cdr test)) ((str . expected)
#t (and acc
(pk 'fail (list (car test) result (cdr test)) #f))))) (let ((result (peg:tree (match-pattern pattern str))))
#t '(("" . #f) (if (equal? result expected)
("\"hello\"" . (string-pat "hello")) #t
("\"hello world\"" . (string-pat "hello world")) (pk 'fail (list str result expected) #f)))))))
("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\"")) #t test-cases)))
("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
("\"今日は\"" . (string-pat "今日は")))))
(test-assert "parse-multiline-strings" (test-opam-syntax
(fold (lambda (test acc) "parse-strings" string-pat
(display test) (newline) '(("" . #f)
(and acc ("\"hello\"" . (string-pat "hello"))
(let ((result (peg:tree (match-pattern multiline-string (car test))))) ("\"hello world\"" . (string-pat "hello world"))
(if (equal? result (cdr test)) ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\""))
#t ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
(pk 'fail (list (car test) result (cdr test)) #f))))) ("\"今日は\"" . (string-pat "今日は"))))
#t '(("" . #f)
("\"\"\"hello\"\"\"" . (multiline-string "hello"))
("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!"))
("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!")))))
(test-assert "parse-lists" (test-opam-syntax
(fold (lambda (test acc) "parse-multiline-strings" multiline-string
(and acc '(("" . #f)
(let ((result (peg:tree (match-pattern list-pat (car test))))) ("\"\"\"hello\"\"\"" . (multiline-string "hello"))
(if (equal? result (cdr test)) ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!"))
#t ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!"))))
(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" (test-opam-syntax
(fold (lambda (test acc) "parse-lists" list-pat
(and acc '(("" . #f)
(let ((result (peg:tree (match-pattern dict (car test))))) ("[]" . list-pat)
(if (equal? result (cdr test)) ("[make]" . (list-pat (var "make")))
#t ("[\"make\"]" . (list-pat (string-pat "make")))
(pk 'fail (list (car test) result (cdr test)) #f))))) ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c")))
#t '(("" . #f) ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c")))))
("{}" . 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" (test-opam-syntax
(fold (lambda (test acc) "parse-dicts" dict
(and acc '(("" . #f)
(let ((result (peg:tree (match-pattern condition (car test))))) ("{}" . dict)
(if (equal? result (cdr test)) ("{a: \"b\"}" . (dict (record "a" (string-pat "b"))))
#t ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d"))))))
(pk 'fail (list (car test) result (cdr test)) #f)))))
#t '(("" . #f) (test-opam-syntax
("{}" . #f) "parse-conditions" condition
("{build}" . (condition-var "build")) '(("" . #f)
("{>= \"0.2.0\"}" . (condition-greater-or-equal ("{}" . #f)
(condition-string "0.2.0"))) ("{build}" . (condition-var "build"))
("{>= \"0.2.0\" & test}" . (condition-and ("{>= \"0.2.0\"}" . (condition-greater-or-equal
(condition-greater-or-equal (condition-string "0.2.0")))
(condition-string "0.2.0")) ("{>= \"0.2.0\" & test}" . (condition-and
(condition-var "test"))) (condition-greater-or-equal
("{>= \"0.2.0\" | build}" . (condition-or (condition-string "0.2.0"))
(condition-greater-or-equal (condition-var "test")))
(condition-string "0.2.0")) ("{>= \"0.2.0\" | build}" . (condition-or
(condition-var "build"))) (condition-greater-or-equal
("{ = \"1.0+beta19\" }" . (condition-eq (condition-string "0.2.0"))
(condition-string "1.0+beta19")))))) (condition-var "build")))
("{ = \"1.0+beta19\" }" . (condition-eq
(condition-string "1.0+beta19")))))
(test-end "opam") (test-end "opam")