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

new optimizer tests

Browse Source 
svn: r2385
This commit is contained in:
Matthew Flatt 2006-03-07 15:55:14 +00:00
parent de0e4fffeb
commit 20f5a5f12b
2 changed files with 56 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -295,7 +295,8 @@
(test-comp (normalize-depth '(let* ([i (cons 0 1)][g i][h (car g)][m h]) m))
(normalize-depth '(let* ([i (cons 0 1)][h (car i)]) h)))
(set! maybe-different-depths? #t)
;; The current optimizer reset depths correctly:
;; (set! maybe-different-depths? #t)
(require #%kernel) ;
@ -316,4 +317,20 @@
(test-comp '(let ([x 3][y 4]) (+ x y))
'((lambda (x y) (+ x y)) 3 4))
(test-comp '(let ([x 1][y 2]) x)
'1)
(test-comp '(let ([x 1][y 2]) (+ y x))
'3)
(test-comp '(let ([x 1][y 2]) (cons x y))
'(cons 1 2))
(test-comp '(let* ([x (cons 1 1)][y x]) (cons x y))
'(let* ([x (cons 1 1)]) (cons x x)))
(test-comp '(let* ([x 1][y (add1 x)]) (+ y x))
'3)
(test-comp '(letrec ([x (cons 1 1)][y x]) (cons x y))
'(letrec ([x (cons 1 1)][y x]) (cons x x)))
(test-comp '(let ([f (lambda (x) x)]) f)
(syntax-property (datum->syntax-object #f '(lambda (x) x)) 'inferred-name 'f))
(report-errs)

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

@ -1045,4 +1045,42 @@
(define x 5)
(test 5 '#%top (#%top . x))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests related to bytecode optimizer.
;; The (if (let ([x M]) (if x x N)) ...)
;; => (if (if M #t N) ...)
;; converter drops the variable `x', which means
;; that other mappings must adjust
(let ([val 0])
(let ([g (lambda ()
(letrec ([f (lambda (z x)
(if (let ([w (even? 81)])
(if w
w
(let ([y x])
(set! x 7)
(set! val (+ y 5)))))
'yes
'no))])
(f 0 11)))])
(g))
(test 16 values val))
(let ([val 0])
(let ([g (lambda ()
(letrec ([f (lambda (z x)
(if (let ([w (even? 81)])
(if w
w
(let ([y x])
(set! val (+ y 5)))))
'yes
'no))])
(f 0 11)))])
(g))
(test 16 values val))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)