[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Scheme-reports] R7RS test suite?
- To: Alex Shinn <alexshinn@x>
- Subject: Re: [Scheme-reports] R7RS test suite?
- From: Per Bothner <per@x>
- Date: Fri, 06 Sep 2013 13:25:48 -0700
- Cc: scheme-reports <scheme-reports@x>
- In-reply-to: <CAMMPzYMfUWus-Bue5rewO7=ZwfwdigbO5swTVtNq9YtbrmBRWQ@mail.gmail.com>
- References: <5222380E.9070801@bothner.com> <CAMMPzYMfUWus-Bue5rewO7=ZwfwdigbO5swTVtNq9YtbrmBRWQ@mail.gmail.com>
I've attached FYI the diffs between the r7rs-tsest.scm versions
in the Chibi repository and what I just checked into the Kawa repository.
The latter now runs "cleanly" in that non-working functionality
is either disabled or marked as "failure expected".
The patches I think you might want to incorporate are the
write and write-shared tests with datum labels.
Kawa starts with #1, while Chibi starts with #0.
I could change Kawa if starting with #0 is considered "normal".
(I just have this vague feeling that #0 is similar to
regex back-references that refer to the whole string,
and so perhaps should be used for that conventionally.
Not a very good reason, I admit.)
There are also a few places where I changed the expected
value from integer to floating-point, like for the
result of (sqrt 4).
--
--Per Bothner
per@x http://per.bothner.com/
--- /home/bothner/Scheme/chibi-scheme/tests/r7rs-tests.scm 2013-09-02 09:17:15.048966081 -0700
+++ ./r7rs-tests.scm 2013-09-06 13:15:58.552949222 -0700
@@ -1,14 +1,47 @@
;; -*- coding: utf-8 -*-
-(import (scheme base) (scheme char) (scheme lazy)
- (scheme inexact) (scheme complex) (scheme time)
- (scheme file) (scheme read) (scheme write)
- (scheme eval) (scheme process-context) (scheme case-lambda)
- (scheme r5rs)
- (chibi test))
-
-;; R7RS test suite. Currently assumes full-unicode support, the full
-;; numeric tower and all standard libraries provided.
+#|
+(cond-expand
+ (not (kawa
+ (import (scheme base) (scheme char) (scheme lazy)
+ (scheme inexact) (scheme complex) (scheme time)
+ (scheme file) (scheme read) (scheme write)
+ (scheme eval) (scheme process-context) (scheme case-lambda)
+ (scheme r5rs)
+ (chibi test)))))
+|#
+(define-syntax skip-if-kawa
+ (syntax-rules ()
+ ((skip-if-kawa message . rest)
+ (begin (test-expect-fail 1)
+ (test-assert message #f)))))
+
+;; Using 3-operand datum->syntax enables line numbers in reporting.
+(define-syntax test
+ (lambda (form)
+ (syntax-case form ()
+ ;; We need to use the rest1 and rest2 variables since the Kawa reader
+ ;; currently only attaches line-numbers to pairs, and the quoted and
+ ;; evaluated sub-forms aren't guaranteed to be lists.
+ ((test expected . rest1)
+ (syntax-case #'rest1 ()
+ ((expr)
+ #`(let ((val expr) (exp expected))
+ (cond ((and (complex? exp) (complex? val)
+ (inexact? exp) (inexact? val)
+ (not (nan? exp)) (not (nan? val)))
+ #,(datum->syntax form
+ #'(test-approximate exp val 0.000001)
+ #'rest1))
+ (else
+ #,(datum->syntax form
+ #'(test-equal exp val)
+ #'rest1))))))))))
+
+;; R7RS test suite. Covers all procedures and syntax in the small
+;; language except `delete-file'. Currently assumes full-unicode
+;; support, the full numeric tower and all standard libraries
+;; provided.
;;
;; Uses the (chibi test) library which is written in portable R7RS.
;; This provides test-begin, test-end and test, which could be defined
@@ -151,6 +184,7 @@
(even? (- n 1))))))
(even? 88)))
+(skip-if-kawa "letrec* not implemented"
(test 5
(letrec* ((p
(lambda (x)
@@ -163,6 +197,7 @@
(x (p 5))
(y x))
y))
+)
(let*-values (((root rem) (exact-integer-sqrt 32)))
(test 35 (* root rem)))
@@ -243,6 +278,7 @@
(test 2 (head (tail (tail integers))))
+(skip-if-kawa "delay-force not implemented"
(define (stream-filter p? s)
(delay-force
(if (null? (force s))
@@ -265,6 +301,7 @@
(force p)))))
(test 6 (force p))
(test 6 (begin (set! x 10) (force p))))
+)
(define radix
(make-parameter
@@ -282,7 +319,8 @@
(test '(list 3 4) `(list ,(+ 1 2) 4))
(let ((name 'a)) (test '(list a (quote a)) `(list ,name ',name)))
(test '(a 3 4 5 6 b) `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
-(test #(10 5 2 4 3 8) `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8))
+(cond (kawa (test #(10 5 2.0 4.0 3.0 8) `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8)))
+ (else (test #(10 5 2 4 3 8) `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8))))
(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
`(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) )
(let ((name1 'x)
@@ -356,6 +394,9 @@
(if y)
y))))
+(cond-expand
+ (kawa (begin))
+ (else
(define-syntax be-like-begin
(syntax-rules ()
((be-like-begin name)
@@ -365,6 +406,7 @@
(begin expr (... ...))))))))
(be-like-begin sequence)
(test 4 (sequence 1 2 3 4))
+))
(test 'ok (let ((=> #f)) (cond (#t => 'ok))))
@@ -383,6 +425,7 @@
(define bar (lambda (a b) (+ (* a b) a)))
(foo (+ x 3))))
+(skip-if-kawa "define-values not implemented"
(test 'ok
(let ()
(define-values () (values))
@@ -407,6 +450,7 @@
(let ()
(define-values (x y . z) (values 1 2 3 4))
(+ x y (car z) (cadr z))))
+)
(test '(2 1) (let ((x 1) (y 2))
(define-syntax swap!
@@ -519,14 +563,16 @@
(test #t (exact? #e3.0))
(test #t (inexact? 3.))
+(skip-if-kawa "exact-integer? not implemented"
(test #t (exact-integer? 32))
(test #f (exact-integer? 32.0))
(test #f (exact-integer? 32/5))
-
+)
(test #t (finite? 3))
(test #f (finite? +inf.0))
+(skip-if-kawa "3.0+inf.0i syntax not recognized"
(test #f (finite? 3.0+inf.0i))
-
+)
(test #f (infinite? 3))
(test #t (infinite? +inf.0))
(test #f (infinite? +nan.0))
@@ -641,6 +687,7 @@
(test 7 (abs -7))
(test 7 (abs 7))
+(skip-if-kawa "floor/ etc not implemented"
(test-values (values 2 1) (floor/ 5 2))
(test-values (values -3 1) (floor/ -5 2))
(test-values (values -3 -1) (floor/ 5 -2))
@@ -650,6 +697,7 @@
(test-values (values -2 1) (truncate/ 5 -2))
(test-values (values 2 -1) (truncate/ -5 -2))
(test-values (values 2.0 -1.0) (truncate/ -5.0 -2))
+)
(test 1 (modulo 13 4))
(test 1 (remainder 13 4))
@@ -668,16 +716,20 @@
(test 4 (gcd 32 -36))
(test 0 (gcd))
(test 288 (lcm 32 -36))
+(skip-if-kawa "lcm not implemented for inexacts"
(test 288.0 (lcm 32.0 -36))
+)
(test 1 (lcm))
(test 3 (numerator (/ 6 4)))
(test 2 (denominator (/ 6 4)))
+(skip-if-kawa "denominator not implemented for inexacts"
(test 2.0 (denominator (inexact (/ 6 4))))
(test 11.0 (numerator 5.5))
(test 2.0 (denominator 5.5))
(test 5.0 (numerator 5.0))
(test 1.0 (denominator 5.0))
+)
(test -5.0 (floor -4.3))
(test -4.0 (ceiling -4.3))
@@ -731,9 +783,9 @@
(test 1764 (square 42))
(test 4 (square 2))
-(test 3 (sqrt 9))
+(test 3.0 (sqrt 9))
(test 1.4142135623731 (sqrt 2))
-(test +i (sqrt -1))
+(test +1.0i (sqrt -1))
(test '(2 0) (call-with-values (lambda () (exact-integer-sqrt 4)) list))
(test '(2 1) (call-with-values (lambda () (exact-integer-sqrt 5)) list))
@@ -853,10 +905,12 @@
(test 'c (list-ref '(a b c d)
(exact (round 1.8))))
+(skip-if-kawa "list-set! not implemented"
(test '(0 ("Sue" "Sue") "Anna")
(let ((lst (list 0 '(2 2 2 2) "Anna")))
(list-set! lst 1 '("Sue" "Sue"))
lst))
+)
(test '(a b c) (memq 'a '(a b c)))
(test '(b c) (memq 'b '(a b c)))
@@ -877,7 +931,9 @@
(test '(2 4) (assoc 2.0 '((1 1) (2 4) (3 9)) =))
(test '(5 7) (assv 5 '((2 3) (5 7) (11 13))))
+(skip-if-kawa "list-copy not implemented"
(test '(1 2 3) (list-copy '(1 2 3)))
+)
(test-end)
@@ -1345,6 +1401,7 @@
(set-cdr! (cddr ls1) ls1)
(map * ls1 ls2)))
+(skip-if-kawa "string-map not implemented"
(test "abdegh" (string-map char-foldcase "AbdEgH"))
(test "IBM" (string-map
@@ -1357,6 +1414,7 @@
(lambda (c k) (if (eqv? k #\u) (char-upcase c) (char-downcase c)))
"studlycaps xxx"
"ululululul"))
+)
(test #(b e h) (vector-map cadr '#((a b) (d e) (g h))))
@@ -1398,11 +1456,13 @@
"abcde")
v))
+(skip-if-kawa "list-set! not implemented"
(test '(0 1 4 9 16) (let ((v (make-list 5)))
(vector-for-each
(lambda (i) (list-set! v i (* i i)))
'#(0 1 2 3 4))
v))
+)
(test -3 (call-with-current-continuation
(lambda (exit)
@@ -1433,6 +1493,7 @@
(test -1 (call-with-values * -))
+(skip-if-kawa "multi-used continuation"
(test '(connect talk1 disconnect
connect talk2 disconnect)
(let ((path '())
@@ -1450,51 +1511,62 @@
(if (< (length path) 4)
(c 'talk2)
(reverse path)))))
+)
(test-end)
(test-begin "6.11 Exceptions")
+(skip-if-kawa "with-exception-handler and raise-continuable not implemented"
(test 65
(with-exception-handler
(lambda (con) 42)
(lambda ()
(+ (raise-continuable "should be a number")
23))))
+)
+(skip-if-kawa "error-object?, error-object-message, error-object-irritants, guard not implemented"
(test #t
(error-object? (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
(test "BOOM!"
(error-object-message (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
(test '(1 2 3)
(error-object-irritants (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
+)
+(skip-if-kawa "file-error? and guard not implemented"
(test #f
(file-error? (guard (exn (else exn)) (error "BOOM!"))))
(test #t
(file-error? (guard (exn (else exn)) (open-input-file " no such file "))))
+)
+(skip-if-kawa "read-error? and guard not implemented"
(test #f
(read-error? (guard (exn (else exn)) (error "BOOM!"))))
(test #t
(read-error? (guard (exn (else exn)) (read (open-input-string ")")))))
+)
(test-end)
(test-begin "6.12 Environments and evaluation")
-;; (test 21 (eval '(* 7 3) (scheme-report-environment 5)))
+(test 21 (eval '(* 7 3) (scheme-report-environment 5)))
(test 20
(let ((f (eval '(lambda (f x) (f x x)) (null-environment 5))))
(f + 10)))
+(skip-if-kawa "evironment not implemented"
(test 1024 (eval '(expt 2 10) (environment '(scheme base))))
(test 0.0 (eval '(sin 0) (environment '(scheme inexact))))
(test 1024.0 (eval '(+ (expt 2 10) (sin 0))
(environment '(scheme base) '(scheme inexact))))
-(test-end)
+
+)(test-end)
(test-begin "6.13 Input and output")
@@ -1642,12 +1714,14 @@
(flush-output-port out)
(get-output-bytevector out)))
-(test "#0=(1 . #0#)" ;; not guaranteed to be 0 indexed, spacing may differ
- (let ((out (open-output-string))
- (x (list 1)))
- (set-cdr! x x)
- (write x out)
- (get-output-string out)))
+(test #f
+ (not (member
+ (let ((out (open-output-string))
+ (x (list 1)))
+ (set-cdr! x x)
+ (write x out)
+ (get-output-string out))
+ '("#0=(1 . #0#)" "#1=(1 . #1#)"))))
(test "((1 2 3) (1 2 3))"
(let ((out (open-output-string))
@@ -1661,11 +1735,13 @@
(write-simple (list x x) out)
(get-output-string out)))
-(test "(#0=(1 2 3) #0#)"
- (let ((out (open-output-string))
- (x (list 1 2 3)))
- (write-shared (list x x) out)
- (get-output-string out)))
+(test #f
+ (not (member
+ (let ((out (open-output-string))
+ (x (list 1 2 3)))
+ (write-shared (list x x) out)
+ (get-output-string out))
+ '("(#0=(1 2 3) #0#)" "(#1=(1 2 3) #1#)"))))
(test-begin "Read syntax")
@@ -1875,8 +1951,10 @@
(test-numeric-syntax "#o-10" -8 "-8")
(test-numeric-syntax "#b-10" -2 "-2")
;; Combination of prefixes
+(skip-if-kawa "combination of prefixes broken"
(test-numeric-syntax "#e#x10" 16 "16")
(test-numeric-syntax "#i#x10" 16.0 "16.0" "16.")
+)
;; (Attempted) decimal notation with base prefixes
(test-numeric-syntax "#d1." 1.0 "1.0" "1.")
(test-numeric-syntax "#d.1" 0.1 "0.1" ".1" "100.0e-3")
@@ -1927,14 +2005,17 @@
(test #t (exact? (jiffies-per-second)))
(test #t (list? (features)))
+(test-expect-fail 1)
(test #t (and (memq 'r7rs (features)) #t))
(test #t (file-exists? "."))
(test #f (file-exists? " no such file "))
+(skip-if-kawa "file-error? and guard missing"
(test #t (file-error?
(guard (exn (else exn))
(delete-file " no such file "))))
+)
(test-end)
_______________________________________________
Scheme-reports mailing list
Scheme-reports@x
http://lists.scheme-reports.org/cgi-bin/mailman/listinfo/scheme-reports