Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Skip check-satisfied in stepper #239

Merged
merged 2 commits into from
Dec 30, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 16 additions & 11 deletions htdp-lib/test-engine/racket-tests.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,8 @@
; racket/function
htdp/error
(for-syntax racket/base
#;"requiring from" lang/private/firstorder #;"avoids load cycle")
#;"requiring from" lang/private/firstorder #;"avoids load cycle"
stepper/private/syntax-property)
test-engine/test-engine
(only-in test-engine/test-markup get-rewritten-error-message)
test-engine/syntax
Expand Down Expand Up @@ -170,11 +171,13 @@
(raise exn)))]
[else (raise exn)])))])
(#,prop1 x)))])
(check-expect-maker stx
#'do-check-satisfied
#'actual:exp
(list code name)
'comes-from-check-satisfied))]
(stepper-syntax-property
(check-expect-maker stx
#'do-check-satisfied
#'actual:exp
(list code name)
'comes-from-check-satisfied)
'stepper-skip-completely #t))]
[(_ actual:exp expected-predicate:exp)
(let ([pred #`(let ([p? expected-predicate:exp])
(let ((name (object-name p?)))
Expand All @@ -183,11 +186,13 @@
(error-check (lambda (v) #f) name SATISFIED-FMT #t)
(error-check (lambda (v) #f) p? SATISFIED-FMT #t))))
p?)])
(check-expect-maker stx
#'do-check-satisfied
#'actual:exp
(list pred "unknown name")
'comes-from-check-satisfied))]
(stepper-syntax-property
(check-expect-maker stx
#'do-check-satisfied
#'actual:exp
(list pred "unknown name")
'comes-from-check-satisfied)
'stepper-skip-completely #t))]
[(_ actual:exp expected-predicate:exp)
(raise-syntax-error 'check-satisfied "expects named function in second position." stx)]
[_ (raise-syntax-error 'check-satisfied (argcount-error-message/stx 2 stx) stx)]))
Expand Down
36 changes: 36 additions & 0 deletions htdp-test/tests/stepper/test-cases.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -1135,6 +1135,42 @@
:: 9 false (check-expect {(+ 1 1)} 2) -> 9 false (check-expect {2} 2)
:: 9 false true (check-expect {(+ 2 2)} 4) -> 9 false true (check-expect {4} 4))

;; check-satisfied is generally skipped
;; UPDATE ME when the stepper supports check-satisfied
(t 'check-satisfied-identifier m:upto-int/lam
(check-expect 1 (+ 1 1)) (check-satisfied (* 2 2) even?) (check-expect 3 (+ 1 2))
:: (check-expect 1 {(+ 1 1)}) -> (check-expect 1 {2})
:: false (check-expect 3 {(+ 1 2)}) -> false (check-expect 3 {3}))

;; non-identifier predicate in check-satisfied
;; UPDATE ME when the stepper supports check-satisfied
(t 'check-satisfied-lambda m:intermediate-lambda/both
(check-satisfied (+ 2 3) (lambda (n) (even? (sub1 n)))) (check-expect 3 (+ 1 2))
:: (check-expect 3 {(+ 1 2)}) -> (check-expect 3 {3}))

;; defined function in check-satisfied
;; define/lambda from user code is stepped
;; UPDATE ME when the stepper supports check-satisfied
(let* ([defs '(;; add2minus1 is stepped
(define (add2minus1 n) (+ 2 n -1))
;; the (lambda (j) ...) part is also stepped since it has cms
(define (curried-mul3 i) (lambda (j) (* 3 i j))))])
(t 'check-satisfied-defined m:intermediate-lambda/both
(define (add2minus1 n) (+ 2 n -1))
(define (curried-mul3 i) (lambda (j) (* 3 i j)))
(check-satisfied (add2minus1 5) even?)
(check-satisfied (curried-mul3 1) procedure?)
(check-satisfied (number? ((curried-mul3 2) 3)) boolean?)
(check-satisfied (curried-mul3 4) (lambda (f) (= (f 5) 60)))
:: ,@defs {(+ 2 5 -1)} -> ,@defs {6}
:: ... -> ,@defs {(lambda (j) (* 3 1 j))}
:: ... -> ,@defs {(lambda (j) (* 3 2 j))}
:: ... -> ,@defs {(* 3 2 3)}
:: ,@defs {(* 3 2 3)} -> ,@defs {18}
:: ... -> ,@defs {(lambda (j) (* 3 4 j))} ;; (f 5) is inside user code, so it is
:: ... -> ,@defs {(* 3 4 5)} ;; stepped through by the stepper; but
:: ,@defs {(* 3 4 5)} -> ,@defs {60})) ;; but (= (f 5) 60) is not.

(t 'check-random m:upto-int/lam
(check-random (+ 3 4) (+ 2 5)) (+ 4 5)
:: {(+ 4 5)} -> {9}
Expand Down