diff --git a/htdp-test/tests/stepper/automatic-tests.rkt b/htdp-test/tests/stepper/automatic-tests.rkt index 5ab9e026..de3c520d 100644 --- a/htdp-test/tests/stepper/automatic-tests.rkt +++ b/htdp-test/tests/stepper/automatic-tests.rkt @@ -33,8 +33,7 @@ '(local-struct/ilam local-struct/i begin-let-bug - qq-splice - big-bang)) + qq-splice)) ;; this test anticipates the implementation of the stepper ;; for check-random, which is not yet implemented diff --git a/htdp-test/tests/stepper/test-cases.rkt b/htdp-test/tests/stepper/test-cases.rkt index 41abae44..6b4401c3 100644 --- a/htdp-test/tests/stepper/test-cases.rkt +++ b/htdp-test/tests/stepper/test-cases.rkt @@ -1205,6 +1205,57 @@ (9 false (check-expect (hilite 4) 4))) (finished-stepping))) + ;; NOTE: a straight-line big-bang test would not work because + ;; it will hang indefinitely, waiting for big-bang to terminate + (let ([defs '((require 2htdp/universe) + (require 2htdp/image) + (define (draw t) (empty-scene 50 50)))] + [img '(instantiate (class ...) ...)]) ;; #; somehow `any` did not work? + ;; Somehow, we could not start big-bang with 2 or below to run only one or two steps + ;; because to-draw won't always get a chance to properly run. + ;; + ;; When the initial world is only 2 or 1, there will be extra steps after + ;; "finished-stepping" which also shows up in the actual Stepper GUI as two extra steps + ;; after "all of the definitions have been successfully evaluated" is displayed. + ;; + ;; The (empty-scene 50 50) also shows up only after the final world 0 like: + ;; :: ... -> ,@defs 0 {(empty-scene 50 50)} -> ,@defs 0 {,img} + ;; + ;; It seems as if `big-bang` has terminated too quickly, possibly due to high ticking + ;; frequency, causing out-of-ordered to-draw steps + (t 'big-bang m:upto-int/lam + ,@defs + (big-bang 4 [stop-when zero?] [close-on-stop #true] + [to-draw draw] + [on-tick sub1 1/8]) + ;; The initial `draw` before the clock starts ticking + :: ,@defs {(empty-scene 50 50)} -> ,@defs {,img} + :: ... -> ,@defs {(empty-scene 50 50)} -> ,@defs {,img} ;; `draw` for w = 3 + :: ... -> ,@defs {(empty-scene 50 50)} -> ,@defs {,img} ;; `draw` for w = 2 + :: ... -> ,@defs {(empty-scene 50 50)} -> ,@defs {,img})) ;; `draw` for w = 1 + + ;; Testing the current big-bang stepping behavior + ;; functions defined in user code are stepped, but lambdas in big-bang are not + ;; so: in to-draw: (first w), empty-scene, and overlay are invisible + (let ([defs '((require 2htdp/universe) + (require 2htdp/image) + (define (drawobj r) (circle r "solid" "red")) + (define (next w) (rest w)))] + [img '(instantiate (class ...) ...)]) ;; #; somehow `any` did not work? + (t 'big-bang-lambda m:intermediate-lambda/both + ,@defs + (big-bang (list 25 18 11) [stop-when empty?] [close-on-stop #true] + [to-draw (lambda (w) + (overlay (drawobj (first w)) + (empty-scene 60 60)))] + [on-tick next 1/5]) + :: ,@defs {(circle 25 "solid" "red")} -> ,@defs {,img} + :: ... -> ,@defs {(rest (list 25 18 11))} -> ,@defs {(list 18 11)} ;; next + :: ... -> ,@defs {(circle 18 "solid" "red")} -> ,@defs {,img} ;; drawobj + :: ... -> ,@defs {(rest (list 18 11))} -> ,@defs {(list 11)} ;; next + :: ... -> ,@defs {(circle 11 "solid" "red")} -> ,@defs {,img} ;; drawobj + :: ... -> ,@defs {(rest (list 11))} -> ,@defs {empty})) ;; next + ;;;;;;;;;;;; ;; ;; SdP TESTS @@ -1218,14 +1269,6 @@ (lambda (s) (if s s s)))" '((finished-stepping))) - - (t1 'big-bang - m:beginner - "(require 2htdp/image) -(require 2htdp/universe) -(define (f2 w) (text \"hi\" 30 \"red\")) -(big-bang \"dummy\" [to-draw f2])" - '((finished-stepping))) ; ;;;;;;;;;;;;; diff --git a/htdp-test/tests/stepper/test-engine.rkt b/htdp-test/tests/stepper/test-engine.rkt index 2edf28b1..de06d3f4 100644 --- a/htdp-test/tests/stepper/test-engine.rkt +++ b/htdp-test/tests/stepper/test-engine.rkt @@ -12,6 +12,7 @@ racket/contract racket/file mzlib/pconvert-prop ;; so it can be attached. + racket/gui/base ;; stepper big-bang tests need them attached test-engine/test-markup lang/private/rewrite-error-message test-engine/test-engine @@ -196,6 +197,7 @@ (parameterize ([current-namespace (make-base-namespace)]) (namespace-attach-module orig-namespace 'mzlib/pconvert-prop) (namespace-attach-module orig-namespace 'racket/class) + (namespace-attach-module orig-namespace 'racket/gui/base) (namespace-attach-module orig-namespace 'test-engine/racket-tests) (thunk)))