;; This reads the stdin, finds the expression (btx-test-suite ...)
;; and evaluates the forms within it.
;; These forms will be mostly (testbtx label function (stack...) (expected)),
;; plus one or two others ignored below.
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2023 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

(module 'unicode)

(define (print-val x)
  (cond ((integer? x) (format #f "#~a" x))
        ((symbol? x)  (format #f "~s" x))
        ((string? x)  (format #f "\"~a\"" x))
        ((ustring? x) (format #f "\"~a\"" x))
        (else
         (format (current-error-port)
                 "extract-bst-tests.scm: odd value in print-val: ~s~%"
                 x))))

;; discard the content of some other forms
(define-macro (discard-content arg . args)
  `())

(let loop ((s (read)))
  (unless (eof-object? s)
    (when (and (list? s) (eqv? (car s) 'btx-test-suite))
      (let ((testbtx (macro (label func input expected)
                       `(begin
                          (format #t "~%~a  % expected"
                                  (print-val (car (list . ,expected))))
                          (for-each (λ (x)
                                      (format #t "~%  ~a" (print-val x)))
                                    (reverse (list . ,input)))
                          (format #t
                                  "~%  ~a~%  ~a~%  ~a~%"
                                  (quote ,func)
                                  (print-val ,label)
                                  (if (integer? (car (list . ,expected)))
                                      "assert.equal.integers"
                                      "assert.equal.strings"))
                          #f)))
            (assert-exception discard-content)
            (testbtx/here discard-content))
        (let eval-forms ((s (cdr s)))
          (unless (null? s)
            (eval (car s))
            (eval-forms (cdr s))))))

    (loop (read))))