xtmtest-with-fixture-body   scheme

(define (xtmtest-with-fixture-body name fixture tests)
  `(let ((fixture-environment ((lambda () (current-environment)))))
     (let ((suite-name ',name))
       (print-with-colors 'cyan 'default #t (print "xtmtest "))
       (print-with-colors 'black 'cyan #t (print "" suite-name))
       (println)
       (eval `(begin
                (define-macro (is? call expected-result . args)
                  (xtmtest-result-body call
                                       expected-result
                                       (list (if (not (null? args))
                                                 (format "~a.~a" ',suite-name (car args))
                                                 (format "~a.is?" ',suite-name))))))
             fixture-environment)
       (catch (xtmtest-update-test-result suite-name 'no-compile ',fixture #f #f)
              (eval ',fixture fixture-environment)
              (eval '(begin ,@tests) fixture-environment)))))