]> git.eshelyaron.com Git - emacs.git/commitdiff
Add tests for gif to src/image-tests.el
authorStefan Kangas <stefan@marxist.se>
Sun, 24 Oct 2021 10:05:37 +0000 (12:05 +0200)
committerStefan Kangas <stefan@marxist.se>
Sun, 24 Oct 2021 10:14:32 +0000 (12:14 +0200)
* 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.

test/data/image/black.gif [new file with mode: 0644]
test/src/image-tests.el

diff --git a/test/data/image/black.gif b/test/data/image/black.gif
new file mode 100644 (file)
index 0000000..6ab623e
Binary files /dev/null and b/test/data/image/black.gif differ
index b921739a05659608a67b9edd0eceb53da1ca56d4..2b236086b6f82453958cb712b77fa17396b52d84 100644 (file)
 
 ;;;; 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))))
     (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)))))
 
 ;;;; 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))
 
 (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))
 
 (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