[plt-scheme] Backwards compatibility?

At Thu, 24 May 2007 19:26:17 -0700, "Mark Engelberg" wrote:
> I have 90+ files with heavy use of the test case boxes.  A script
> would certainly be helpful...

This *should* have worked in v370:

 (require (lib "wxme.ss" "wxme")
          (lib "port.ss"))

 (define (convert-to-text src dest)
   (call-with-output-file dest
     (lambda (out)
      (call-with-input-file src
        (lambda (in)
         (copy-port (wxme-port->text-port in) out))))))

But it looks like "wmxe" test-case-box reading wasn't tested for text
conversion. I fixed it in SVN.

Meanwhile, the hard way works in v370:

  (require (lib "wxme.ss" "wxme")
           (lib "test-case.ss" "wxme")
           (lib "class.ss")
           (lib "port.ss"))

  (define (concat port)
    (if port
        (let loop ([accum null])
          (let ([s (read-bytes 4096 port)])
            (if (eof-object? s)
                (apply bytes-append (reverse accum))
                (loop (cons s accum)))))
        #""))

  (define (convert-to-text src dest)
    (call-with-output-file dest
      (lambda (out)
        (call-with-input-file src
          (lambda (in)
            (let ([in (wxme-port->port in)])
              (let loop ()
                (let ([v (read-char-or-special in)])
                  (unless (eof-object? v)
                    (cond
                     [(v . is-a? . test-case%)
                      (display (bytes-append
                                (concat (send v get-comment))
                                (concat (send v get-test))
                                (concat (send v get-expected))
                                (concat (send v get-predicate))
                                (concat (send v get-should-raise))
                                (concat (send v get-error-message)))
                               out)]
                     [else (display v out)])
                    (loop))))))))))


Matthew