summaryrefslogtreecommitdiff
path: root/test/lisp/url
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/url')
-rw-r--r--test/lisp/url/url-auth-tests.el6
-rw-r--r--test/lisp/url/url-domsuf-tests.el51
-rw-r--r--test/lisp/url/url-expand-tests.el11
-rw-r--r--test/lisp/url/url-file-resources/file.txt1
-rw-r--r--test/lisp/url/url-file-tests.el44
-rw-r--r--test/lisp/url/url-future-tests.el26
-rw-r--r--test/lisp/url/url-handlers-tests.el76
-rw-r--r--test/lisp/url/url-misc-tests.el41
-rw-r--r--test/lisp/url/url-parse-tests.el6
-rw-r--r--test/lisp/url/url-tramp-tests.el91
-rw-r--r--test/lisp/url/url-util-tests.el36
11 files changed, 367 insertions, 22 deletions
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index e7aeb6e6164..fa6ecdce390 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -1,6 +1,6 @@
-;;; url-auth-tests.el --- Test suite for url-auth.
+;;; url-auth-tests.el --- Test suite for url-auth. -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
;; Author: Jarno Malmari <jarno@malmari.fi>
@@ -154,7 +154,7 @@ Essential is how realms and paths are matched."
auth)
(dolist (row (list
- ;; If :expected-user is `nil' it indicates
+ ;; If :expected-user is nil it indicates
;; authentication information shouldn't be found.
;; non-existent server
diff --git a/test/lisp/url/url-domsuf-tests.el b/test/lisp/url/url-domsuf-tests.el
new file mode 100644
index 00000000000..33962846820
--- /dev/null
+++ b/test/lisp/url/url-domsuf-tests.el
@@ -0,0 +1,51 @@
+;;; url-domsuf-tests.el --- Tests for url-domsuf.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-domsuf)
+(require 'ert)
+
+(defun url-domsuf-tests--run ()
+ (should-not (url-domsuf-cookie-allowed-p "com"))
+ (should (url-domsuf-cookie-allowed-p "foo.bar.bd"))
+ (should-not (url-domsuf-cookie-allowed-p "bar.bd"))
+ (should-not (url-domsuf-cookie-allowed-p "co.uk"))
+ (should (url-domsuf-cookie-allowed-p "foo.bar.hokkaido.jo"))
+ (should-not (url-domsuf-cookie-allowed-p "bar.yokohama.jp"))
+ (should (url-domsuf-cookie-allowed-p "city.yokohama.jp")))
+
+(ert-deftest url-domsuf-test-cookie-allowed-p ()
+ "Run the domsuf tests without need for parsing a file."
+ (let ((url-domsuf-domains '(("com")
+ ("bar.bd")
+ ("co.uk")
+ ("bar.yokohama.jp"))))
+ (url-domsuf-tests--run)))
+
+(ert-deftest url-domsuf-test-cookie-allowed-p/and-parse ()
+ "Run the domsuf tests, but also parse the file."
+ :tags '(:expensive-test)
+ (url-domsuf-tests--run))
+
+(provide 'url-domsuf-tests)
+
+;;; url-domsuf-tests.el ends here
diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el
index d147bddb3d3..a9695c6a192 100644
--- a/test/lisp/url/url-expand-tests.el
+++ b/test/lisp/url/url-expand-tests.el
@@ -1,6 +1,6 @@
-;;; url-expand-tests.el --- Test suite for relative URI/URL resolution.
+;;; url-expand-tests.el --- Test suite for relative URI/URL resolution. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Alain Schneble <a.s@realize.ch>
;; Version: 1.0
@@ -100,6 +100,13 @@
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "http://host/foo#bar"))
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar")))
+(ert-deftest url-expand-file-name/relative-resolution-file-url ()
+ "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples"
+ (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/foo.html") "file:///a/b/c/bar.html"))
+ (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/") "file:///a/b/c/bar.html"))
+ (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/") "file:///a/b/d/bar.html"))
+ (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/foo.html") "file:///a/b/d/bar.html")))
+
(provide 'url-expand-tests)
;;; url-expand-tests.el ends here
diff --git a/test/lisp/url/url-file-resources/file.txt b/test/lisp/url/url-file-resources/file.txt
new file mode 100644
index 00000000000..b0b4e38e5fd
--- /dev/null
+++ b/test/lisp/url/url-file-resources/file.txt
@@ -0,0 +1 @@
+Some file data
diff --git a/test/lisp/url/url-file-tests.el b/test/lisp/url/url-file-tests.el
new file mode 100644
index 00000000000..9fe3cb38ebb
--- /dev/null
+++ b/test/lisp/url/url-file-tests.el
@@ -0,0 +1,44 @@
+;;; url-file-tests.el --- Test suite for url-file. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-file)
+(require 'ert)
+(require 'ert-x)
+
+(ert-deftest url-file ()
+ "Test reading file via file:/// URL."
+ (let* ((file (ert-resource-file "file.txt"))
+ (uri-prefix (if (eq (aref file 0) ?/) "file://" "file:///")))
+ (should (equal
+ (with-current-buffer
+ (url-file (url-generic-parse-url (concat uri-prefix file))
+ #'ignore nil)
+ (prog1 (buffer-substring (point) (point-max))
+ (kill-buffer)))
+ (with-temp-buffer
+ (insert-file-contents-literally file)
+ (buffer-string))))))
+
+(provide 'url-file-tests)
+
+;;; url-file-tests.el ends here
diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el
index e7bcbd696a4..5083fc5abae 100644
--- a/test/lisp/url/url-future-tests.el
+++ b/test/lisp/url/url-future-tests.el
@@ -1,6 +1,6 @@
-;;; url-future-tests.el --- Test suite for url-future.
+;;; url-future-tests.el --- Test suite for url-future. -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2022 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -25,31 +25,33 @@
(require 'ert)
(require 'url-future)
+(defvar url-future-tests--saver)
+
(ert-deftest url-future-tests ()
- (let* (saver
+ (let* (url-future-tests--saver
(text "running future")
(good (make-url-future :value (lambda () (format text))
- :callback (lambda (f) (set 'saver f))))
+ :callback (lambda (f) (setq url-future-tests--saver f))))
(bad (make-url-future :value (lambda () (/ 1 0))
- :errorback (lambda (&rest d) (set 'saver d))))
+ :errorback (lambda (&rest d) (setq url-future-tests--saver d))))
(tocancel (make-url-future :value (lambda () (/ 1 0))
- :callback (lambda (f) (set 'saver f))
+ :callback (lambda (f) (setq url-future-tests--saver f))
:errorback (lambda (&rest d)
- (set 'saver d)))))
+ (setq url-future-tests--saver d)))))
(should (equal good (url-future-call good)))
- (should (equal good saver))
+ (should (equal good url-future-tests--saver))
(should (equal text (url-future-value good)))
(should (url-future-completed-p good))
(should-error (url-future-call good))
- (setq saver nil)
+ (setq url-future-tests--saver nil)
(should (equal bad (url-future-call bad)))
(should-error (url-future-call bad))
- (should (equal saver (list bad '(arith-error))))
+ (should (equal url-future-tests--saver (list bad '(arith-error))))
(should (url-future-errored-p bad))
- (setq saver nil)
+ (setq url-future-tests--saver nil)
(should (equal (url-future-cancel tocancel) tocancel))
(should-error (url-future-call tocancel))
- (should (null saver))
+ (should (null url-future-tests--saver))
(should (url-future-cancelled-p tocancel))))
(provide 'url-future-tests)
diff --git a/test/lisp/url/url-handlers-tests.el b/test/lisp/url/url-handlers-tests.el
new file mode 100644
index 00000000000..f43e9651f5e
--- /dev/null
+++ b/test/lisp/url/url-handlers-tests.el
@@ -0,0 +1,76 @@
+;;; url-handlers-tests.el --- Test suite for url-handlers.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'url-handlers)
+
+(defmacro with-url-handler-mode (&rest body)
+ "Evaluate BODY with `url-handler-mode' turned on."
+ (declare (indent 0) (debug t))
+ (let ((url-handler-mode-active (make-symbol "url-handler-mode-active")))
+ `(let ((,url-handler-mode-active url-handler-mode))
+ (unwind-protect
+ (progn
+ (unless ,url-handler-mode-active
+ (url-handler-mode))
+ ,@body)
+ (unless ,url-handler-mode-active
+ (url-handler-mode -1))))))
+
+(ert-deftest url-handlers-file-name-directory/preserve-url-types ()
+ (with-url-handler-mode
+ (should (equal (file-name-directory "https://gnu.org/index.html")
+ "https://gnu.org/"))
+ (should (equal (file-name-directory "http://gnu.org/index.html")
+ "http://gnu.org/"))
+ (should (equal (file-name-directory "ftp://gnu.org/index.html")
+ "ftp://gnu.org/"))))
+
+(ert-deftest url-handlers-file-name-directory/should-not-handle-non-url-file-names ()
+ (with-url-handler-mode
+ (should-not (equal (file-name-directory "not-uri://gnu.org")
+ "not-uri://gnu.org/"))))
+
+(ert-deftest url-handlers-file-name-directory/sub-directories ()
+ (with-url-handler-mode
+ (should (equal (file-name-directory "https://foo/bar/baz/index.html")
+ "https://foo/bar/baz/"))))
+
+(ert-deftest url-handlers-file-name-directory/file-urls ()
+ (with-url-handler-mode
+ (should (equal (file-name-directory "file:///foo/bar/baz.txt")
+ "file:///foo/bar/"))
+ (should (equal (file-name-directory "file:///")
+ "file:///"))))
+
+;; Regression test for bug#30444
+(ert-deftest url-handlers-file-name-directory/no-filename ()
+ (with-url-handler-mode
+ (should (equal (file-name-directory "https://foo.org")
+ "https://foo.org/"))
+ (should (equal (file-name-directory "https://foo.org/")
+ "https://foo.org/"))))
+
+;;; url-handlers-tests.el ends here
diff --git a/test/lisp/url/url-misc-tests.el b/test/lisp/url/url-misc-tests.el
new file mode 100644
index 00000000000..df561eb8887
--- /dev/null
+++ b/test/lisp/url/url-misc-tests.el
@@ -0,0 +1,41 @@
+;;; url-misc-tests.el --- Test suite for url-misc. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-misc)
+(require 'ert)
+
+(ert-deftest url-misc-data ()
+ "Test reading data: URL."
+ (should (equal
+ (with-current-buffer
+ (url-data (url-generic-parse-url "data:;,some%20text"))
+ (goto-char (point-min))
+ (forward-paragraph)
+ (forward-line)
+ (prog1 (buffer-substring (point) (point-max))
+ (kill-buffer)))
+ "some text")))
+
+(provide 'url-misc-tests)
+
+;;; url-misc-tests.el ends here
diff --git a/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el
index 56be313b776..c115da1e4ba 100644
--- a/test/lisp/url/url-parse-tests.el
+++ b/test/lisp/url/url-parse-tests.el
@@ -1,6 +1,6 @@
-;;; url-parse-tests.el --- Test suite for URI/URL parsing.
+;;; url-parse-tests.el --- Test suite for URI/URL parsing. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Alain Schneble <a.s@realize.ch>
;; Version: 1.0
@@ -23,7 +23,7 @@
;;; Commentary:
;; Test cases covering generic URI syntax as described in RFC3986,
-;; section 3. Syntax Components and 4. Usage. See also appendix
+;; section 3. Syntax Components and 4. Usage. See also appendix
;; A. Collected ABNF for URI, as the example given here are all
;; productions of this grammar.
diff --git a/test/lisp/url/url-tramp-tests.el b/test/lisp/url/url-tramp-tests.el
new file mode 100644
index 00000000000..369de0e2457
--- /dev/null
+++ b/test/lisp/url/url-tramp-tests.el
@@ -0,0 +1,91 @@
+;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017-2022 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'url-tramp)
+(require 'ert)
+
+(ert-deftest url-tramp-test-convert-url-to-tramp ()
+ "Test that URLs are converted into proper Tramp file names."
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "ftp://ftp.is.co.za/rfc/rfc1808.txt")
+ "/ftp:ftp.is.co.za:/rfc/rfc1808.txt"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "ssh://user@localhost")
+ "/ssh:user@localhost:"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "telnet://remotehost:42")
+ "/telnet:remotehost#42:"))
+
+ ;; The password will be added to the cache. The password cache key
+ ;; is the remote file name identification of the Tramp file.
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "scp://user:geheim@somewhere/localfile")
+ "/scp:user@somewhere:/localfile"))
+ (let ((key
+ (file-remote-p
+ (url-tramp-convert-url-to-tramp "scp://user@somewhere/localfile"))))
+ (should (password-in-cache-p key))
+ (should (string-equal (password-read-from-cache key) "geheim"))
+ (password-cache-remove key)
+ (should-not (password-in-cache-p key)))
+
+ ;; "http" does not belong to `url-tramp-protocols'. The string
+ ;; isn't changed, therefore.
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "http://www.gnu.org")
+ "http://www.gnu.org")))
+
+(ert-deftest url-tramp-test-convert-tramp-to-url ()
+ "Test that Tramp file names are converted into proper URLs."
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/ftp:ftp.is.co.za:/rfc/rfc1808.txt")
+ "ftp://ftp.is.co.za/rfc/rfc1808.txt"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/ssh:user@localhost:")
+ "ssh://user@localhost"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/telnet:user@remotehost#42:")
+ "telnet://user@remotehost:42"))
+
+ ;; "sftp" does not belong to `url-tramp-protocols'. The string
+ ;; isn't changed, therefore.
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/sftp:user@localhost:")
+ "/sftp:user@localhost:")))
+
+(provide 'url-tramp-tests)
+
+;;; url-tramp-tests.el ends here
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index 0d9ad9074d2..cfc2d93c890 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -1,6 +1,6 @@
-;;; url-util-tests.el --- Test suite for url-util.
+;;; url-util-tests.el --- Test suite for url-util. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -46,6 +46,38 @@
("key2" "val2")
("key1" "val1")))))
+(ert-deftest url-unhex-string-tests ()
+ (should (equal (url-unhex-string "foo%20bar")
+ "foo bar"))
+ (should (equal (decode-coding-string (url-unhex-string "Fran%C3%A7ois") 'utf-8)
+ "François"))
+ (should (equal (url-unhex-string "%20%21%23%24%25%26%27%28%29%2A")
+ " !#$%&'()*"))
+ (should (equal (url-unhex-string "%2B%2C%2F%3A%3B%3D%3F%40%5B%5D")
+ "+,/:;=?@[]")))
+
+(ert-deftest url-hexify-string-tests ()
+ (should (equal (url-hexify-string "foo bar")
+ "foo%20bar"))
+ (should (equal (url-hexify-string "François")
+ "Fran%C3%A7ois"))
+ (should (equal (url-hexify-string " !#$%&'()*")
+ "%20%21%23%24%25%26%27%28%29%2A"))
+ (should (equal (url-hexify-string "+,/:;=?@[]")
+ "%2B%2C%2F%3A%3B%3D%3F%40%5B%5D")))
+
+(ert-deftest url-domain-tests ()
+ (should (equal (url-domain (url-generic-parse-url "http://www.fsf.co.uk"))
+ "fsf.co.uk"))
+ (should (equal (url-domain (url-generic-parse-url "http://fsf.co.uk"))
+ "fsf.co.uk"))
+ (should (equal (url-domain (url-generic-parse-url "http://co.uk"))
+ nil))
+ (should (equal (url-domain (url-generic-parse-url "http://www.fsf.com"))
+ "fsf.com"))
+ (should (equal (url-domain (url-generic-parse-url "http://192.168.0.1"))
+ nil)))
+
(provide 'url-util-tests)
;;; url-util-tests.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-06 13:08:59 +0000