Merge branch 'master' into core-updates

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")