Avoid leaking p? in check-satisfied to anonymous λ

racket · Dec 27, 2024 · ef67552 · shhyou · Dec 27, 2024 · ef67552
1 parent 495e6bd
commit ef67552
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 1 deletion.
diff --git a/htdp-lib/test-engine/racket-tests.rkt b/htdp-lib/test-engine/racket-tests.rkt
@@ -176,7 +176,8 @@
                            (list code name)
                            'comes-from-check-satisfied))]
     [(_ actual:exp expected-predicate:exp)
-     (let ([pred #`(let ([p? expected-predicate:exp])
+     (let ([pred #`(let ([p? #,(syntax-property #'expected-predicate:exp
+                                                'inferred-name (void))])
                      (let ((name (object-name p?)))
                        (unless (and (procedure? p?) (procedure-arity-includes? p? 1))
                          (if name  ;; this produces the BSL/ISL name 

diff --git a/htdp-test/tests/test-engine/racket-tests.rkt b/htdp-test/tests/test-engine/racket-tests.rkt
@@ -60,6 +60,20 @@
                unequal-actual 1
                unequal-expected 2)
 
+(check-satisfied 0 (lambda (n bad) #t))
+(check-exn
+ (lambda (e)
+   (initialize-test-object!)
+   (and (exn:fail:contract? e)
+        (regexp-match?
+         ;; BUG: error-check in test-engine/racket-tests is NOT using print-convert!
+         (pregexp
+          (string-append "check-satisfied.*expect.*one argument.*second position.*"
+                         "Given.*racket-tests[.]rkt:[[:digit:]]+:[[:digit:]]+"))
+         (exn-message e))))
+ (lambda ()
+   (run-tests!)))
+
 (check-within 1.345 1.3 .05)
 (check-success)