;;;; procedure-decoration-test.scm

(import test)

(import procedure-decoration)

;;;

(define DOCSTR "test-proc is foo")

(test-group "Become? yes"
  (define (test-proc) #t)
  (define-procedure-extender docstring procedure-documentation documented-procedure?)

  (test-assert (not (documented-procedure? test-proc)))
  (test-assert (set! (procedure-documentation test-proc) DOCSTR))
  (test-assert (documented-procedure? test-proc))
  (test DOCSTR (procedure-documentation test-proc))
  (test-assert (test-proc))
)

(test-group "Become? no"
  (define (test-proc) #t)
  (define decr-test-proc)
  (let ((dctr
          (make-procedure-decorator
            (lambda (obj) (and (pair? obj) (eq? 'foo (car obj))))
            (lambda (_ new) (cons 'foo new))
            cdr)) )
    (test-assert "procedure-decorator" dctr)
    (test-assert (not (decorated-procedure? test-proc dctr)))
    (test-assert (set! decr-test-proc (decorate-procedure test-proc dctr DOCSTR)))
    (test-assert "Procedure did not \"become\"" (not (eq? test-proc decr-test-proc)))
    (test-assert (decorated-procedure? decr-test-proc dctr))
    (test DOCSTR (procedure-decoration decr-test-proc dctr))
    (test-assert (test-proc))
    (test-assert (decr-test-proc)) )
)

(test-exit)