diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/elpa.scm | 43 | ||||
| -rw-r--r-- | tests/glob.scm | 67 |
2 files changed, 64 insertions, 46 deletions
diff --git a/tests/elpa.scm b/tests/elpa.scm index 46c6ac2d75..44e3914f2e 100644 --- a/tests/elpa.scm +++ b/tests/elpa.scm @@ -81,24 +81,31 @@ information about package NAME. (Function 'elpa-package-info'.)" auctex-readme-mock url))) (_ #f))))) - (match (elpa->guix-package pkg) - (('package - ('name "emacs-auctex") - ('version "11.88.6") - ('source - ('origin - ('method 'url-fetch) - ('uri ('string-append - "http://elpa.gnu.org/packages/auctex-" 'version ".tar")) - ('sha256 ('base32 (? string? hash))))) - ('build-system 'emacs-build-system) - ('home-page "http://www.gnu.org/software/auctex/") - ('synopsis "Integrated environment for *TeX*") - ('description (? string?)) - ('license 'license:gpl3+)) - #t) - (x - (pk 'fail x #f))))) + (mock + ((guix build download) url-fetch + (lambda (url file . _) + (call-with-output-file file + (lambda (port) + (display "fake tarball" port))))) + + (match (elpa->guix-package pkg) + (('package + ('name "emacs-auctex") + ('version "11.88.6") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://elpa.gnu.org/packages/auctex-" 'version ".tar")) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'emacs-build-system) + ('home-page "http://www.gnu.org/software/auctex/") + ('synopsis "Integrated environment for *TeX*") + ('description (? string?)) + ('license 'license:gpl3+)) + #t) + (x + (pk 'fail x #f)))))) (test-assert "elpa->guix-package test 1" (eval-test-with-elpa "auctex")) diff --git a/tests/glob.scm b/tests/glob.scm index 033eeb10fe..3134069789 100644 --- a/tests/glob.scm +++ b/tests/glob.scm @@ -23,36 +23,47 @@ (test-begin "glob") -(test-equal "compile-glob-pattern, no wildcards" - "foo" - (compile-glob-pattern "foo")) +(define-syntax test-string->sglob + (syntax-rules (=>) + ((_ pattern => result rest ...) + (begin + (test-equal (format #f "string->sglob, ~s" pattern) + result + (string->sglob pattern)) + (test-string->sglob rest ...))) + ((_) + #t))) -(test-equal "compile-glob-pattern, Kleene star" - '("foo" * "bar") - (compile-glob-pattern "foo*bar")) +(define-syntax test-glob-match + (syntax-rules (matches and not) + ((_ (pattern-string matches strings ... (and not others ...)) rest ...) + (begin + (test-assert (format #f "glob-match? ~s" pattern-string) + (let ((pattern (string->compiled-sglob pattern-string))) + (and (glob-match? pattern strings) ... + (not (glob-match? pattern others)) ...))) + (test-glob-match rest ...))) + ((_) + #t))) -(test-equal "compile-glob-pattern, question mark" - '(? "foo" *) - (compile-glob-pattern "?foo*")) +(test-string->sglob + "foo" => "foo" + "?foo*" => '(? "foo" *) + "foo[1-5]" => '("foo" (range #\1 #\5)) + "foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar") + "foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar") + "[123]x" => '((set #\1 #\2 #\3) "x") + "[a-z]" => '((range #\a #\z))) -(test-assert "literal match" - (let ((pattern (compile-glob-pattern "foo"))) - (and (glob-match? pattern "foo") - (not (glob-match? pattern "foobar")) - (not (glob-match? pattern "barfoo"))))) - -(test-assert "trailing star" - (let ((pattern (compile-glob-pattern "foo*"))) - (and (glob-match? pattern "foo") - (glob-match? pattern "foobar") - (not (glob-match? pattern "xfoo"))))) - -(test-assert "question marks" - (let ((pattern (compile-glob-pattern "foo??bar"))) - (and (glob-match? pattern "fooxxbar") - (glob-match? pattern "fooZZbar") - (not (glob-match? pattern "foobar")) - (not (glob-match? pattern "fooxxxbar")) - (not (glob-match? pattern "fooxxbarzz"))))) +(test-glob-match + ("foo" matches "foo" (and not "foobar" "barfoo")) + ("foo*" matches "foo" "foobar" (and not "xfoo")) + ("foo??bar" matches "fooxxbar" "fooZZbar" + (and not "foobar" "fooxxxbar" "fooxxbarzz")) + ("foo?" matches "foox" (and not "fooxx")) + ("ab[0-9]c" matches "ab0c" "ab7c" "ab9c" + (and not "ab-c" "ab00c" "ab3")) + ("ab[cdefg]" matches "abc" "abd" "abg" + (and not "abh" "abcd" "ab["))) (test-end "glob") |