test/automated/xwidget-tests.el

   1 ;; -*- lexical-binding: t; -*-
   2
   3 (require 'cl)
   4 (require 'xwidget)
   5 (require 'xwidget-test)
   6 (require 'parallel)
   7
   8 (defvar xwidget-parallel-config (list :emacs-path (expand-file-name
   9                                                    "~/packages/xwidget-build/src/emacs")))
  10
  11 (defmacro xwidget-deftest (name types &rest body)
  12   (declare (indent defun))
  13   (if (null types)
  14       `(ert-deftest ,(intern (format "%s" name)) ()
  15          (let ((parallel-config xwidget-parallel-config))
  16            ,@body))
  17     `(progn
  18        ,@(loop for type in types
  19                collect
  20                `(ert-deftest ,(intern (format "%s-%s" name type)) ()
  21                   (let ((parallel-config xwidget-parallel-config)
  22                         (type ',type)
  23                         (title ,(symbol-name type)))
  24                     ,@body))))))
  25
  26 (xwidget-deftest xwidget-make-xwidget (Button ToggleButton slider socket cairo)
  27   (let* ((beg 1)
  28          (end 1)
  29          (width 100)
  30          (height 100)
  31          (data nil)
  32          (proc (parallel-start
  33                 (lambda (beg end type title width height data)
  34                   (require 'xwidget)
  35                   (require 'cl)
  36                   (with-temp-buffer
  37                     (insert ?\0)
  38                     (let* ((buffer (current-buffer))
  39                            (xwidget (make-xwidget beg end type title width height data buffer)))
  40                       (set-xwidget-query-on-exit-flag xwidget nil)
  41                       (parallel-remote-send (coerce (xwidget-info xwidget) 'list))
  42                       (parallel-remote-send (buffer-name buffer))
  43                       (buffer-name (xwidget-buffer xwidget)))))
  44                 :env (list beg end type title width height data)))
  45          (results (parallel-get-results proc)))
  46     (should (parallel-success-p proc))
  47     (when (parallel-success-p proc)
  48       (destructuring-bind (xwidget-buffer temp-buffer xwidget-info)
  49           results
  50         (should (equal (list type title width height)
  51                        xwidget-info))
  52         (should (equal temp-buffer xwidget-buffer))))))
  53
  54 (xwidget-deftest xwidget-query-on-exit-flag ()
  55   (should (equal '(nil t)
  56                  (parallel-get-results
  57                   (parallel-start (lambda ()
  58                                     (require 'xwidget)
  59                                     (let ((xwidget (make-xwidget 1 1 'Button "Button" 100 100 nil)))
  60                                       (parallel-remote-send (xwidget-query-on-exit-flag xwidget))
  61                                       (set-xwidget-query-on-exit-flag xwidget nil)
  62                                       (xwidget-query-on-exit-flag xwidget))))))))
  63
  64 (xwidget-deftest xwidget-query-on-exit-flag (Button ToggleButton slider socket cairo)
  65   (should (parallel-get-result
  66            (parallel-start (lambda (type title)
  67                              (require 'xwidget)
  68                              (with-temp-buffer
  69                                (let ((xwidget (make-xwidget 1 1 type title 10 10 nil)))
  70                                  (set-xwidget-query-on-exit-flag xwidget nil)
  71                                  (xwidgetp xwidget))))
  72                            :env (list type title)))))
  73
  74 (xwidget-deftest xwidget-CHECK_XWIDGET ()
  75   (should (equal (parallel-get-result
  76                   (parallel-start (lambda ()
  77                                     (require 'xwidget)
  78                                     (xwidget-info nil))))
  79                  '(wrong-type-argument xwidgetp nil)))
  80   (should (equal (parallel-get-result
  81                   (parallel-start (lambda ()
  82                                     (require 'xwidget)
  83                                     (xwidget-view-info nil))))
  84                  '(wrong-type-argument xwidget-view-p nil))))
  85
  86 (xwidget-deftest xwidget-view-p (Button ToggleButton slider socket cairo)
  87   (should (parallel-get-result
  88            (parallel-start (lambda (type title)
  89                              (require 'xwidget)
  90                              (with-temp-buffer
  91                                (insert ?\0)
  92                                (let* ((xwidget (xwidget-insert 1 type title 100 100))
  93                                       (window (xwidget-display xwidget)))
  94                                  (set-xwidget-query-on-exit-flag xwidget nil)
  95                                  (xwidget-view-p
  96                                   (xwidget-view-lookup xwidget window)))))
  97                            :env (list type title)
  98                            :graphical t
  99                            :emacs-args '("-T" "emacs-debug")))))
 100
 101 (defun xwidget-interactive-tests ()
 102   "Interactively test Button ToggleButton and slider.
 103
 104 Start Emacs instances and try to insert the xwidget."
 105   (interactive)
 106   (flet ((test-xwidget (type)
 107                        (parallel-get-result
 108                         (parallel-start (lambda ()
 109                                           (require 'xwidget)
 110                                           (with-temp-buffer
 111                                             (insert ?\0)
 112                                             (set-xwidget-query-on-exit-flag
 113                                              (xwidget-insert 1 type (format "%s" type) 100 100) nil)
 114                                             (display-buffer (current-buffer))
 115                                             (cons type (or (y-or-n-p (format "Do you see a %s?" type)) 'failed))))
 116                                         :graphical t
 117                                         :debug t
 118                                         :config xwidget-parallel-config))))
 119     (message "%S" (mapcar #'test-xwidget '(Button ToggleButton slider)))))
 120
 121 (provide 'xwidget-tests)