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 <http://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 didn't succeed; size is %s"
  29               ',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
  71   ;; Test the image that's taller than it is wide.
  72   (im-should :h 100 200)
  73   ;; Changing one dimension changes the other.
  74   (im-should :h 50 100 :width 50)
  75   (im-should :h 50 100 :height 100)
  76   ;; The same with :max-width etc.
  77   (im-should :h 50 100 :max-width 50)
  78   (im-should :h 50 100 :max-height 100)
  79   ;; :width wins over :max-width etc
  80   (im-should :h 300 600 :width 300 :max-width 100)
  81   (im-should :h 150 300 :height 300 :max-height 100)
  82   ;; Specifying both width and height is fine.
  83   (im-should :h 300 50 :width 300 :height 50)
  84   ;; A too-large :max-width (etc) has no effect.
  85   (im-should :h 100 200 :max-width 300)
  86   (im-should :h 100 200 :max-height 300)
  87   ;; Both max-width/height.
  88   (im-should :h 50 100 :max-width 75 :max-height 100)
  89   (im-should :h 25 50 :max-width 25 :max-height 100)
  90   )
  91
  92 ;;; image-size-tests.el ends here