masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-09 13:40:50 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions
emacs/test/lisp/net/mailcap-tests.el
Po Lu ecf08f0621 Merge from savannah/emacs-29 
dc4e6b1329 ; Update copyright years in more files
64b3777631 ; Run set-copyright from admin.el
8e1c56ae46 ; Add 2024 to copyright years

# Conflicts:
#	doc/misc/modus-themes.org
#	doc/misc/texinfo.tex
#	etc/NEWS
#	etc/refcards/ru-refcard.tex
#	etc/themes/modus-operandi-theme.el
#	etc/themes/modus-themes.el
#	etc/themes/modus-vivendi-theme.el
#	lib/alloca.in.h
#	lib/binary-io.h
#	lib/c-ctype.h
#	lib/c-strcasecmp.c
#	lib/c-strncasecmp.c
#	lib/careadlinkat.c
#	lib/cloexec.c
#	lib/close-stream.c
#	lib/diffseq.h
#	lib/dup2.c
#	lib/filemode.h
#	lib/fpending.c
#	lib/fpending.h
#	lib/fsusage.c
#	lib/getgroups.c
#	lib/getloadavg.c
#	lib/gettext.h
#	lib/gettime.c
#	lib/gettimeofday.c
#	lib/group-member.c
#	lib/malloc.c
#	lib/md5-stream.c
#	lib/md5.c
#	lib/md5.h
#	lib/memmem.c
#	lib/memrchr.c
#	lib/nanosleep.c
#	lib/save-cwd.h
#	lib/sha1.c
#	lib/sig2str.c
#	lib/stdlib.in.h
#	lib/strtoimax.c
#	lib/strtol.c
#	lib/strtoll.c
#	lib/time_r.c
#	lib/xalloc-oversized.h
#	lisp/auth-source-pass.el
#	lisp/emacs-lisp/lisp-mnt.el
#	lisp/emacs-lisp/timer.el
#	lisp/info-look.el
#	lisp/jit-lock.el
#	lisp/loadhist.el
#	lisp/mail/rmail.el
#	lisp/net/ntlm.el
#	lisp/net/webjump.el
#	lisp/progmodes/asm-mode.el
#	lisp/progmodes/project.el
#	lisp/progmodes/sh-script.el
#	lisp/textmodes/flyspell.el
#	lisp/textmodes/reftex-toc.el
#	lisp/textmodes/reftex.el
#	lisp/textmodes/tex-mode.el
#	lisp/url/url-gw.el
#	m4/alloca.m4
#	m4/clock_time.m4
#	m4/d-type.m4
#	m4/dirent_h.m4
#	m4/dup2.m4
#	m4/euidaccess.m4
#	m4/fchmodat.m4
#	m4/filemode.m4
#	m4/fsusage.m4
#	m4/getgroups.m4
#	m4/getloadavg.m4
#	m4/getrandom.m4
#	m4/gettime.m4
#	m4/gettimeofday.m4
#	m4/gnulib-common.m4
#	m4/group-member.m4
#	m4/inttypes.m4
#	m4/malloc.m4
#	m4/manywarnings.m4
#	m4/mempcpy.m4
#	m4/memrchr.m4
#	m4/mkostemp.m4
#	m4/mktime.m4
#	m4/nproc.m4
#	m4/nstrftime.m4
#	m4/pathmax.m4
#	m4/pipe2.m4
#	m4/pselect.m4
#	m4/pthread_sigmask.m4
#	m4/readlink.m4
#	m4/realloc.m4
#	m4/sig2str.m4
#	m4/ssize_t.m4
#	m4/stat-time.m4
#	m4/stddef_h.m4
#	m4/stdint.m4
#	m4/stdio_h.m4
#	m4/stdlib_h.m4
#	m4/stpcpy.m4
#	m4/strnlen.m4
#	m4/strtoimax.m4
#	m4/strtoll.m4
#	m4/time_h.m4
#	m4/timegm.m4
#	m4/timer_time.m4
#	m4/timespec.m4
#	m4/unistd_h.m4
#	m4/warnings.m4
#	nt/configure.bat
#	nt/preprep.c
#	test/lisp/register-tests.el
2024-01-02 10:28:14 +08:00

565 lines
24 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; mailcap-tests.el --- tests for mailcap.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2024 Free Software Foundation, Inc.
;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; 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 'ert-x)
(require 'mailcap)
(defconst mailcap-tests-path (ert-resource-file "mime.types")
"String used as PATH argument of `mailcap-parse-mimetypes'.")
(defconst mailcap-tests-mime-extensions (copy-alist mailcap-mime-extensions))
(defconst mailcap-tests-path-extensions
'((".wav" . "audio/x-wav")
(".flac" . "audio/flac")
(".opus" . "audio/ogg"))
"Alist of MIME associations in `mailcap-tests-path'.")
(ert-deftest mailcap-mimetypes-parsed-p ()
(should (null mailcap-mimetypes-parsed-p)))
(ert-deftest mailcap-parse-empty-path ()
"If PATH is empty, this should be a noop."
(mailcap-parse-mimetypes "file/that/should/not/exist" t)
(should mailcap-mimetypes-parsed-p)
(should (equal mailcap-mime-extensions mailcap-tests-mime-extensions)))
(ert-deftest mailcap-parse-path ()
(let ((mimetypes (getenv "MIMETYPES")))
(unwind-protect
(progn
(setenv "MIMETYPES" mailcap-tests-path)
(mailcap-parse-mimetypes nil t))
(setenv "MIMETYPES" mimetypes)))
(should (equal mailcap-mime-extensions
(append mailcap-tests-path-extensions
mailcap-tests-mime-extensions)))
;; Already parsed this, should be a noop
(mailcap-parse-mimetypes mailcap-tests-path)
(should (equal mailcap-mime-extensions
(append mailcap-tests-path-extensions
mailcap-tests-mime-extensions))))
(defmacro with-pristine-mailcap (&rest body)
;; We only want the mailcap info we define ourselves.
`(let (mailcap--computed-mime-data
mailcap-mime-data
mailcap-user-mime-data)
;; `mailcap-mime-info' calls `mailcap-parse-mailcaps' which parses
;; the system's mailcaps. We don't want that for our test.
(cl-letf (((symbol-function 'mailcap-parse-mailcaps) #'ignore))
,@body)))
(ert-deftest mailcap-parsing-and-mailcap-mime-info ()
(with-pristine-mailcap
;; One mailcap entry has a test=false field. The shell command
;; execution errors when running the tests from the Makefile
;; because then HOME=/nonexistent.
(ert-with-temp-directory home
(with-environment-variables (("HOME" home))
;; Now parse our resource mailcap file.
(mailcap-parse-mailcap (ert-resource-file "mailcap"))
;; Assert that we get what we have defined.
(dolist (type '("audio/ogg" "audio/flac"))
(should (string= "mpv %s" (mailcap-mime-info type))))
(should (string= "aplay %s" (mailcap-mime-info "audio/x-wav")))
(should (string= "emacsclient -t %s"
(mailcap-mime-info "text/plain")))
;; evince is chosen because acroread has test=false and okular
;; comes later.
(should (string= "evince %s"
(mailcap-mime-info "application/pdf")))
(should (string= "inkscape %s"
(mailcap-mime-info "image/svg+xml")))
(should (string= "eog %s"
(mailcap-mime-info "image/jpg")))
;; With REQUEST being a number, all fields of the selected entry
;; should be returned.
(should (equal '((viewer . "evince %s")
(type . "application/pdf"))
(mailcap-mime-info "application/pdf" 1)))
;; With 'all, all applicable entries should be returned.
(should (equal '(((viewer . "evince %s")
(type . "application/pdf"))
((viewer . "okular %s")
(type . "application/pdf")))
(mailcap-mime-info "application/pdf" 'all)))
(let* ((c nil)
(toggle (lambda (_) (setq c (not c)))))
(mailcap-add "audio/ogg" "toggle %s" toggle)
(should (string= "toggle %s" (mailcap-mime-info "audio/ogg")))
;; The test results are cached, so in order to have the test
;; re-evaluated, one needs to clear the cache.
(setq mailcap-viewer-test-cache nil)
(should (string= "mpv %s" (mailcap-mime-info "audio/ogg")))
(setq mailcap-viewer-test-cache nil)
(should (string= "toggle %s" (mailcap-mime-info "audio/ogg"))))))))
(defvar mailcap--test-result nil)
(defun mailcap--test-viewer ()
(setq mailcap--test-result (string= (buffer-string) "test\n")))
(ert-deftest mailcap-view-file ()
(with-pristine-mailcap
;; Try using a lambda as viewer and check whether
;; `mailcap-view-file' works correctly.
(let* ((mailcap-mime-extensions '((".test" . "test/test"))))
(mailcap-add "test/test" 'mailcap--test-viewer)
(save-window-excursion
(mailcap-view-file (ert-resource-file "test.test")))
(should mailcap--test-result))))
(ert-deftest mailcap-add-mailcap-entry-new-major ()
"Add a major entry not yet in ‘mailcap-mime-data’."
(let ((mailcap-mime-data))
;; Add a new major entry to a empty ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major1" "minor1"
(list (cons 'viewer "viewer1"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major1"
("minor1" . ((viewer . "viewer1")))))))
;; Add a new major entry to a non-empty ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major2" "minor2"
(list (cons 'viewer "viewer2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major2"
("minor2" . ((viewer . "viewer2"))))
("major1"
("minor1" . ((viewer . "viewer1"))))))))
;; Same spiel but with extra entries in INFO.
(let ((mailcap-mime-data))
;; Add a new major entry to an empty ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major1" "minor1"
(list (cons 'viewer "viewer1")
(cons 'print "print1"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major1"
("minor1" . ((viewer . "viewer1")
(print . "print1")))))))
;; Add a new major entry to a non-empty ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major2" "minor2"
(list (cons 'viewer "viewer2")
(cons 'print "print2")
(cons 'compose "compose2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major2"
("minor2" . ((viewer . "viewer2")
(print . "print2")
(compose . "compose2"))))
("major1"
("minor1" . ((viewer . "viewer1")
(print . "print1")))))))))
(ert-deftest mailcap-add-mailcap-entry-new-minor-to-empty-major ()
"Add a minor entry to a an empty major entry."
(let ((mailcap-mime-data (list (list "major"))))
(mailcap-add-mailcap-entry "major" "minor1"
(list (cons 'viewer "viewer1")
(cons 'print "print1"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor1" . ((viewer . "viewer1")
(print . "print1")))))))))
(ert-deftest mailcap-add-mailcap-entry-new-minor-to-non-empty-major ()
"Add a minor to a major entry containing already minor entries."
(let ((mailcap-mime-data
(list
(list "major"
(list "minor1"
(cons 'viewer "viewer1")
(cons 'test "test1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor2"
(list (cons 'viewer "viewer2")
(cons 'test "test2")
(cons 'print "print2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor2" . ((viewer . "viewer2")
(test . "test2")
(print . "print2")))
("minor1" . ((viewer . "viewer1")
(test . "test1")
(print . "print1")))))))
(mailcap-add-mailcap-entry "major" "minor3"
(list (cons 'viewer "viewer3")
(cons 'test "test3")
(cons 'compose "compose3"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor3" . ((viewer . "viewer3")
(test . "test3")
(compose . "compose3")))
("minor2" . ((viewer . "viewer2")
(test . "test2")
(print . "print2")))
("minor1" . ((viewer . "viewer1")
(test . "test1")
(print . "print1")))))))))
(ert-deftest mailcap-add-mailcap-entry-new-minor-to-various-major-positions ()
"Add a new minor entry to major entries at various positions
in ‘mailcap-mime-data’."
(let ((mailcap-mime-data
(list
(list "major1"
(list "minor1.1"
(cons 'viewer "viewer1.1")
(cons 'print "print1.1")))
(list "major2"
(list "minor2.1"
(cons 'viewer "viewer2.1")
(cons 'print "print2.1")
(cons 'compose "compose2.1")))
(list "major3"
(list "minor3.1"
(cons 'viewer "viewer3.1")
(cons 'compose "compose3.1")))
(list "major4"
(list "minor4.1"
(cons 'viewer "viewer4.1")
(cons 'edit "edit4.1"))))))
;; Add a minor entry to a major mode at the front of
;; ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major1" "minor1.2"
(list (cons 'viewer "viewer1.2")
(cons 'test "test1.2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major1"
("minor1.2" . ((viewer . "viewer1.2")
(test . "test1.2")))
("minor1.1" . ((viewer . "viewer1.1")
(print . "print1.1"))))
("major2"
("minor2.1" . ((viewer . "viewer2.1")
(print . "print2.1")
(compose . "compose2.1"))))
("major3"
("minor3.1" . ((viewer . "viewer3.1")
(compose . "compose3.1"))))
("major4"
("minor4.1" . ((viewer . "viewer4.1")
(edit . "edit4.1")))))))
;; Add a minor entry to a major mode in the middle of
;; ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major3" "minor3.2"
(list (cons 'viewer "viewer3.2")
(cons 'test "test3.2")
(cons 'compose "compose3.2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major1"
("minor1.2" . ((viewer . "viewer1.2")
(test . "test1.2")))
("minor1.1" . ((viewer . "viewer1.1")
(print . "print1.1"))))
("major2"
("minor2.1" . ((viewer . "viewer2.1")
(print . "print2.1")
(compose . "compose2.1"))))
("major3"
("minor3.2" . ((viewer . "viewer3.2")
(test . "test3.2")
(compose . "compose3.2")))
("minor3.1" . ((viewer . "viewer3.1")
(compose . "compose3.1"))))
("major4"
("minor4.1" . ((viewer . "viewer4.1")
(edit . "edit4.1")))))))
;; Add a minor entry to a major mode at the end of
;; ‘mailcap-mime-data’.
(mailcap-add-mailcap-entry "major4" "minor4.2"
(list (cons 'viewer "viewer4.2")
(cons 'test "test4.2")
(cons 'print "print4.2")
(cons 'compose "compose4.2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major1"
("minor1.2" . ((viewer . "viewer1.2")
(test . "test1.2")))
("minor1.1" . ((viewer . "viewer1.1")
(print . "print1.1"))))
("major2"
("minor2.1" . ((viewer . "viewer2.1")
(print . "print2.1")
(compose . "compose2.1"))))
("major3"
("minor3.2" . ((viewer . "viewer3.2")
(test . "test3.2")
(compose . "compose3.2")))
("minor3.1" . ((viewer . "viewer3.1")
(compose . "compose3.1"))))
("major4"
("minor4.2" . ((viewer . "viewer4.2")
(test . "test4.2")
(print . "print4.2")
(compose . "compose4.2")))
("minor4.1" . ((viewer . "viewer4.1")
(edit . "edit4.1")))))))))
(ert-deftest mailcap-add-mailcap-entry-existing-with-test-differing-viewer ()
"Add a new entry for an already existing major/minor entry."
;; The new and the existing entry have each a test info field.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer1")
(cons 'test "test1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer2")
(cons 'test "test2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer2")
(test . "test2")))
("minor" . ((viewer . "viewer1")
(test . "test1")
(print . "print1"))))))))
;; Only the new entry has a test info field.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer2")
(cons 'test "test2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer2")
(test . "test2")))
("minor" . ((viewer . "viewer1")
(print . "print1"))))))))
;; Only the existing entry has a test info field.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer1")
(cons 'test "test1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer2")))
("minor" . ((viewer . "viewer1")
(test . "test1")
(print . "print1")))))))))
(ert-deftest mailcap-add-mailcap-entry-existing-with-test-same-viewer ()
"Add a new entry for an already existing major/minor entry."
;; Both the new and the existing entry have each a test info field.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer")
(cons 'test "test1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer")
(cons 'test "test2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer")
(test . "test2")))
("minor" . ((viewer . "viewer")
(test . "test1")
(print . "print1"))))))))
;; Only the new entry has a test field.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer")
(cons 'test "test2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer")
(test . "test2")))
("minor" . ((viewer . "viewer")
(print . "print1"))))))))
;; Only the existing entry has a test info field.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer")
(cons 'test "test1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer")))
("minor" . ((viewer . "viewer")
(test . "test1")
(print . "print1")))))))))
(ert-deftest mailcap-add-mailcap-entry-existing-without-test-differing-viewer ()
"Add a new entry for an already existing major/minor entry."
;; Both entries do not have test fields.
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer1")
(cons 'print "print1"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer2")
(cons 'compose "print2"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer2")
(compose . "print2")))
("minor" . ((viewer . "viewer1")
(print . "print1")))))))))
(ert-deftest mailcap-add-mailcap-entry-simple-merge ()
"Merge entries without tests (no extra info fields in the existing entry)."
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer"))))))))
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer")
(cons 'print "print"))
'mailcap-mime-data)
(should (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer")
(print . "print")))))))))
(ert-deftest mailcap-add-mailcap-entry-erroneous-merge ()
"Merge entries without tests (extra info fields in existing entry).
In its current implementation ‘mailcap-add-mailcap-entry’ loses
extra fields of an entry already existing in ‘mailcap-mime-data’.
This test does not actually verify a correct result; it merely
checks whether ‘mailcap-add-mailcap-entry’ behavior is still the
incorrect one. As such, it can be satisfied by any other result
than the expected and known wrong one, and its success does not
help to verify the correct addition and merging of an entry."
:expected-result :failed
(let ((mailcap-mime-data
(list
(list "major"
(list "minor"
(cons 'viewer "viewer")
(cons 'print "print"))))))
(mailcap-add-mailcap-entry "major" "minor"
(list (cons 'viewer "viewer")
(cons 'edit "edit"))
'mailcap-mime-data)
;; Has the print field been lost?
(should-not (equal mailcap-mime-data
'(("major"
("minor" . ((viewer . "viewer")
(edit . "edit")))))))))
(ert-deftest mailcap-viewer-passes-test-w/o-test-returns-t ()
"A VIEWER-INFO without a test should return t with a valid viewer (Bug#65224)."
(should (equal t
(let ((mailcap-viewer-test-cache)
(viewer-info
(list (cons 'viewer "viewer-w/o-test"))))
(mailcap-viewer-passes-test viewer-info nil))))
(should (equal '(t t nil t)
(let ((mailcap-viewer-test-cache)
(viewer-infos
(list
(list (cons 'viewer "viewer-w/o-test"))
(list (cons 'viewer "viewer-w/o-test"))
(list (cons 'viewer "viewer-w/nil-test")
(cons 'test nil))
(list (cons 'viewer "viewer-w/o-test"))
)))
(mapcar (lambda (vi)
(mailcap-viewer-passes-test vi nil))
viewer-infos)))))
;;; mailcap-tests.el ends here
Reference in a new issue View git blame Copy permalink