Библиотека функций к Script-fu

Введение

Написание кода на Лисп это тестирование, я не знаю(это не значит что их нет, просто я их действительно не знаю) ни одного языка программирования в котором цикл: написание код - проверка(тестирование) был бы таким коротким. Кстати в Script-fu я работаю через буфер обмена, это не удобно! Там есть возможность работать из Емакс, через сервер Scrip-fu, но я эту возможность не использую(приятно видеть консоль), а с обычной схемой или лиспом, работа в передаче кода заключается в нажатии пары клавиш. Лисперы не пишут многостраничные листинги кода, а затем его тестируют, они пишут функцию, выполняют его в интерпретаторе и сразу тестируют. Всё это благодаря наличию в системе REPL. И всё таки не смотря на это настаёт момент, когда требуются отдельные тесты, которые удобно запустить и проверить консистентное состояние программной системы, а то в процессе такого интенсивного создания-тестирования программы всё равно можно что либо опустить, и какая нибудь функциональность да отвалится.

В нашем случае(в связи со сложностью функционирования комбинаций методов) потребуются тесты проверяющие корректность функционирования обобщённых функций в объектной системе и, по мимо них, правильность обращения к полям объекта, т.е правильность создания самих объектов и т.д. Так что эти тесты будут скорее интеграционными, чем юнит-тестами.

Функции тестирования

Тестирование функциональности всегда сопряжено с риском возникновения какого либо отказа, исключительной ситуации, поэтому для тестирования работы обобщённых функций я написал следующую функцию:

(define *test-rezult* '())
(define-m (push-rez x)
  (push *test-rezult* x))

;;выполняет запуск функции с аргументами и сравнивает результат в функции сравнения.
(define (test-func func args comp-func)
  (set! *test-rezult* '())
  (let ((rez (catch (begin  '())
               (cons (apply func args) '()))))
    (set! *test-rezult* (reverse (cons rez *test-rezult*)))
	(if (not (null? rez))
        (if (apply comp-func (list *test-rezult*))
            (cons #t *test-rezult*)
            (cons #f *test-rezult*))
	    (cons rez *test-rezult*))))

основное назначение которой: перехват внезапного исключения в тестируемой функции и сигнализация об этом(путем возврата пустого списка) вышестоящей функции. Например можно протестировать подобную функцию

тест обычной функции.

(define (t1 x1)
  (/ 10 x1))

(t1 10)
;;1
(t1 0)
;;Error: /: division by zero 

(test-func t1 '(2) (lambda (x) (if (not (null? (car x)))
                               (begin (prn "args: " x "\n") (= (caar x) 5)) 
							   #f)))
;;(#t (5))  результат 5 и это правильно

(test-func t1 '(2) (lambda (x) (if (not (null? (car x)))
                               (begin (prn "args: " x "\n") (= (caar x) 4))
							   #f)))
;;(#f (5)) результат 5 и это не правильно(мы ожидали 4).

(test-func t1 '(0) (lambda (x) (if (not (null? (car x)))
                               (begin (prn "args: " x "\n") (= (caar x) 4))
							   #f)))
;;(() ())# возврат первым элементом пустого списка свидетельствует о произошедшей ошибке

Таким образом наша тестирующая функция различает три возможных ситуации правильно, неправильно и произошедшая ошибка. По мимо этого, по скольку я тестирую вызовы методов которые не возвращают никаких результатов и мне важно знать порядок вызова этих методов, я ввёл глобальную переменную test-rezult, в которую из тестирующих функция я буду производить запись push-rez произвольных данных, и на их основе отслеживать надлежащий порядок вызова методов. Для функции тестирования сделаем обёртку сообщающую нам о результатах тестирования.

(define-m (named-test name func args comp-func)
  (let ((rez (test-func func args comp-func)))
    (cond
     ((null? (car rez))
      (prn "FAIL TEST! (executed error!) `" name "` rez: " (cdr rez) "\n")
	  (throw (join-to-str "FAIL TEST! (executed error!) `" name "`")))
     ((car rez)
      (prn "PASS TEST!: `" name "` rez: " (cdr rez) "\n"))
     ((not (car rez))
      (prn "FAIL TEST! (unexpected rezult) `" name "` rez: " (cdr rez) "\n")
	  (throw (join-to-str  "FAIL TEST! (unexpected rezult) `" name "`")))
     (#t
      (prn "UNKNOWN TEST RESULT `" name "` args: " args ", rez: "  rez "\n")))
    ))


(define-macro (check-equal param)
  (let ((var    (gensym)))
    `(lambda (,var) (equal?  ,param ,var))))

тесты могут располагаться в загружаемом файле, и создавать длинную цепочку. Чтобы не пропустить возникшую ошибку просто будем выкидывать исключение при неудовлетворительном результате тестирования.

(define (test-t1 x)
  (push-rez "Start test")
  (let ((rez (t1 x)))
    (push-rez "End test")
	rez))
	
(named-test "test1 t1" test-t1 '(5) (check-equal '("Start test" "End test" (2))))
;;PASS TEST!: `test1 t1` rez: (Start test End test (2))

(named-test "test1 t1" test-t1 '(0) (check-equal '("Start test" "End test" (2))))
;;FAIL TEST! (executed error!) `test1 t1` rez: (Start test ())
;;Error: FAIL TEST! (executed error!) `test1 t1` 

(named-test "test1 t1" test-t1 '(4) (check-equal '("Start test" "End test" (2))))
;;FAIL TEST! (unexpected rezult) `test1 t1` rez: (Start test End test (2,5.0))
;;Error: FAIL TEST! (unexpected rezult) `test1 t1`

Проверив работоспособность нашей тестирующей системы можно приступать к написанию интеграционных тестов проверяющих функционирование нашей объектной системы.

Класс Object и циклические(взаимнорекурсивные) структуры

В тестах мы проверим правильность создания объектов, правильность работы функций доступа к полям и правильность работы обобщённых функций. Для вывода состояний объекта я использую базовый класс, определённый в файле: obj/object.scm

(defclass Object () ())

(defmethod (to-s (o Object))
  (inspect o nil))

(struct cycle-detect
  (again first-encounter num-enc))

Основное назначение этого класса, это распечатка значений полей объектов, пользуясь интроспекцией. И казалось бы в чём тут может быть проблема? Но суть в том, что объекты могут иметь не только стандартные примитивные поля, но и поля содержащие объекты(или их списки) и иногда эти объекты могут иметь взаимно рекурсивные ссылки. И вот такие объекты уже стандартыным обходом полей не распечатать, нужно использовать алгоритм определения циклов в структурах данных, что и делает функция inspect.(в статье я не использую такие структуры, но может быть как нибудь при случае расскажу и о них).

inspect

(defmethod (inspect (obj Object) cycle)
  ;;(prn "inspect Object!\n" "cycle: " cycle "\n")
  (when (not (cycle-detect? cycle))
    (set! cycle (cycle-detect! (build-storage-points-cycle obj)
                               (make-storage 16 (lambda (x el) (eq? (car x) el)))
                               0)))
  ;;(prn "inspect Object!\n" "cycle: " cycle "\n")
  (let* ((again           (cycle-detect-again           cycle))
         (first-encounter (cycle-detect-first-encounter cycle))
         (type   (type-obj obj))
         (f1 (get-class-fields-all type))
         (fields (if (not (null? f1))
                     (sort-symb< (map (lambda (x) (sym2key (if (pair? x)
                                                               (car x)
                                                               x)))
                                      f1))
                     f1))
         (to-str-rec
          (lambda (cur)
            (cond
             ((string? cur) cur)
             ((null?   cur) "()")
             ((boolean? cur) (if cur "#t" "#f"))
             ((closure? cur) (string-append "#CLOSURE" (to-str-rec (get-closure-code cur))) )
             ((and (atom? cur)
                   (not (vector? cur))) (atom->string cur))
             ((or (list? cur) (vector? cur) (pair? cur))
              ;;(prn "find list or vector or pair\n")
              (let ((f-enc (storage-ref first-encounter cur)))
                ;;(prn "element again used: " (car f-enc) "\n")
                (if (car f-enc) ;;уже встречался!!!
                    (string-append "#" (atom->string (cdr (cdr f-enc))) "#") ;;вместо элемента будет ссылка на него!
                    (let ((cur-again (storage-ref again cur))) ;;может элемент из циклич. ссылок?
                      ;;(prn "element may by again: " (car cur-again) "\n")
                      (when (car cur-again) ;;да? а ведь это первое наше вхождение!
                        (cycle-detect-num-enc! cycle (+ 1 (cycle-detect-num-enc cycle))) ;;установим его номер
                        (storage-add first-encounter (cons cur (cycle-detect-num-enc cycle)))) ;;и запомним что первое вхождение уже было!
                      (let ((ret
                             (cond
                              ((list? cur)
                               (string-append "(" (apply string-append (insert-between-elements (map to-str-rec cur) " ")) ")"))
                              ((hash? cur)
                               ;;(prn "Cur is hash: " cur "\n")
                               (string-append "#{" (apply string-append (insert-between-elements (map to-str-rec (hash2pairs cur)) " ")) "}"))
                              ((object? cur)
                               (inspect cur cycle))
                              ((vector? cur)
                               (string-append "#(" (apply string-append (insert-between-elements (map to-str-rec (vector->list cur)) " ")) ")"))
                              ((pair? cur)
                               (let ((splt (split-pairs-to-list cur)))
                                 (string-append "(" (apply string-append (insert-between-elements (map to-str-rec (car splt)) " "))
                                                (if (null? (cdr splt))
                                                    ""
                                                    (string-append " . " (to-str-rec (cadr splt))))
                                                ")")))
                              )))
                        (if (car cur-again)
                            (string-append "#" (atom->string (cdr (cdr (storage-ref first-encounter cur)))) "=" ret) ;;поставим метку!
                            ret))) ;;обычный не циклический список
                  )))
             
             (#t "-bad element-")
             ))))
    (let ((rez '()))
      (for-list (f fields)
                (push rez (string-append (to-str f) ": " (to-str-rec (vfield obj f)))))
      (join-to-str "#" type "[" (apply join-to-str (insert-between-elements (reverse rez) ", ")) "]"))
  ))

Ну а что такое циклическая структура? Структура которая может содержать ссылку на саму себя, прямо или косвенно.

(define end-list    (cons 13 '()))
(define cyclic-list (append '(1 2 3 4) end-list))
cyclic-list
;;(1 2 3 4 13)
(begin
  (set-car! end-list cyclic-list) ;;не выполняйте без окружения begin, иначе репл попытается вывести это в консоль и за
  #t)
(to-str* cyclic-list)
;;"#1=(1 2 3 4 #1#)"

;;простейшая циклическая структура:
(define simple-cycle    (cons 13 '()))
(begin
  (set-car! simple-cycle simple-cycle) ;;не выполняйте без окружения begin, иначе репл попытается вывести это в консоль
  #t)
(prn* simple-cycle)
;;#1=(#1#)

важно отметить данным алгоритмом обрабатываются не все циклические структуры, а только те в которых ссылки содержат значащие элементы структуры(т.е те в которых должны содержаться значения). т.е для списков это car элементы, если цикл содержит cdr элементы алгоритм работать не будет(зависнет просто и вывалится из за нехватки памяти).

Интеграционные тесты

Подготовка к тестированию

;;(define path-home "D:")
(define path-home (getenv "HOME"))
(define path-lib (string-append path-home "/work/gimp/lib/"))
(define path-work (string-append path-home "/work/gimp/"))
(load (string-append path-lib "util.scm"))
(load (string-append path-lib "defun.scm"))
(load (string-append path-lib "struct2.scm"))
(load (string-append path-lib "storage.scm"))
(load (string-append path-lib "cyclic.scm"))
(load (string-append path-lib "hashtable3.scm")) ;;хеш который может работать с объектами в качестве ключей!!!
(load (string-append path-lib "sort2.scm"))
(load (string-append path-lib "tsort.scm"))
;;(load (string-append path-lib "cpl-sbcl.scm"))  ;;можно выбрать любую из функций упорядочения иерархии классов.
(load (string-append path-lib "cpl-mro.scm"))
;;(load (string-append path-lib "cpl-topext.scm"))
(load (string-append path-lib "struct2ext.scm"))
(load (string-append path-lib "queue.scm"))
(load (string-append path-lib "obj4.scm"))
(load (string-append path-lib "obj/object.scm"))
(load (string-append path-lib "tests.scm"))

Что представляют из себя тесты для объектной системы? Это определение иерархии, определение методов обобщённых функций и собственно их вызов и сверка результатов, что получилось и что должно быть.

;;чтобы не вводить одну и туже иерархию десять раз напишу макрос определяющий иерархию
(define-macro (deftest-obj1)
  `(begin
     (defclass a (Object)
       (a))
     (defclass b (a)
       (b))
     (defclass c (a)
       (c))
     (defclass d (b c)
       (d))))

;;TEST before
(deftest-obj1) ;; определение иерархии
(defgeneric test-a x)
(defmethod (:before test-a (x a))
  (push-rez (join-to-str ":before test-a (x a), x: " (to-s x))))

(named-test "test :before" test-a (list (make-a :a 12)) (check-equal '(":before test-a (x a), x: #a[:a: 12]" (#f))))
(named-test "test2 :before" test-a (list (make-d :a 1 :b 2 :c 3 :d 4)) (check-equal '(":before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]" (#f))))
;;PASS TEST!: `test :before` rez: (:before test-a (x a), x: #a[:a: 12] (#f))
;;PASS TEST!: `test2 :before` rez: (:before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] (#f))

;;TEST before before

(defmethod (:before test-a (x d))
  (push-rez (join-to-str ":before test-a (x d)")))

(named-test "test3 :before" test-a (list (make-a :a 12)) (check-equal '(":before test-a (x a), x: #a[:a: 12]" (#f))))
(named-test "test4 :before" test-a (list (make-d :a 1 :b 2 :c 3 :d 4))
            (check-equal '(":before test-a (x d)" ":before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]" (#f))))
;;PASS TEST!: `test3 :before` rez: (:before test-a (x a), x: #a[:a: 12])
;;PASS TEST!: `test4 :before` rez: (:before test-a (x d) :before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] (#f))

все тесты приводить не буду, но вот последний тест тестирующий сложную комбинацию методов обобщённой функции

;подготовка к большому тесту с различными комбинациями методов с различными квалификаторами и более простые тесты

;;around around primary primary after after after before before before
(deftest-obj1)
(defgeneric test-a x)

(defmethod (:before test-a (x a))
  (push-rez (join-to-str ":before test-a (x a), x: " (to-s x))))

(defmethod (:after test-a (x a))
  (push-rez (join-to-str ":after test-a (x a), x: " (to-s x))))


(defmethod (:around test-a (x a))
  (push-rez (join-to-str ":around test-a (x a), x: " (to-s x)))
  (if (next-method-p)
      (call-next-method)
      (vfield x :a)))

(defmethod (:around test-a (x d))
  (push-rez (join-to-str ":around test-a (x d), x: " (to-s x)))
  (if (next-method-p)
      (call-next-method)
      (vfield x :d)))

(named-test "test comb" test-a (list (make-a :a 12))
            (check-equal '(":around test-a (x a), x: #a[:a: 12]" ":before test-a (x a), x: #a[:a: 12]"
                           ":after test-a (x a), x: #a[:a: 12]" (#f))))

(named-test "test comb" test-a (list (make-c :a 12 :c 13))
            (check-equal '(":around test-a (x a), x: #c[:a: 12, :c: 13]" ":before test-a (x a), x: #c[:a: 12, :c: 13]"
                           ":after test-a (x a), x: #c[:a: 12, :c: 13]" (#f))))

(defmethod (test-a (x a))
  (push-rez (join-to-str ":primary test-a (x a), x: " (to-s x)))
  (if (next-method-p)
      (call-next-method)
      (vfield x :a)))

(defmethod (test-a (x d))
  (push-rez (join-to-str ":primary test-a (x d), x: " (to-s x)))
  (if (next-method-p)
      (call-next-method)
      (vfield x :d)))

(named-test "test comb3" test-a (list (make-a :a 12))
            (check-equal '(":around test-a (x a), x: #a[:a: 12]" ":before test-a (x a), x: #a[:a: 12]"
                           ":primary test-a (x a), x: #a[:a: 12]" ":after test-a (x a), x: #a[:a: 12]" (12))))


(named-test "test comb4" test-a (list (make-d :a 1 :b 2 :c 3 :d 4))
            (check-equal '(":around test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":around test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":primary test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":primary test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":after test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]" (1))))

(defmethod (:before test-a (x b))
  (push-rez (join-to-str ":before test-a (x b), x: " (to-s x))))

(defmethod (:after test-a (x b))
  (push-rez (join-to-str ":after test-a (x b), x: " (to-s x))))


(defmethod (:before test-a (x d))
  (push-rez (join-to-str ":before test-a (x d), x: " (to-s x))))

(defmethod (:after test-a (x d))
  (push-rez (join-to-str ":after test-a (x d), x: " (to-s x))))


(named-test "test comb5" test-a (list (make-b :a 1 :b 2))
            (check-equal '(":around test-a (x a), x: #b[:a: 1, :b: 2]"
                           ":before test-a (x b), x: #b[:a: 1, :b: 2]"
                           ":before test-a (x a), x: #b[:a: 1, :b: 2]"
                           ":primary test-a (x a), x: #b[:a: 1, :b: 2]"
                           ":after test-a (x a), x: #b[:a: 1, :b: 2]"
                           ":after test-a (x b), x: #b[:a: 1, :b: 2]" (1))))


(named-test "test comb6" test-a (list (make-c :a 1 :c 3))
            (check-equal '(":around test-a (x a), x: #c[:a: 1, :c: 3]"
                           ":before test-a (x a), x: #c[:a: 1, :c: 3]"
                           ":primary test-a (x a), x: #c[:a: 1, :c: 3]"
                           ":after test-a (x a), x: #c[:a: 1, :c: 3]" (1))))

результаты запуска предварительных тестов.

;;PASS TEST!: `test comb` rez: (:around test-a (x a), x: #a[:a: 12] :before test-a (x a), x: #a[:a: 12] :after test-a (x a), x: #a[:a: 12] (#f))
;;PASS TEST!: `test comb` rez: (:around test-a (x a), x: #c[:a: 12, :c: 13]
;;                              :before test-a (x a), x: #c[:a: 12, :c: 13] :after test-a (x a), x: #c[:a: 12, :c: 13] (#f))


;; PASS TEST!: `test comb3` rez: (:around test-a (x a), x: #a[:a: 12]
;;                                :before test-a (x a), x: #a[:a: 12]
;;                                :primary test-a (x a), x: #a[:a: 12]
;;                                :after test-a (x a), x: #a[:a: 12] (12))


;; PASS TEST!: `test comb4` rez: (:around test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                        :around test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                        :before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                        :primary test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                        :primary test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                        :after test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] (1))


;; PASS TEST!: `test comb5` rez: (:around test-a (x a), x: #b[:a: 1, :b: 2]
;;                                        :before test-a (x b), x: #b[:a: 1, :b: 2]
;;                                        :before test-a (x a), x: #b[:a: 1, :b: 2]
;;                                        :primary test-a (x a), x: #b[:a: 1, :b: 2]
;;                                        :after test-a (x a), x: #b[:a: 1, :b: 2]
;;                                        :after test-a (x b), x: #b[:a: 1, :b: 2] (1))

;; PASS TEST!: `test comb6` rez: (:around test-a (x a), x: #c[:a: 1, :c: 3]
;;                                        :before test-a (x a), x: #c[:a: 1, :c: 3]
;;                                        :primary test-a (x a), x: #c[:a: 1, :c: 3]
;;                                        :after test-a (x a), x: #c[:a: 1, :c: 3] (1))

А вот и сам большой тест и его результат. Как видите вызов одной функции test-a с параметором объектом класс d приводит к вызову целой цепочки методов.

(named-test "test comb7" test-a (list (make-d :a 1 :b 2 :c 3 :d 4))
            (check-equal '(":around test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":around test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":before test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":before test-a (x b), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":primary test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":primary test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":after test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":after test-a (x b), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]"
                           ":after test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]" (1))))


;; PASS TEST!: `test comb7` rez: (:around test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :around test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :before test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :before test-a (x b), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :primary test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :primary test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :after test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :after test-a (x b), x: #d[:a: 1, :b: 2, :c: 3, :d: 4]
;;                                :after test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] (1))

и вот сводим все тесты в один файл:

(load (string-append path-work "test-obj4.scm"))

deftest-obj1#tPASS TEST!: `test :before` rez: (:before test-a (x a), x: #a[:a: 12] (#f))
...
...
#tPASS TEST!: `test comb7` rez: (:around test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :around test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :before test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :before test-a (x b), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :before test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :primary test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :primary test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :after test-a (x a), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :after test-a (x b), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] :after test-a (x d), x: #d[:a: 1, :b: 2, :c: 3, :d: 4] (1))
#t##t#

И если мы где-то, для теста, поставим какое то некорректное значение или вызовем некорректную операцию, например:

(defmethod (test-a (x a))
  (push-rez (join-to-str ":primary test-a (x a), x: " (to-s x)))
  (/ 10 0)
  ;;(push-rez (join-to-str "ops!"))
  (if (next-method-p)
      (call-next-method)
      (vfield x :a)))

То цепочка тестов прервётся приблизительно с таким вот сообщением:

#t#tFAIL TEST! (unexpected rezult) `test comb3` rez: (:around test-a (x a), x: #a[:a: 12] :before test-a (x a), x: #a[:a: 12] :primary test-a (x a), x: #a[:a: 12] ops! :after test-a (x a), x: #a[:a: 12] (12))
Error: FAIL TEST! (unexpected rezult) `test comb3`

Выводы

Без создания и использования тестирующей системы большой проект развиваться, да и существовать, просто не может. Создание набора тестов создаёт тестовый ИНВАРИАНТ программной системы, применение которого даст ответ при изменениях в проекте, это всё ещё наша система или уже нет. Если обнаруживаются ошибки или случаи, которые не отслеживает наш инвариант, то его расширяют соответствующим набором тестов и приводят код в состояние удовлетворяющему новому тестовому инварианту системы. И мы СМОГЛИ внедрить тестирующую систему в наш проект, так что за правильность функционирования диспетчеризации, в условиях изменения проекта, можно быть спокойным. Ну а без тестов, как говориться: «то лапы ломит, то хвост отваливается, а недавно я ещё линять начал... и т. д.».

GIMP Script-Fu ООП. Тестирование на «РОМБЕ СМЕРТИ»