summaryrefslogtreecommitdiff
path: root/test/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp')
-rw-r--r--test/lisp/emacs-lisp/icons-tests.el63
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el5
-rw-r--r--test/lisp/erc/erc-scenarios-misc.el39
-rw-r--r--test/lisp/erc/erc-tests.el82
-rw-r--r--test/lisp/erc/resources/dcc/chat/accept-dcc.eld3
-rw-r--r--test/lisp/erc/resources/dcc/chat/accept.eld23
-rw-r--r--test/lisp/erc/resources/erc-d/erc-d-tests.el27
-rw-r--r--test/lisp/erc/resources/erc-d/erc-d.el68
-rw-r--r--test/lisp/erc/resources/erc-d/resources/foreign.eld5
-rw-r--r--test/lisp/ffap-tests.el24
-rw-r--r--test/lisp/help-fns-tests.el6
-rw-r--r--test/lisp/international/ccl-tests.el36
-rw-r--r--test/lisp/misc-tests.el38
-rw-r--r--test/lisp/net/shr-tests.el15
-rw-r--r--test/lisp/net/tramp-archive-tests.el2
-rw-r--r--test/lisp/net/tramp-tests.el15
-rw-r--r--test/lisp/progmodes/python-tests.el55
-rw-r--r--test/lisp/subr-tests.el31
-rw-r--r--test/lisp/x-dnd-tests.el9
19 files changed, 488 insertions, 58 deletions
diff --git a/test/lisp/emacs-lisp/icons-tests.el b/test/lisp/emacs-lisp/icons-tests.el
new file mode 100644
index 00000000000..e6e71a8e4fd
--- /dev/null
+++ b/test/lisp/emacs-lisp/icons-tests.el
@@ -0,0 +1,63 @@
+;;; icons-tests.el --- Tests for icons.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 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 'icons)
+(require 'ert)
+(require 'ert-x)
+(require 'cus-edit)
+
+(define-icon icon-test1 nil
+ '((symbol ">")
+ (text "great"))
+ "Test icon"
+ :version "29.1")
+
+(define-icon icon-test2 icon-test1
+ '((text "child"))
+ "Test icon"
+ :version "29.1")
+
+(deftheme test-icons-theme "")
+
+(ert-deftest test-icon-theme ()
+ (let ((icon-preference '(image emoji symbol text)))
+ (should (equal (icon-string 'icon-test1) ">")))
+ (let ((icon-preference '(text)))
+ (should (equal (icon-string 'icon-test1) "great")))
+ (custom-theme-set-icons
+ 'test-icons-theme
+ '(icon-test1 ((symbol "<") (text "less"))))
+ (let ((icon-preference '(image emoji symbol text)))
+ (should (equal (icon-string 'icon-test1) ">"))
+ (enable-theme 'test-icons-theme)
+ (should (equal (icon-string 'icon-test1) "<"))))
+
+(ert-deftest test-icon-inheretance ()
+ (let ((icon-preference '(image emoji symbol text)))
+ (should (equal (icon-string 'icon-test2) ">")))
+ (let ((icon-preference '(text)))
+ (should (equal (icon-string 'icon-test2) "child"))))
+
+;;; icons-tests.el ends here
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 99c0e822155..7a3efe9db62 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -766,5 +766,10 @@
(should (equal (sort (hash-table-keys h) #'string<) '(a b c)))
(should (equal (sort (hash-table-values h) #'<) '(1 2 3)))))
+(ert-deftest test-string-truncate-left ()
+ (should (equal (string-truncate-left "band" 3) "...d"))
+ (should (equal (string-truncate-left "band" 2) "...d"))
+ (should (equal (string-truncate-left "longstring" 8) "...tring")))
+
(provide 'subr-x-tests)
;;; subr-x-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el
index 9d6d5bc1d6a..ded620ccc1d 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -138,4 +138,43 @@
(should-not (get-buffer "$*"))))
+(ert-deftest erc-scenarios-dcc-chat-accept ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "dcc/chat")
+ (dcc-server (erc-d-run "127.0.0.1" t "erc-dcc-server" 'accept-dcc
+ :ending "\n"))
+ (dcc-port (process-contact dcc-server :service))
+ (dumb-server (erc-d-run "localhost" t 'accept :tmpl-vars
+ `((port . ,(number-to-string dcc-port)))))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (ert-info ("Offer received")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "DCC: chat offered by dummy")
+ (erc-cmd-DCC "CHAT" "dummy")))
+
+ ;; Regression
+ (erc-d-t-ensure-for 1 (not (get-buffer "tester")))
+
+ ;; Becomes current buffer by default (because `erc-join-buffer')
+ (erc-d-t-wait-for 10 (get-buffer "DCC-CHAT-dummy"))
+
+ (with-current-buffer "foonet"
+ (funcall expect 10 "*** DCC: accepting chat from dummy"))
+
+ (ert-info ("Chat with dummy")
+ (with-current-buffer "DCC-CHAT-dummy"
+ (erc-scenarios-common-say "Hi")
+ (funcall expect 10 "Hola")))))
+
;;; erc-scenarios-misc.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4971d0e194f..0f222edacfa 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -893,4 +893,86 @@
(should-not calls))))))
+;; Note: if adding an erc-backend-tests.el, please relocate this there.
+
+(ert-deftest erc-message ()
+ (should-not erc-server-last-peers)
+ (let (server-proc
+ calls
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (cl-letf (((symbol-function 'erc-display-message)
+ (lambda (_ _ _ line) (push line calls)))
+ ((symbol-function 'erc-server-send)
+ (lambda (line _) (push line calls)))
+ ((symbol-function 'erc-server-buffer)
+ (lambda () (process-buffer server-proc))))
+ (with-current-buffer (get-buffer-create "ExampleNet")
+ (erc-mode)
+ (setq erc-server-current-nick "tester"
+ server-proc (start-process "sleep" (current-buffer) "sleep" "1")
+ erc-server-process server-proc
+ erc-server-last-peers (cons nil nil)
+ erc-server-users (make-hash-table :test 'equal)
+ erc-network 'ExampleNet)
+ (set-process-query-on-exit-flag erc-server-process nil))
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "ExampleNet"))
+ erc-default-recipients '("#chan")
+ erc-channel-users (make-hash-table :test 'equal)
+ erc-network 'ExampleNet)
+ (erc-update-current-channel-member "alice" "alice")
+ (erc-update-current-channel-member "tester" "tester"))
+
+ (with-current-buffer "ExampleNet"
+ (erc-server-PRIVMSG erc-server-process
+ (make-erc-response
+ :sender "alice!~u@fsf.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "hi")
+ :unparsed ":alice!~u@fsf.org PRIVMSG #chan :hi"))
+ (should (equal erc-server-last-peers '("alice")))
+ (should (string-match "<alice>" (pop calls))))
+
+ (with-current-buffer "#chan"
+ (ert-info ("Shortcuts usable in target buffers")
+ (should-not (local-variable-p 'erc-server-last-peers))
+ (should-not erc-server-last-peers)
+ (erc-message "PRIVMSG" ". hi")
+ (should-not erc-server-last-peers)
+ (should (eq 'no-target (pop calls)))
+ (erc-message "PRIVMSG" ", hi")
+ (should-not erc-server-last-peers)
+ (should (string-match "alice :hi" (pop calls)))))
+
+ (with-current-buffer "ExampleNet"
+ (ert-info ("Shortcuts local in server bufs")
+ (should (equal erc-server-last-peers '("alice" . "alice")))
+ (erc-message "PRIVMSG" ", hi")
+ (should (equal erc-server-last-peers '("alice" . "alice")))
+ (should (string-match "PRIVMSG alice :hi" (pop calls)))
+ (setcdr erc-server-last-peers "bob")
+ (erc-message "PRIVMSG" ". hi")
+ (should (equal erc-server-last-peers '("alice" . "bob")))
+ (should (string-match "PRIVMSG bob :hi" (pop calls)))))
+
+ (with-current-buffer "#chan"
+ (ert-info ("Non-shortcuts are local to server buffer")
+ (should-not (local-variable-p 'erc-server-last-peers))
+ (should-not erc-server-last-peers)
+ (erc-message "PRIVMSG" "#chan hola")
+ (should-not erc-server-last-peers)
+ (should-not (default-value 'erc-server-last-peers))
+ (should (equal (buffer-local-value 'erc-server-last-peers
+ (get-buffer "ExampleNet"))
+ '("alice" . "#chan")))
+ (should (string-match "hola" (pop calls))))))
+
+ (should-not erc-server-last-peers)
+ (should-not calls)
+ (kill-buffer "ExampleNet")
+ (kill-buffer "#chan")))
+
;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/dcc/chat/accept-dcc.eld b/test/lisp/erc/resources/dcc/chat/accept-dcc.eld
new file mode 100644
index 00000000000..23828a8115e
--- /dev/null
+++ b/test/lisp/erc/resources/dcc/chat/accept-dcc.eld
@@ -0,0 +1,3 @@
+;; -*- mode: lisp-data; -*-
+((open 10 "Hi")
+ (0 "Hola"))
diff --git a/test/lisp/erc/resources/dcc/chat/accept.eld b/test/lisp/erc/resources/dcc/chat/accept.eld
new file mode 100644
index 00000000000..a23e9580bcc
--- /dev/null
+++ b/test/lisp/erc/resources/dcc/chat/accept.eld
@@ -0,0 +1,23 @@
+;; -*- mode: lisp-data; -*-
+((pass 1 "PASS :changeme"))
+((nick 1 "NICK tester"))
+((user 1 "USER user 0 * :tester")
+ (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.foonet.org 003 tester :This server was created Mon, 31 May 2021 09:56:24 UTC")
+ (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
+ (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
+ (0 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
+ (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.foonet.org 254 tester 2 :channels formed")
+ (0 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
+ (0 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
+ (0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
+ (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ ;; No mode answer
+ (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
+ (0.2 ":dummy!~u@34n9brushbpj2.irc PRIVMSG tester :\C-aDCC CHAT chat 2130706433 " port "\C-a"))
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index 21005cd7600..357bc48b088 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -1343,4 +1343,31 @@ DIALOGS are symbols representing the base names of dialog files in
(kill-buffer dumb-server-buffer)))
(delete-file sock))))
+(ert-deftest erc-d-run-direct-foreign-protocol ()
+ :tags '(:expensive-test)
+ (let* ((server (erc-d-run "localhost" t "erc-d-server" 'foreign
+ :ending "\n"))
+ (server-buffer (get-buffer "*erc-d-server*"))
+ (client-buffer (get-buffer-create "*erc-d-client*"))
+ client)
+ (with-current-buffer server-buffer (erc-d-t-search-for 4 "Starting"))
+ (setq client (make-network-process
+ :buffer client-buffer
+ :name "erc-d-client"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service (process-contact server :service)
+ :host "localhost"))
+ (process-send-string client "ONE one\n")
+ (with-current-buffer client-buffer
+ (erc-d-t-search-for 5 "echo ONE one"))
+ (process-send-string client "TWO two\n")
+ (with-current-buffer client-buffer
+ (erc-d-t-search-for 2 "echo TWO two"))
+ (erc-d-t-wait-for 2 "server death" (not (process-live-p server)))
+ (when noninteractive
+ (kill-buffer client-buffer)
+ (kill-buffer server-buffer))))
+
;;; erc-d-tests.el ends here
diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el
index ee9b6a7fec9..d6082227c52 100644
--- a/test/lisp/erc/resources/erc-d/erc-d.el
+++ b/test/lisp/erc/resources/erc-d/erc-d.el
@@ -136,6 +136,9 @@ Only relevant when starting a server with `erc-d-run'.")
Possibly used by overriding handlers, like the one for PING, and/or
dialog templates for the sender portion of a reply message.")
+(defvar erc-d-line-ending "\r\n"
+ "Protocol line delimiter for sending and receiving.")
+
(defvar erc-d-linger-secs nil
"Seconds to wait before quitting for all dialogs.
For more granular control, use the provided LINGER `rx' variable (alone)
@@ -249,6 +252,7 @@ return a replacement.")
(mat-h (copy-sequence (process-get process :dialog-match-handlers)))
(fqdn (copy-sequence (process-get process :dialog-server-fqdn)))
(vars (copy-sequence (process-get process :dialog-vars)))
+ (ending (process-get process :dialog-ending))
(dialog (make-erc-d-dialog :name name
:process process
:queue (make-ring 5)
@@ -263,6 +267,8 @@ return a replacement.")
(erc-d-dialog-hunks dialog) reader)
;; Add reverse link, register client, launch
(process-put process :dialog dialog)
+ (process-put process :ending ending)
+ (process-put process :ending-regexp (rx-to-string `(+ ,ending)))
(push process erc-d--clients)
(erc-d--command-refresh dialog nil)
(erc-d--on-request process)))
@@ -311,7 +317,7 @@ PROCESS should be a client connection or a server network process."
(name (erc-d-dialog-name (process-get ,process :dialog))))
(if ,outbound
(erc-d--m process "-> %s:%s %s" name id ,string)
- (dolist (line (split-string ,string "\r\n"))
+ (dolist (line (split-string ,string (process-get process :ending)))
(erc-d--m process "<- %s:%s %s" name id line)))))
(defun erc-d--log-process-event (server process msg)
@@ -320,7 +326,7 @@ PROCESS should be a client connection or a server network process."
(defun erc-d--send (process string)
"Send STRING to PROCESS peer."
(erc-d--log process string 'outbound)
- (process-send-string process (concat string "\r\n")))
+ (process-send-string process (concat string (process-get process :ending))))
(define-inline erc-d--fuzzy-p (exchange)
(inline-letevals (exchange)
@@ -442,9 +448,10 @@ This will start the teardown for DIALOG."
"Handle input received from peer.
PROCESS represents a client peer connection and STRING is a raw request
including line delimiters."
- (let ((queue (erc-d-dialog-queue (process-get process :dialog))))
+ (let ((queue (erc-d-dialog-queue (process-get process :dialog)))
+ (delim (process-get process :ending-regexp)))
(setq string (concat (process-get process :stashed-input) string))
- (while (and string (string-match (rx (+ "\r\n")) string))
+ (while (and string (string-match delim string))
(let ((line (substring string 0 (match-beginning 0))))
(setq string (unless (= (match-end 0) (length string))
(substring string (match-end 0))))
@@ -913,35 +920,40 @@ Pass HOST and SERVICE directly to `make-network-process'. When present,
use string SERVER-NAME for the server-process name as well as that of
its buffer (w. surrounding asterisks). When absent, do the same with
`erc-d-server-name'. When running \"in process,\" return the server
-process, otherwise sleep for the duration of the server process.
+process; otherwise sleep until it dies.
A dialog must be a symbol matching the base name of a dialog file in
-`erc-d-u-canned-dialog-dir'.
-
-The variable `erc-d-tmpl-vars' determines the common members of the
-`erc-d--render-entries' ENTRIES param. Variables `erc-d-server-fqdn'
-and `erc-d-linger-secs' determine the `erc-d-dialog' items
-`:server-fqdn' and `:linger-secs' for all client processes.
-
-The variable `erc-d-tmpl-vars' can be used to initialize the
-process's `erc-d-dialog' vars item."
+`erc-d-u-canned-dialog-dir'. Global variables `erc-d-server-fqdn',
+`erc-d-linger-secs', and `erc-d-tmpl-vars' determine the process's
+`erc-d-dialog' fields `:server-fqdn', `:linger-secs', and `:vars',
+respectively. The latter may also be populated via keyword pairs
+appearing among DIALOGS."
(when (and server-name (symbolp server-name))
(push server-name dialogs)
(setq server-name nil))
- (let (loaded)
- (dolist (dialog (nreverse dialogs))
- (let ((reader (erc-d-u--canned-load-dialog dialog)))
- (when erc-d--slow-mo
- (setq reader (erc-d-u--rewrite-for-slow-mo erc-d--slow-mo reader)))
- (push (cons (erc-d-u--normalize-canned-name dialog) reader) loaded)))
- (setq dialogs loaded))
- (erc-d--start host service (or server-name erc-d-server-name)
- :dialog-dialogs dialogs
- :dialog-vars erc-d-tmpl-vars
- :dialog-linger-secs erc-d-linger-secs
- :dialog-server-fqdn erc-d-server-fqdn
- :dialog-match-handlers (erc-d-u--unkeyword
- erc-d-match-handlers)))
+ (let (loaded kwds defaults args)
+ (while dialogs
+ (if-let* ((dlog (pop dialogs))
+ ((keywordp dlog)))
+ (progn (push (pop dialogs) kwds) (push dlog kwds))
+ (let ((reader (erc-d-u--canned-load-dialog dlog)))
+ (when erc-d--slow-mo
+ (setq reader (erc-d-u--rewrite-for-slow-mo erc-d--slow-mo reader)))
+ (push (cons (erc-d-u--normalize-canned-name dlog) reader) loaded))))
+ (setq kwds (erc-d-u--unkeyword kwds)
+ defaults `((ending . ,erc-d-line-ending)
+ (server-fqdn . ,erc-d-server-fqdn)
+ (linger-secs . ,erc-d-linger-secs)
+ (vars . ,(or (plist-get kwds 'tmpl-vars) erc-d-tmpl-vars))
+ (dialogs . ,(nreverse loaded)))
+ args (list :dialog-match-handlers
+ (erc-d-u--unkeyword (or (plist-get kwds 'match-handlers)
+ erc-d-match-handlers))))
+ (pcase-dolist (`(,var . ,def) defaults)
+ (push (or (plist-get kwds var) def) args)
+ (push (intern (format ":dialog-%s" var)) args))
+ (apply #'erc-d--start host service (or server-name erc-d-server-name)
+ args)))
(defun erc-d-serve ()
"Start serving canned dialogs from the command line.
diff --git a/test/lisp/erc/resources/erc-d/resources/foreign.eld b/test/lisp/erc/resources/erc-d/resources/foreign.eld
new file mode 100644
index 00000000000..64a5dca8b10
--- /dev/null
+++ b/test/lisp/erc/resources/erc-d/resources/foreign.eld
@@ -0,0 +1,5 @@
+;;; -*- mode: lisp-data -*-
+((one 5 "ONE one")
+ (0 "echo ONE one"))
+((two 5 "TWO two")
+ (0 "echo TWO two"))
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 4b580b5af52..076d8256421 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -28,6 +28,30 @@
(require 'ert-x)
(require 'ffap)
+(ert-deftest ffap-replace-file-component ()
+ (should (equal
+ (ffap-replace-file-component "/ftp:who@foo.com:/whatever" "/new")
+ "/ftp:who@foo.com:/new")))
+
+(ert-deftest ffap-file-remote-p ()
+ (dolist (test '(("/user@foo.bar.com:/pub" .
+ "/user@foo.bar.com:/pub")
+ ("/cssun.mathcs.emory.edu://dir" .
+ "/cssun.mathcs.emory.edu:/dir")
+ ("/ffap.el:80" .
+ "/ffap.el:80")))
+ (let ((A (car test))
+ (B (cdr test)))
+ (should (equal (ffap-file-remote-p A) B)))))
+
+(ert-deftest ffap-machine-p ()
+ (should-not (ffap-machine-p "ftp"))
+ (should-not (ffap-machine-p "nonesuch"))
+ (should (eq (ffap-machine-p "ftp.mathcs.emory.edu") 'accept))
+ (should-not (ffap-machine-p "mathcs" 5678))
+ (should-not (ffap-machine-p "foo.bonk"))
+ (should (eq (ffap-machine-p "foo.bonk.com") 'accept)))
+
(ert-deftest ffap-tests-25243 ()
"Test for https://debbugs.gnu.org/25243 ."
(ert-with-temp-file file
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index e3fed60b4cb..7ff7aa1ccd7 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -64,13 +64,13 @@ Return first line of the output of (describe-function-1 FUNC)."
(ert-deftest help-fns-test-lisp-defun ()
(let ((regexp (if (featurep 'native-compile)
- "a native compiled Lisp function in .+subr\\.el"
- "a compiled Lisp function in .+subr\\.el"))
+ "a native-compiled Lisp function in .+subr\\.el"
+ "a byte-compiled Lisp function in .+subr\\.el"))
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defsubst ()
- (let ((regexp "a compiled Lisp function in .+subr\\.el")
+ (let ((regexp "a byte-compiled Lisp function in .+subr\\.el")
(result (help-fns-tests--describe-function 'posn-window)))
(should (string-match regexp result))))
diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el
index 57ac74639b1..cf472415c7a 100644
--- a/test/lisp/international/ccl-tests.el
+++ b/test/lisp/international/ccl-tests.el
@@ -25,23 +25,25 @@
(ert-deftest shift ()
- ;; shift left +ve 5628 #x00000000000015fc
- (should (= (ash 5628 8) 1440768)) ; #x000000000015fc00
- (should (= (lsh 5628 8) 1440768)) ; #x000000000015fc00
-
- ;; shift left -ve -5628 #x3fffffffffffea04
- (should (= (ash -5628 8) -1440768)) ; #x3fffffffffea0400
- (should (= (lsh -5628 8) -1440768)) ; #x3fffffffffea0400
-
- ;; shift right +ve 5628 #x00000000000015fc
- (should (= (ash 5628 -8) 21)) ; #x0000000000000015
- (should (= (lsh 5628 -8) 21)) ; #x0000000000000015
-
- ;; shift right -ve -5628 #x3fffffffffffea04
- (should (= (ash -5628 -8) -22)) ; #x3fffffffffffffea
- (should (= (lsh -5628 -8)
- (ash (- -5628 (ash most-negative-fixnum 1)) -8)
- (ash (logand (ash -5628 -1) most-positive-fixnum) -7))))
+ (with-suppressed-warnings ((suspicious lsh))
+
+ ;; shift left +ve 5628 #x00000000000015fc
+ (should (= (ash 5628 8) 1440768)) ; #x000000000015fc00
+ (should (= (lsh 5628 8) 1440768)) ; #x000000000015fc00
+
+ ;; shift left -ve -5628 #x3fffffffffffea04
+ (should (= (ash -5628 8) -1440768)) ; #x3fffffffffea0400
+ (should (= (lsh -5628 8) -1440768)) ; #x3fffffffffea0400
+
+ ;; shift right +ve 5628 #x00000000000015fc
+ (should (= (ash 5628 -8) 21)) ; #x0000000000000015
+ (should (= (lsh 5628 -8) 21)) ; #x0000000000000015
+
+ ;; shift right -ve -5628 #x3fffffffffffea04
+ (should (= (ash -5628 -8) -22)) ; #x3fffffffffffffea
+ (should (= (lsh -5628 -8)
+ (ash (- -5628 (ash most-negative-fixnum 1)) -8)
+ (ash (logand (ash -5628 -1) most-positive-fixnum) -7)))))
;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el
(defconst prog-pgg-source
diff --git a/test/lisp/misc-tests.el b/test/lisp/misc-tests.el
index a56feaa0495..f84827ab025 100644
--- a/test/lisp/misc-tests.el
+++ b/test/lisp/misc-tests.el
@@ -96,5 +96,43 @@
(should (equal (buffer-string) "abc\nabc\n"))
(should (equal (point) 2))))
+(require 'rect)
+
+(ert-deftest misc--duplicate-dwim ()
+ ;; Duplicate a line.
+ (with-temp-buffer
+ (insert "abc\ndefg\nh\n")
+ (goto-char 7)
+ (duplicate-dwim 2)
+ (should (equal (buffer-string) "abc\ndefg\ndefg\ndefg\nh\n"))
+ (should (equal (point) 7)))
+
+ ;; Duplicate a region.
+ (with-temp-buffer
+ (insert "abc\ndef\n")
+ (set-mark 2)
+ (goto-char 7)
+ (transient-mark-mode)
+ (should (use-region-p))
+ (duplicate-dwim)
+ (should (equal (buffer-string) "abc\ndebc\ndef\n"))
+ (should (equal (point) 7))
+ (should (region-active-p))
+ (should (equal (mark) 2)))
+
+ ;; Duplicate a rectangular region.
+ (with-temp-buffer
+ (insert "x\n>a\n>bcde\n>fg\nyz\n")
+ (goto-char 4)
+ (rectangle-mark-mode)
+ (goto-char 15)
+ (rectangle-forward-char 1)
+ (duplicate-dwim)
+ (should (equal (buffer-string) "x\n>a a \n>bcdbcde\n>fg fg \nyz\n"))
+ (should (equal (point) 24))
+ (should (region-active-p))
+ (should rectangle-mark-mode)
+ (should (equal (mark) 4))))
+
(provide 'misc-tests)
;;; misc-tests.el ends here
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 821ca5ca636..2254f9bc860 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -67,6 +67,21 @@
(should-not
(shr--use-cookies-p "http://www.gnu.org" '("http://www.fsf.org")))))
+(ert-deftest shr-srcset ()
+ (should (equal (shr--parse-srcset "") nil))
+
+ (should (equal (shr--parse-srcset "a 10w, b 20w")
+ '(("b" 20) ("a" 10))))
+
+ (should (equal (shr--parse-srcset "a 10w b 20w")
+ '(("a" 10))))
+
+ (should (equal (shr--parse-srcset "https://example.org/1\n\n 10w , https://example.org/2 20w ")
+ '(("https://example.org/2" 20) ("https://example.org/1" 10))))
+
+ (should (equal (shr--parse-srcset "https://example.org/1,2\n\n 10w , https://example.org/2 20w ")
+ '(("https://example.org/2" 20) ("https://example.org/1,2" 10)))))
+
(require 'shr)
;;; shr-tests.el ends here
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 54d1ecf3652..f51037aabb4 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -31,7 +31,6 @@
(require 'ert)
(require 'ert-x)
(require 'tramp-archive)
-(defvar tramp-copy-size-limit)
(defvar tramp-persistency-file-name)
;; `ert-resource-file' was introduced in Emacs 28.1.
@@ -96,7 +95,6 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs."
(setq password-cache-expiry nil
tramp-cache-read-persistent-data t ;; For auth-sources.
- tramp-copy-size-limit nil
tramp-persistency-file-name nil
tramp-verbose 0)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 55a6feba9b7..5a8d9100e18 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -201,6 +201,14 @@ being the result.")
(file-writable-p ert-remote-temporary-file-directory))))))
(when (cdr tramp--test-enabled-checked)
+ ;; Remove old test files.
+ (dolist (dir `(,temporary-file-directory
+ ,ert-remote-temporary-file-directory))
+ (dolist (file (directory-files dir 'full "\\`\\(\\.#\\)?tramp-test"))
+ (ignore-errors
+ (if (file-directory-p file)
+ (delete-directory file 'recursive)
+ (delete-file file)))))
;; Cleanup connection.
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
@@ -4078,10 +4086,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
;; Cleanup.
- (ignore-errors
- (delete-file tmp-name2)
- (delete-file tmp-name3)
- (delete-directory tmp-name1 'recursive)))
+ (ignore-errors (delete-file tmp-name2))
+ (ignore-errors (delete-file tmp-name3))
+ (ignore-errors (delete-directory tmp-name1 'recursive)))
;; Detect cyclic symbolic links.
(unwind-protect
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index b2cccdd9569..6f2ad87f81a 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1122,6 +1122,35 @@ if save:
(python-indent-line t)
(should (= (python-indent-calculate-indentation t) 8))))
+(ert-deftest python-indent-dedenters-comment-else ()
+ "Test de-indentation for the else keyword with comments before it."
+ (python-tests-with-temp-buffer
+ "
+if save:
+ try:
+ write_to_disk(data)
+ except IOError:
+ msg = 'Error saving to disk'
+ message(msg)
+ logger.exception(msg)
+ except Exception:
+ if hide_details:
+ logger.exception('Unhandled exception')
+ # comment
+ else
+ finally:
+ data.free()
+"
+ (python-tests-look-at "else\n")
+ (should (eq (car (python-indent-context)) :at-dedenter-block-start))
+ (should (= (python-indent-calculate-indentation) 8))
+ (python-indent-line t)
+ (should (= (python-indent-calculate-indentation t) 4))
+ (python-indent-line t)
+ (should (= (python-indent-calculate-indentation t) 0))
+ (python-indent-line t)
+ (should (= (python-indent-calculate-indentation t) 8))))
+
(ert-deftest python-indent-dedenters-3 ()
"Test de-indentation for the except keyword."
(python-tests-with-temp-buffer
@@ -1995,6 +2024,32 @@ def c():
(beginning-of-line)
(point))))))
+(ert-deftest python-nav-beginning-of-defun-5 ()
+ (python-tests-with-temp-buffer
+ "
+class C:
+
+ def \\
+ m(self):
+ pass
+"
+ (python-tests-look-at "m(self):")
+ (should (= (save-excursion
+ (python-nav-beginning-of-defun)
+ (point))
+ (save-excursion
+ (python-tests-look-at "def \\" -1)
+ (beginning-of-line)
+ (point))))
+ (python-tests-look-at "class C:" -1)
+ (should (= (save-excursion
+ (python-nav-beginning-of-defun -1)
+ (point))
+ (save-excursion
+ (python-tests-look-at "def \\")
+ (beginning-of-line)
+ (point))))))
+
(ert-deftest python-nav-end-of-defun-1 ()
(python-tests-with-temp-buffer
"
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index f5c1c40263e..be613ce7595 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -368,6 +368,17 @@
2)))
(ert-deftest string-comparison-test ()
+ (should (string-equal-ignore-case "abc" "abc"))
+ (should (string-equal-ignore-case "abc" "ABC"))
+ (should (string-equal-ignore-case "abc" "abC"))
+ (should-not (string-equal-ignore-case "abc" "abCD"))
+ (should (string-equal-ignore-case "S" "s"))
+ (should (string-equal-ignore-case "ẞ" "ß"))
+ (should (string-equal-ignore-case "Dz" "DZ"))
+ (should (string-equal-ignore-case "Όσος" "ΌΣΟΣ"))
+ ;; not yet: (should (string-equal-ignore-case "SS" "ß"))
+ ;; not yet: (should (string-equal-ignore-case "SS" "ẞ"))
+
(should (string-lessp "abc" "acb"))
(should (string-lessp "aBc" "abc"))
(should (string-lessp "abc" "abcd"))
@@ -1026,7 +1037,15 @@ final or penultimate step during initialization."))
(ert-deftest test-readablep ()
(should (readablep "foo"))
- (should-not (readablep (list (make-marker)))))
+ (should-not (readablep (list (make-marker))))
+ (should-not (readablep (make-marker))))
+
+(ert-deftest test-print-unreadable-function ()
+ ;; Check that problem with unwinding properly is fixed (bug#56773).
+ (with-temp-buffer
+ (let ((buf (current-buffer)))
+ (readablep (make-marker))
+ (should (eq buf (current-buffer))))))
(ert-deftest test-string-lines ()
(should (equal (string-lines "") '("")))
@@ -1107,5 +1126,15 @@ final or penultimate step during initialization."))
(should (equal (butlast l n)
(subr-tests--butlast-ref l n))))))
+(ert-deftest test-print-unreadable-function-buffer ()
+ (with-temp-buffer
+ (let ((current (current-buffer))
+ callback-buffer)
+ (let ((print-unreadable-function
+ (lambda (_object _escape)
+ (setq callback-buffer (current-buffer)))))
+ (prin1-to-string (make-marker)))
+ (should (eq current callback-buffer)))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/x-dnd-tests.el b/test/lisp/x-dnd-tests.el
index 8856be79ebc..55994e9b724 100644
--- a/test/lisp/x-dnd-tests.el
+++ b/test/lisp/x-dnd-tests.el
@@ -90,6 +90,8 @@ AgAABQMAAAYDAAATGwAAGhsAAA==")
;;; XDS tests.
+(defvar x-dnd-xds-testing)
+
(defvar x-dnd-tests-xds-target-dir nil
"The name of the target directory where the file will be saved.")
@@ -122,8 +124,8 @@ Return the result of the selection."
(format "file://%s%s" (system-name)
(expand-file-name x-dnd-tests-xds-property-value
x-dnd-tests-xds-target-dir))
- (concat "file:///" (expand-file-name x-dnd-tests-xds-property-value
- x-dnd-tests-xds-target-dir)))))
+ (concat "file://" (expand-file-name x-dnd-tests-xds-property-value
+ x-dnd-tests-xds-target-dir)))))
(setq x-dnd-tests-xds-property-value
(encode-coding-string (url-encode-url uri)
'raw-text)))
@@ -162,7 +164,8 @@ hostname in the target URI."
(original-file (expand-file-name
(make-temp-name "x-dnd-test")
temporary-file-directory))
- (x-dnd-tests-xds-name (make-temp-name "x-dnd-test-target")))
+ (x-dnd-tests-xds-name (make-temp-name "x-dnd-test-target"))
+ (x-dnd-xds-testing t))
;; The call to `gui-set-selection' is only used for providing the
;; conventional `text/uri-list' target and can be ignored.
(cl-flet ((gui-set-selection #'ignore))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 05:29:50 +0000