test/manual/image-size-tests.el

   1 ;;; image-size-tests.el -- tests for image scaling
   2
   3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
  19
  20 ;; To test: Load the file and eval (image-size-tests).
  21 ;; A non-erroring result is a success.
  22
  23 ;;; Code:
  24
  25 (defmacro im-should (image width height &rest props)
  26   `(let ((im (im-image ,image ,@props)))
  27      (unless (im-compare im ,width ,height)
  28        (error "%s %s didn't succeed; size is %s"
  29               ',image ',props (image-size im t)))))
  30
  31 (defun im-image (type &rest props)
  32   (let ((image-scaling-factor 1))
  33     (apply
  34      #'create-image
  35      (expand-file-name
  36       (if (eq type :w)
  37           "test/data/image/blank-200x100.png"
  38           "test/data/image/blank-100x200.png")
  39       source-directory)
  40      'imagemagick nil props)))
  41
  42 (defun im-compare (image width height)
  43   (let ((size (image-size image t)))
  44     (and (= (car size) width)
  45          (= (cdr size) height))))
  46
  47 (defun image-size-tests ()
  48   (unless (imagemagick-types)
  49     (error "This only makes sense if ImageMagick is installed"))
  50   ;; Test the image that's wider than it is tall.
  51   ;; Default sizes.
  52   (im-should :w 200 100)
  53   ;; Changing one dimension changes the other.
  54   (im-should :w 100 50 :width 100)
  55   (im-should :w 100 50 :height 50)
  56   ;; The same with :max-width etc.
  57   (im-should :w 100 50 :max-width 100)
  58   (im-should :w 100 50 :max-height 50)
  59   ;; :width wins over :max-width etc
  60   (im-should :w 300 150 :width 300 :max-width 100)
  61   (im-should :w 400 200 :height 200 :max-height 100)
  62   ;; Specifying both width and height is fine.
  63   (im-should :w 300 50 :width 300 :height 50)
  64   ;; A too-large :max-width (etc) has no effect.
  65   (im-should :w 200 100 :max-width 300)
  66   (im-should :w 200 100 :max-height 300)
  67   ;; Both max-width/height.
  68   (im-should :w 100 50 :max-width 100 :max-height 75)
  69   (im-should :w 50 25 :max-width 100 :max-height 25)
  70   ;; :width and :max-height (max-height wins).
  71   (im-should :w 400 200 :width 400 :max-height 200)
  72   (im-should :w 400 200 :width 500 :max-height 200)
  73
  74   ;; Test the image that's taller than it is wide.
  75   (im-should :h 100 200)
  76   ;; Changing one dimension changes the other.
  77   (im-should :h 50 100 :width 50)
  78   (im-should :h 50 100 :height 100)
  79   ;; The same with :max-width etc.
  80   (im-should :h 50 100 :max-width 50)
  81   (im-should :h 50 100 :max-height 100)
  82   ;; :width wins over :max-width etc
  83   (im-should :h 300 600 :width 300 :max-width 100)
  84   (im-should :h 150 300 :height 300 :max-height 100)
  85   ;; Specifying both width and height is fine.
  86   (im-should :h 300 50 :width 300 :height 50)
  87   ;; A too-large :max-width (etc) has no effect.
  88   (im-should :h 100 200 :max-width 300)
  89   (im-should :h 100 200 :max-height 300)
  90   ;; Both max-width/height.
  91   (im-should :h 50 100 :max-width 75 :max-height 100)
  92   (im-should :h 25 50 :max-width 25 :max-height 100)
  93   ;; :height and :max-width (max-width wins).
  94   (im-should :h 200 400 :height 400 :max-width 200)
  95   (im-should :h 200 400 :height 500 :max-width 200)
  96   )
  97
  98 ;;; image-size-tests.el ends here