;;;; procedure-decoration-test.scm

(use test)
(use procedure-decoration)

;;;

(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) "test-proc is foo"))
  (test-assert (documented-procedure? test-proc))
  (test "test-proc is foo" (procedure-documentation test-proc))
  (test-assert (test-proc))
)

(test-group "Become? no"
  (define (test-proc) #t)
  (define dctr)
  (define decr-test-proc)

  (test-assert
    (set! dctr
     (make-procedure-decorator (lambda (obj) (and (pair? obj) (eq? 'foo (car obj))))
                               (lambda (_ new) (cons 'foo new))
                               cdr)))

  (test-assert (not (decorated-procedure? test-proc dctr)))
  (test-assert (set! decr-test-proc (decorate-procedure test-proc dctr "test-proc is foo")))
  (test-assert "Procedure did not \"become\"" (not (eq? test-proc decr-test-proc)))
  (test-assert (decorated-procedure? decr-test-proc dctr))
  (test "test-proc is foo" (procedure-decoration decr-test-proc dctr))
  (test-assert (test-proc))
  (test-assert (decr-test-proc))
)