Add tests for gif to src/image-tests.el

* test/src/image-tests.el (image-tests--images): Rename from
image-tests-files.  Add gif.
(image-tests-image-size/gif)
(image-tests-image-mask-p/gif)
(image-tests-image-metadata/gif): New tests.
* test/data/image/black.gif: New file.
scratch/etags-regen
Stefan Kangas 2021-10-24 12:05:37 +02:00
parent b931e11a03
commit b2bfdd9658
2 changed files with 48 additions and 31 deletions

BIN
test/data/image/black.gif Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 143 B

View File

@ -35,8 +35,10 @@
;;;; Images
(defconst image-tests--files
`((jpeg . ,(expand-file-name "test/data/image/black.jpg"
(defconst image-tests--images
`((gif . ,(expand-file-name "test/data/image/black.gif"
source-directory))
(jpeg . ,(expand-file-name "test/data/image/black.jpg"
source-directory))
(pbm . ,(find-image '((:file "splash.svg" :type svg))))
(png . ,(find-image '((:file "splash.png" :type png))))
@ -47,64 +49,69 @@
(webp . ,(expand-file-name "test/data/image/black.webp"
source-directory))
(xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm))))
(xpm . ,(find-image '((:file "splash.xpm" :type xpm))))
;; TODO: gif
))
(xpm . ,(find-image '((:file "splash.xpm" :type xpm))))))
;;;; image-test-size
(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--files))))
(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--files)))
(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--files)))
(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--files)))
(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--files))))
(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--files))))
(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--files)))
(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--files)))
(pcase (image-size (cdr (assq 'xpm image-tests--images)))
(`(,a . ,b)
(should (floatp a))
(should (floatp b)))))
@ -119,40 +126,45 @@
;;;; image-mask-p
(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--files))))))
(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--files)))))
(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--files)))))
(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--files)))))
(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--files))))))
(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--files))))))
(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--files)))))
(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--files)))))
(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))
@ -160,47 +172,52 @@
(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--files)))))
(should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
;;;; image-metadata
;; TODO: These tests could be expanded with files that actually
;; contain metadata.
(ert-deftest image-tests-image-metadata/gif ()
(image-skip-unless 'gif)
(should-not (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--files))))))
(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--files)))))
(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--files)))))
(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--files)))))
(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--files))))))
(create-image (cdr (assq 'tiff image-tests--images))))))
(ert-deftest image-tests-image-metadata/webp ()
(image-skip-unless 'webp)
(should-not (image-metadata
(create-image (cdr (assq 'webp image-tests--files))))))
(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--files)))))
(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--files)))))
(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))
@ -208,7 +225,7 @@
(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--files)))))
(should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
;;;; ImageMagick