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

adding some tests from the Racket test suite regarding with-continuation-mark

Browse Source
This commit is contained in:
Danny Yoo 2011-04-14 12:13:08 -04:00
parent a35190c07e
commit 6cc07abd25
1 changed files with 73 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
test-compiler.rkt
View File

@ -1087,52 +1087,85 @@
(make-ContinuationMarkSet (list (cons 'name "danny")))) (make-ContinuationMarkSet (list (cons 'name "danny"))))
(test '(begin (define (extract-current-continuation-marks key)
(continuation-mark-set->list (define-syntax (wcm-test stx)
(current-continuation-marks) (syntax-case stx ()
key)) [(_ code expected options ...)
(with-continuation-mark 'key 'mark (syntax/loc stx
(extract-current-continuation-marks 'key))) (let ([code-val code])
'(mark)) (test `(begin (define (extract-current-continuation-marks key)
(continuation-mark-set->list
(current-continuation-marks)
key))
,code-val)
expected
options ...)))]))
(wcm-test '(with-continuation-mark 'key 'mark
(extract-current-continuation-marks 'key))
'(mark))
(test '(begin (define (extract-current-continuation-marks key) (wcm-test '(with-continuation-mark 'key1 'mark1
(continuation-mark-set->list (with-continuation-mark 'key2 'mark2
(current-continuation-marks) (list
key)) (extract-current-continuation-marks 'key1)
(extract-current-continuation-marks 'key2))))
'((mark1) (mark2)))
(with-continuation-mark 'key1 'mark1 (wcm-test '(with-continuation-mark 'key 'mark1
(with-continuation-mark 'key2 'mark2 (with-continuation-mark 'key 'mark2 ; replaces previous mark
(list (extract-current-continuation-marks 'key)))
(extract-current-continuation-marks 'key1) '(mark2))
(extract-current-continuation-marks 'key2)))))
'((mark1) (mark2)))
(test '(begin (define (extract-current-continuation-marks key) (wcm-test '(with-continuation-mark 'key 'mark1
(continuation-mark-set->list (list ; continuation extended to evaluate the argument
(current-continuation-marks) (with-continuation-mark 'key 'mark2
key)) (extract-current-continuation-marks 'key))))
(with-continuation-mark 'key 'mark1 '((mark2 mark1)))
(with-continuation-mark 'key 'mark2 ; replaces previous mark
(extract-current-continuation-marks 'key))))
'(mark2))
(wcm-test '(extract-current-continuation-marks 'key)
'())
;; Hmm... something is failing here. (wcm-test '(with-continuation-mark 'key 10
(test '(begin (define (extract-current-continuation-marks key) (extract-current-continuation-marks 'key))
(continuation-mark-set->list '(10))
(current-continuation-marks)
key))
(with-continuation-mark 'key 'mark1 (wcm-test '(with-continuation-mark 'key 10
(list ; continuation extended to evaluate the argument (with-continuation-mark 'key 11
(with-continuation-mark 'key 'mark2 (extract-current-continuation-marks 'key)))
(extract-current-continuation-marks 'key))))) '(11))
'((mark2 mark1)))
(wcm-test '(with-continuation-mark 'key 10
(with-continuation-mark 'key2 9
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key2))))
'(9))
(wcm-test '(with-continuation-mark 'key 10
(with-continuation-mark 'key2 9
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key3))))
'())
(wcm-test '(let ([x (with-continuation-mark 'key 10 (list 100))])
(extract-current-continuation-marks 'key))
'())
(wcm-test '(with-continuation-mark 'key 11
(let ([x (with-continuation-mark 'key 10 (extract-current-continuation-marks 'key))])
(extract-current-continuation-marks 'key)))
'(11))
(wcm-test '(with-continuation-mark 'key 11
(list (extract-current-continuation-marks 'key)
(with-continuation-mark 'key 10 (extract-current-continuation-marks 'key))
(extract-current-continuation-marks 'key)))
'((11) (10 11) (11)))
#;(test (read (open-input-file "tests/conform/program0.sch")) #;(test (read (open-input-file "tests/conform/program0.sch"))