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

new tests for 301.11

Browse Source 
svn: r2467
This commit is contained in:
Matthew Flatt 2006-03-20 20:33:22 +00:00
parent dc63516c39
commit 6b7e973056
3 changed files with 52 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/tests/mzscheme/basic.ss
View File

@ -1991,7 +1991,7 @@
(arity-test hash-table-for-each 2 2)
(arity-test hash-table? 1 3)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc
(test #t string? (version))
@ -2013,6 +2013,30 @@
(arity-test system-library-subpath 0 1)
(arity-test current-command-line-arguments 0 1)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; procedure-closure-contents-eq?
(for-each
(lambda (jit?)
(parameterize ([eval-jit-enabled jit?])
(let ([f #f])
(set! f (eval '(lambda (x) (lambda () x))))
((f 'c)) ; forced JIT compilation
(test #t procedure-closure-contents-eq? (f 'a) (f 'a))
(test #f procedure-closure-contents-eq? (f 'a) (f 'b))
(set! f (eval '(case-lambda
[(x) (lambda () 12)]
[(x y) (lambda () (list x y))])))
((f 'c)) ; forces JIT compilation
((f 'c 'd)) ; forces JIT compilation
(test #t procedure-closure-contents-eq? (f 'a) (f 'a))
(test #t procedure-closure-contents-eq? (f 'a 'b) (f 'a 'b))
(test #f procedure-closure-contents-eq? (f 'a 'b) (f 'c 'b)))))
'(#t #f))
(test #t procedure-closure-contents-eq? add1 add1)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)
"last item in file"

13
collects/tests/mzscheme/optimize.ss
View File

@ -333,4 +333,17 @@
(test-comp '(let ([f (lambda (x) x)]) f)
(syntax-property (datum->syntax-object #f '(lambda (x) x)) 'inferred-name 'f))
(test-comp '(letrec ([f (lambda (x) x)])
(f 10)
f)
'(letrec ([f (lambda (x) x)])
f))
(test-comp '(let ([f (lambda (x) x)])
(f 10))
10)
(test-comp '(let ([f (lambda (x) (add1 x))]
[y 10])
(f y))
'11)
(report-errs)

14
collects/tests/mzscheme/syntax.ss
View File

@ -1081,6 +1081,20 @@
(g))
(test 16 values val))
;; Function-inline test where (h (g v 10)) involves two inlines:
(letrec ([f (lambda (x) (h (g v 10)))]
[h (lambda (x) (list x x))]
[g (lambda (a b) a)]
[v (list 'hello)]
[w (list 'no!)])
(test '((hello) (hello)) f 10))
;; Inlining introduces a let binding that is immediately dropped:
(test '(1 . 2)
(let ([x (cons 1 2)]) (let ([f (lambda (x) x)]) (f (lambda (y) x))))
10)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)