[plt-scheme] Catch an unknown method error

Better macro (& tests) is below.  It was fun.  Had I the time I'd write it up.

File test.scm:

#lang scheme/base

(require (rename-in scheme/class [send c:send]
                                 [send/apply c:send/apply]))
(require (for-syntax scheme/base))

(provide send)

(define (forwardable? obj args-length)
  (lambda (e)
    (and (exn:fail:object? e)
         (regexp-match #rx"no such method" (exn-message e))
         (object-method-arity-includes?
          obj
          'forward-invocation (add1 args-length)))))

(define (forward obj name args)
  (lambda (e)
    (printf "No such method: ~a for object ~a with args: ~a, forwarding.~%"
            name obj args)
    (c:send/apply obj forward-invocation name args)))

(define-syntax (send stx)
  (syntax-case stx ()
    [(_ obj name arg ...)
     ;; Make the temporary names we'll bind values to
     (with-syntax
         ([obj-name       (datum->syntax stx (gensym))]
          [(arg-name ...) (datum->syntax
                           stx
                           (map gensym (syntax->datum (syntax (arg ...)))))]
          [args-length    (datum->syntax
                           stx
                           (length (syntax->datum (syntax (arg ...)))))])
       ;; Bind the arguments to names, so we only evaluate once
       (syntax
        (let ([obj-name obj]
              [arg-name arg] ...)
          (with-handlers ([(forwardable? obj-name args-length)
                           (forward obj-name 'name (list arg-name ...))])
            (c:send obj-name name arg-name ...)))))]))


File test-test.scm:

#lang scheme/base

(require
 (except-in scheme/class send)
 (planet "test.ss" ("schematics" "schemeunit.plt" 2))
 (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
 (file "test.scm"))

(provide test-tests)

(define test-tests
  (test-suite
   "All tests for test"

   (test-case
    "exception raised on unknown method and no forward-invocation method"
    (check-exn exn:fail:object?
               (lambda () (send (new object%) ola))))

   (test-case
    "forward-invocation method is passed unknown methods"
    (let ([a% (class object% (super-new)
                (define/public (forward-invocation name . args)
                  (printf "Method: ~a args: ~a~%" name args)
                  'got-it))])
      (check-eq? (send (new a%) hi) 'got-it)))
   ))

(test/text-ui test-tests)