tests: opam: Factorize tests.

* 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

View file

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