suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed up for our modern times

Browse Source 
svn: r16437
This commit is contained in:
Robby Findler 2009-10-26 19:48:58 +00:00
parent a4d3b956f7
commit b17d6cfc2c
1 changed files with 28 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/tests/mzscheme/shared-tests.ss
View File

@ -1,5 +1,7 @@
(load-relative "loadtest.ss")
(Section 'shared)
;; This file has to work for both "shared.ss" and "advanced.ss" (require (prefix-in b: lang/htdp-advanced))
;; this writes values to strings and compares the strings ;; this writes values to strings and compares the strings
;; to implements an equal? predicate that works for cyclic ;; to implements an equal? predicate that works for cyclic
@ -15,42 +17,45 @@
(define (stest expect expression) (define (stest expect expression)
(test (test
(gs expect) (gs expect)
(let ([shared-tester (lambda (x) (gs (eval x)))]) shared-tester) (let ([shared-tester (lambda (x) (gs x))]) shared-tester)
expression)) expression))
(stest '(1 2) '(shared ([x (list 1 2)]) x)) (stest '(1 2) (shared ([x (list 1 2)]) x))
(stest #(1 2) '(shared ([x (vector 1 2)]) x)) (stest #(1 2) (shared ([x (vector 1 2)]) x))
(stest (box 1) '(shared ([x (box 1)]) x)) (stest (box 1) (shared ([x (box 1)]) x))
(stest '(1) '(shared ([x (cons 1 null)]) x)) (stest '(1) (shared ([x (cons 1 null)]) x))
(stest (mcons 1 null) '(shared ([x (mcons 1 null)]) x)) (stest (mcons 1 null) (shared ([x (mcons 1 null)]) x))
(stest (x "#1=(#1# 1)") '(shared ([x (list x 1)]) x)) (stest (x "#1=(#1# 1)") (shared ([x (list x 1)]) x))
(stest (x "#2=#(#2# 1)") '(shared ([x (vector x 1)]) x)) (stest (x "#2=#(#2# 1)") (shared ([x (vector x 1)]) x))
(stest (x "#2=#(#2# 1)") '(shared ([x (vector-immutable x 1)]) x)) (stest (x "#2=#(#2# 1)") (shared ([x (vector-immutable x 1)]) x))
(stest (x "#3=#&#3#") '(shared ([x (box x)]) x)) (stest (x "#3=#&#3#") (shared ([x (box x)]) x))
(stest (x "#3=#&#3#") '(shared ([x (box-immutable x)]) x)) (stest (x "#3=#&#3#") (shared ([x (box-immutable x)]) x))
(stest (x "#4=(#4#)") '(shared ([x (cons x null)]) x)) (stest (x "#4=(#4#)") (shared ([x (cons x null)]) x))
(stest (x "#5=(1 . #5#)") '(shared ([x (cons 1 x)]) x)) (stest (x "#5=(1 . #5#)") (shared ([x (cons 1 x)]) x))
(stest (let ([x (mcons 1 #f)]) (stest (let ([x (mcons 1 #f)])
(begin (set-mcdr! x x) (begin (set-mcdr! x x)
x)) x))
'(shared ([x (mcons 1 x)]) x)) (shared ([x (mcons 1 x)]) x))
(stest (x "#11=(#11#)") '(shared ([x `(,x)]) x)) (stest (x "#11=(#11#)") (shared ([x `(,x)]) x))
(stest 1 '(shared ([x (list 1 x p)] (stest 1 (shared ([x (list 1 x p)]
[p (lambda () x)]) [p (lambda () x)])
(car ((caddr x))))) (car ((caddr x)))))
(define-struct s (a b)) (b:define-struct s (a b))
(shared ([x (make-s 17 x)]) (shared ([x (make-s 17 x)])
(begin (begin
(test #t s? x) (test #t s? x)
(test 17 s-a x) (test 17 s-a x)
(test 17 s-a (s-b x))
(test #t eq? x (s-b x)))) (test #t eq? x (s-b x))))
(define-struct shared-test-ds-no-fields ()) (define-struct shared-test-ds-no-fields ())
(stest (make-shared-test-ds-no-fields) (stest (make-shared-test-ds-no-fields)
'(shared ((-4- 11) (shared ((-4- 11)
(-8- (make-shared-test-ds-no-fields))) (-8- (make-shared-test-ds-no-fields)))
-8-)) -8-))
(report-errs)