move test-numeric-syntax to r7rs-tests.scm. test-numeric-syntax is a

test runner specific to r7rs-tests.scm. It should not be placed in
generic test library.
This commit is contained in:
Yuichi Nishiwaki 2014-07-27 12:46:10 +09:00
parent b7c76ccc2a
commit 01061efc5a
2 changed files with 11 additions and 11 deletions

View File

@ -83,19 +83,10 @@
(syntax-rules () (syntax-rules ()
((_) (syntax-error "invalid use of test-syntax-error")))) ((_) (syntax-error "invalid use of test-syntax-error"))))
(define-syntax test-numeric-syntax
(syntax-rules ()
((test-numeric-syntax str expect strs ...)
(let* ((z (read (open-input-string str)))
(out (open-output-string))
(z-str (begin (write z out) (get-output-string out))))
(test expect (values z))
(test #t (and (member z-str '(str strs ...)) #t))))))
;; (define (test-read-error str) ;; (define (test-read-error str)
;; (test-assert ;; (test-assert
;; (guard (exn (else #t)) ;; (guard (exn (else #t))
;; (read (open-input-string str)) ;; (read (open-input-string str))
;; #f))) ;; #f)))
(export test test-begin test-end test-values test-exit test-syntax-error test-numeric-syntax)
) (export test test-begin test-end test-values test-exit test-syntax-error))

View File

@ -2068,6 +2068,15 @@
(test-begin "Numeric syntax") (test-begin "Numeric syntax")
(define-syntax test-numeric-syntax
(syntax-rules ()
((test-numeric-syntax str expect strs ...)
(let* ((z (read (open-input-string str)))
(out (open-output-string))
(z-str (begin (write z out) (get-output-string out))))
(test expect (values z))
(test #t (and (member z-str '(str strs ...)) #t))))))
;; Simple ;; Simple
(test-numeric-syntax "1" 1) (test-numeric-syntax "1" 1)
;; (test-numeric-syntax "+1" 1 "1") ;; (test-numeric-syntax "+1" 1 "1")