156 lines
3.5 KiB
Racket
156 lines
3.5 KiB
Racket
#lang racket
|
|
|
|
(require "randomized-tests.rkt"
|
|
"reduce.rkt"
|
|
"grammar.rkt"
|
|
rackunit
|
|
(except-in redex/reduction-semantics plug))
|
|
|
|
(define-syntax (test-transformation stx)
|
|
(syntax-case stx ()
|
|
[(_ program expected-output expected-result)
|
|
#`(match-let ([(answer actual-output actual-result)
|
|
(model-eval (transform-intermediate (term program)))])
|
|
(begin
|
|
#,(syntax/loc #'expected-output
|
|
(check-equal? actual-output expected-output))
|
|
#,(syntax/loc #'expected-result
|
|
(check-equal? actual-result 'expected-result))))]))
|
|
|
|
(test-transformation
|
|
(<> ()
|
|
()
|
|
(% 0
|
|
(wcm ()
|
|
((λ (k)
|
|
(begin (k 7) (print 1)))
|
|
(cont 0 hole)))
|
|
(λ (x) x)))
|
|
"" 7)
|
|
|
|
(test-transformation
|
|
(<> ()
|
|
()
|
|
(cont 1 (begin hole (print 3))))
|
|
"" procedure)
|
|
|
|
(test-transformation
|
|
(<> ()
|
|
()
|
|
(% 0
|
|
(print
|
|
(wcm ()
|
|
((λ (k) (begin (k 1) 2))
|
|
(comp (print hole)))))
|
|
(λ (x) x)))
|
|
"12" #f)
|
|
|
|
(test-transformation
|
|
(<> ()
|
|
(1)
|
|
(% 1
|
|
(dw
|
|
x_1
|
|
(print 1)
|
|
(wcm ()
|
|
((λ (k) (k 3))
|
|
(cont 1 (dw x_1 (print 1) hole (print 2)))))
|
|
(print 2))
|
|
(λ (x) x)))
|
|
"12" 3)
|
|
|
|
(test-transformation
|
|
(<> ()
|
|
(1)
|
|
(% 0
|
|
((% 0
|
|
(dw
|
|
x_1
|
|
(print 1)
|
|
(wcm ()
|
|
((λ (k) k)
|
|
(cont 0 (dw x_1 (print 1) hole (print 2)))))
|
|
(print 2))
|
|
(λ (x) x))
|
|
3)
|
|
(λ (x) x)))
|
|
"1212" 3)
|
|
|
|
(test-transformation
|
|
(<> () []
|
|
(% 0
|
|
(wcm ([1 2] [3 4])
|
|
((λ (x) x)
|
|
(wcm ([1 5] [3 6])
|
|
(cons (current-marks 1 0)
|
|
(cons (current-marks 3 0)
|
|
(list))))))
|
|
(λ (x) x)))
|
|
"" ((5 2) (6 4)))
|
|
|
|
(test-transformation
|
|
(<>
|
|
()
|
|
()
|
|
(dw
|
|
ra
|
|
(print 1)
|
|
(print 2)
|
|
(print 3)))
|
|
"23" #f)
|
|
|
|
(test-transformation
|
|
(<> ()
|
|
()
|
|
(%
|
|
1
|
|
(dw x_1
|
|
(print 1)
|
|
(abort 1 (cont 1 (dw x_1 (print 1) hole (print 3))))
|
|
(print 3))
|
|
(λ (k) (% 1 (k 4) (λ (x) x)))))
|
|
"313" 4)
|
|
|
|
(test-transformation
|
|
(<>
|
|
()
|
|
()
|
|
((comp
|
|
(dw
|
|
ra
|
|
(print 1)
|
|
hole
|
|
(dw q (print 2) (print 3) (print 4))))
|
|
5))
|
|
"134" 5)
|
|
|
|
(test-transformation
|
|
(<>
|
|
()
|
|
()
|
|
(cont 0
|
|
(dw x
|
|
#f
|
|
(cons (cont 1 hole) hole)
|
|
(print 2))))
|
|
"" procedure)
|
|
|
|
(define (transformation-preserves-meaning? p)
|
|
(let ([original-result (parameterize ([model-eval-steps 1000]) (model-eval p))]
|
|
[transformed (transform-intermediate p)]
|
|
[warn (λ () (eprintf "Long test:\n") (pretty-write p (current-error-port)))]
|
|
[threshold (* 60 2)])
|
|
(or (timeout? original-result)
|
|
(let ([transformed-result
|
|
(timeout-warn threshold (model-eval transformed) (warn))])
|
|
(if (answer? original-result)
|
|
(equal? original-result transformed-result)
|
|
(not (answer? transformed-result))))
|
|
; filters bad tests
|
|
(bad-test? (timeout-warn threshold (impl-eval (impl-program transformed)) (warn))))))
|
|
|
|
(define-syntax-rule (test-transformation/randomized . kw-args)
|
|
(let ([test-number 1])
|
|
(redex-check grammar p (transformation-preserves-meaning? (term p))
|
|
#:prepare fix-prog
|
|
#:source :-> . kw-args))) |