glib/gobject.type-tests.lisp

   1 (defpackage #:gtype-tests
   2   (:use #:cl #:iter #:gobject #:gobject.ffi #:5am)
   3   (:export #:run-all-tests)
   4   (:import-from #:gobject.ffi #:%gtype #:gtype #:gtype-name #:gtype-%id #:gtype-id #:invalidate-gtypes))
   5
   6 (in-package #:gtype-tests)
   7
   8 (def-suite gtype)
   9
  10 (in-suite gtype)
  11
  12 (defun run-all-tests ()
  13   (run! 'gtype))
  14
  15 ;; Normal things
  16
  17 (test normal.1
  18   (finishes (%gtype "gint"))
  19   (finishes (%gtype "glong"))
  20   (finishes (%gtype +g-type-pointer+)))
  21
  22 (test normal.eq
  23   (is (eq (%gtype "gint") (%gtype "gint")))
  24   (is (eq (%gtype "GObject") (%gtype "GObject")))
  25   (is (not (eq (%gtype "gint") (%gtype "GObject"))))
  26   (is (eq (%gtype "gchararray") (%gtype +g-type-string+))))
  27
  28 (test normal.boundary
  29   (is (null (%gtype 0)))
  30   (is (null (%gtype nil)))
  31   (signals warning (%gtype "foobarbaz"))
  32   (signals error (%gtype 1)))
  33
  34 (test normal.trans
  35   (is (string= (gtype-name (%gtype "gint")) "gint"))
  36   (is (eql (gtype-id (%gtype "gint")) +g-type-int+)))
  37
  38 ;; Clear mappings
  39
  40 (test clear.simple
  41   (let ((type (%gtype "gint")))
  42     (is (eql (gtype-id type) +g-type-int+))
  43     (invalidate-gtypes)
  44     (is (null (gtype-%id type)))
  45     (is (eql (gtype-id type) +g-type-int+))
  46     (invalidate-gtypes)
  47     (is (eq type (%gtype "gint")))
  48     (invalidate-gtypes)
  49     (is (eq type (%gtype +g-type-int+)))))
  50
  51 (test clear.1
  52   (let ((type (%gtype "gint")))
  53     (invalidate-gtypes)
  54     (is (null (gtype-%id type)))
  55     (%gtype +g-type-int+)
  56     (is (not (null (gethash +g-type-int+ gobject.ffi::*id-to-gtype*))))
  57     (is (not (null (gtype-%id type))))))
  58
  59 ;; Core saving
  60
  61 (defvar *gi* (%gtype +g-type-int+))
  62
  63 (test core.saving
  64   (is (eq *gi* (%gtype +g-type-int+)))
  65   (is (eq (gtype +g-type-int+) (%gtype +g-type-int+))))