master 5b87429d99: Move some tests to test/manual/image-tests.el

[Stefan Kangas]

branch: master
commit 5b87429d99bf99c0adde371a5ecfd2c745fc3489
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>

    Move some tests to test/manual/image-tests.el
    
    * test/src/image-tests.el: Move several tests from here...
    * test/manual/image-tests.el: ...to here.
    Suggested by Eli Zaretskii <eliz@gnu.org>.
---
 test/{src => manual}/image-tests.el |  49 ++------
 test/src/image-tests.el             | 224 ------------------------------------
 2 files changed, 8 insertions(+), 265 deletions(-)

diff --git a/test/src/image-tests.el b/test/manual/image-tests.el
similarity index 85%
copy from test/src/image-tests.el
copy to test/manual/image-tests.el
index 0b2d42ab9f..2565ff29c9 100644
--- a/test/src/image-tests.el
+++ b/test/manual/image-tests.el
@@ -1,8 +1,9 @@
-;;; image-tests.el --- Tests for image.c  -*- lexical-binding: t -*-
+;;; image-tests.el --- tests for image.c  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
 
 ;; Author: Stefan Kangas <stefankangas@gmail.com>
+;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
@@ -21,24 +22,19 @@
 
 ;;; Commentary:
 
-;; Most of these tests will only run in a GUI session, and not with
-;; "make check".  You must run them manually in an interactive session
-;; with, for example, `M-x eval-buffer' followed by `M-x ert'.
+;; These tests will only run in a GUI session.  You must run them
+;; manually in an interactive session with, for example, `M-x
+;; eval-buffer' followed by `M-x ert'.
 ;;
-;; To run these tests from the command line, try:
-;;     ./src/emacs -Q -l test/src/image-tests.el -eval "(ert t)"
+;; To run them from the command line instead, try:
+;;     ./src/emacs -Q -l test/manual/image-tests.el -eval "(ert t)"
 
 ;;; Code:
 
-(require 'ert)
-
 (defmacro image-skip-unless (format)
   `(skip-unless (and (display-images-p)
                      (image-type-available-p ,format))))
 
-
-;;;; Image data
-
 (defconst image-tests--images
   `((gif . ,(expand-file-name "test/data/image/black.gif"
                               source-directory))
@@ -154,10 +150,6 @@
   (skip-unless (display-images-p))
   (should-error (image-size 'invalid-spec)))
 
-(ert-deftest image-tests-image-size/error-on-nongraphical-display ()
-  (skip-unless (not (display-images-p)))
-  (should-error (image-size 'invalid-spec)))
-
 
 ;;;; image-mask-p
 
@@ -207,10 +199,6 @@
   (skip-unless (display-images-p))
   (should-error (image-mask-p 'invalid-spec)))
 
-(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display ()
-  (skip-unless (not (display-images-p)))
-  (should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
-
 
 ;;;; image-metadata
 
@@ -265,25 +253,4 @@
   (skip-unless (display-images-p))
   (should-not (image-metadata 'invalid-spec)))
 
-(ert-deftest image-tests-image-metadata/error-on-nongraphical-display ()
-  (skip-unless (not (display-images-p)))
-  (should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
-
-
-;;;; ImageMagick
-
-(ert-deftest image-tests-imagemagick-types ()
-  (skip-unless (fboundp 'imagemagick-types))
-  (when (fboundp 'imagemagick-types)
-    (should (listp (imagemagick-types)))))
-
-
-;;;; Initialization
-
-(ert-deftest image-tests-init-image-library ()
-  (skip-unless (fboundp 'init-image-library))
-  (declare-function init-image-library "image.c" (type))
-  (should (init-image-library 'pbm)) ; built-in
-  (should-not (init-image-library 'invalid-image-type)))
-
-;;; image-tests.el ends here
+;;; image-size-tests.el ends here
diff --git a/test/src/image-tests.el b/test/src/image-tests.el
index 0b2d42ab9f..bf79faca52 100644
--- a/test/src/image-tests.el
+++ b/test/src/image-tests.el
@@ -19,26 +19,10 @@
 ;; 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:
-
-;; Most of these tests will only run in a GUI session, and not with
-;; "make check".  You must run them manually in an interactive session
-;; with, for example, `M-x eval-buffer' followed by `M-x ert'.
-;;
-;; To run these tests from the command line, try:
-;;     ./src/emacs -Q -l test/src/image-tests.el -eval "(ert t)"
-
 ;;; Code:
 
 (require 'ert)
 
-(defmacro image-skip-unless (format)
-  `(skip-unless (and (display-images-p)
-                     (image-type-available-p ,format))))
-
-
-;;;; Image data
-
 (defconst image-tests--images
   `((gif . ,(expand-file-name "test/data/image/black.gif"
                               source-directory))
@@ -55,231 +39,23 @@
     (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm))))
     (xpm . ,(find-image '((:file "splash.xpm" :type xpm))))))
 
-
-;;;; Load image
-
-(defmacro image-tests-make-load-image-test (type)
-  `(ert-deftest ,(intern (format "image-tests-load-image/%s"
-                                 (eval type t)))
-       ()
-     (image-skip-unless ,type)
-     (let* ((img (cdr (assq ,type image-tests--images)))
-            (file (if (listp img)
-                      (plist-get (cdr img) :file)
-                    img)))
-       (find-file file))
-     (should (equal major-mode 'image-mode))
-     ;; Cleanup
-     (kill-buffer (current-buffer))))
-
-(image-tests-make-load-image-test 'gif)
-(image-tests-make-load-image-test 'jpeg)
-(image-tests-make-load-image-test 'pbm)
-(image-tests-make-load-image-test 'png)
-(image-tests-make-load-image-test 'svg)
-(image-tests-make-load-image-test 'tiff)
-(image-tests-make-load-image-test 'webp)
-(image-tests-make-load-image-test 'xbm)
-(image-tests-make-load-image-test 'xpm)
-
-
-;;;; image-test-size
-
-(declare-function image-size "image.c" (spec &optional pixels frame))
-
-(ert-deftest image-tests-image-size/gif ()
-  (image-skip-unless 'gif)
-  (pcase (image-size (create-image (cdr (assq 'gif image-tests--images))))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/jpeg ()
-  (image-skip-unless 'jpeg)
-  (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--images))))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/pbm ()
-  (image-skip-unless 'pbm)
-  (pcase (image-size (cdr (assq 'pbm image-tests--images)))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/png ()
-  (image-skip-unless 'png)
-  (pcase (image-size (cdr (assq 'png image-tests--images)))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/svg ()
-  (image-skip-unless 'svg)
-  (pcase (image-size (cdr (assq 'svg image-tests--images)))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/tiff ()
-  (image-skip-unless 'tiff)
-  (pcase (image-size (create-image (cdr (assq 'tiff image-tests--images))))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/webp ()
-  (image-skip-unless 'webp)
-  (pcase (image-size (create-image (cdr (assq 'webp image-tests--images))))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/xbm ()
-  (image-skip-unless 'xbm)
-  (pcase (image-size (cdr (assq 'xbm image-tests--images)))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/xpm ()
-  (image-skip-unless 'xpm)
-  (pcase (image-size (cdr (assq 'xpm image-tests--images)))
-    (`(,a . ,b)
-     (should (floatp a))
-     (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/error-on-invalid-spec ()
-  (skip-unless (display-images-p))
-  (should-error (image-size 'invalid-spec)))
-
 (ert-deftest image-tests-image-size/error-on-nongraphical-display ()
   (skip-unless (not (display-images-p)))
   (should-error (image-size 'invalid-spec)))
 
-
-;;;; image-mask-p
-
-(declare-function image-mask-p "image.c" (spec &optional frame))
-
-(ert-deftest image-tests-image-mask-p/gif ()
-  (image-skip-unless 'gif)
-  (should-not (image-mask-p (create-image
-                             (cdr (assq 'gif image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/jpeg ()
-  (image-skip-unless 'jpeg)
-  (should-not (image-mask-p (create-image
-                             (cdr (assq 'jpeg image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/pbm ()
-  (image-skip-unless 'pbm)
-  (should-not (image-mask-p (cdr (assq 'pbm image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/png ()
-  (image-skip-unless 'png)
-  (should-not (image-mask-p (cdr (assq 'png image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/svg ()
-  (image-skip-unless 'svg)
-  (should-not (image-mask-p (cdr (assq 'svg image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/tiff ()
-  (image-skip-unless 'tiff)
-  (should-not (image-mask-p (create-image
-                             (cdr (assq 'tiff image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/webp ()
-  (image-skip-unless 'webp)
-  (should-not (image-mask-p (create-image
-                             (cdr (assq 'webp image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/xbm ()
-  (image-skip-unless 'xbm)
-  (should-not (image-mask-p (cdr (assq 'xbm image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/xpm ()
-  (image-skip-unless 'xpm)
-  (should-not (image-mask-p (cdr (assq 'xpm image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/error-on-invalid-spec ()
-  (skip-unless (display-images-p))
-  (should-error (image-mask-p 'invalid-spec)))
-
 (ert-deftest image-tests-image-mask-p/error-on-nongraphical-display ()
   (skip-unless (not (display-images-p)))
   (should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
 
-
-;;;; image-metadata
-
-(declare-function image-metadata "image.c" (spec &optional frame))
-
-;; TODO: These tests could be expanded with files that actually
-;;       contain metadata.
-
-(ert-deftest image-tests-image-metadata/gif ()
-  (image-skip-unless 'gif)
-  (should (memq 'delay
-                (image-metadata
-                 (create-image (cdr (assq 'gif image-tests--images)))))))
-
-(ert-deftest image-tests-image-metadata/jpeg ()
-  (image-skip-unless 'jpeg)
-  (should-not (image-metadata
-               (create-image (cdr (assq 'jpeg image-tests--images))))))
-
-(ert-deftest image-tests-image-metadata/pbm ()
-  (image-skip-unless 'pbm)
-  (should-not (image-metadata (cdr (assq 'pbm image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/png ()
-  (image-skip-unless 'png)
-  (should-not (image-metadata (cdr (assq 'png image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/svg ()
-  (image-skip-unless 'svg)
-  (should-not (image-metadata (cdr (assq 'svg image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/tiff ()
-  (image-skip-unless 'tiff)
-  (should-not (image-metadata
-               (create-image (cdr (assq 'tiff image-tests--images))))))
-
-(ert-deftest image-tests-image-metadata/webp ()
-  (image-skip-unless 'webp)
-  (should (memq 'delay
-                (image-metadata
-                 (create-image (cdr (assq 'webp image-tests--images)))))))
-
-(ert-deftest image-tests-image-metadata/xbm ()
-  (image-skip-unless 'xbm)
-  (should-not (image-metadata (cdr (assq 'xbm image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/xpm ()
-  (image-skip-unless 'xpm)
-  (should-not (image-metadata (cdr (assq 'xpm image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/nil-on-invalid-spec ()
-  (skip-unless (display-images-p))
-  (should-not (image-metadata 'invalid-spec)))
-
 (ert-deftest image-tests-image-metadata/error-on-nongraphical-display ()
   (skip-unless (not (display-images-p)))
   (should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
 
-
-;;;; ImageMagick
-
 (ert-deftest image-tests-imagemagick-types ()
   (skip-unless (fboundp 'imagemagick-types))
   (when (fboundp 'imagemagick-types)
     (should (listp (imagemagick-types)))))
 
-
-;;;; Initialization
-
 (ert-deftest image-tests-init-image-library ()
   (skip-unless (fboundp 'init-image-library))
   (declare-function init-image-library "image.c" (type))