Test several check-satisfied error messages

racket · Dec 28, 2024 · e6b7936 · e6b7936
1 parent ea06d4c
commit e6b7936
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 0 deletions.
diff --git a/htdp-test/info.rkt b/htdp-test/info.rkt
@@ -6,6 +6,7 @@
 (define build-deps '("lazy"
                      "deinprogramm"
                      "pict-lib"
+                     "simple-tree-text-markup-lib"
                      "redex-lib"
                      "racket-index"
                      "scheme-lib"

diff --git a/htdp-test/tests/test-engine/racket-tests.rkt b/htdp-test/tests/test-engine/racket-tests.rkt
@@ -2,12 +2,24 @@
 
 (require (only-in lang/private/teach check-property
                   for-all Integer)
+         (only-in lang/htdp-intermediate-lambda
+                  [define define/isl]
+                  local)
+         (only-in htdp/bsl/runtime configure)
          (except-in rackunit check-within)
+         racket/port
+         simple-tree-text-markup/text
          test-engine/racket-tests
          test-engine/test-engine)
 
 (require racket/format)
 
+;; To configure error messages
+(configure ;; ISL options
+ '(abbreviate-cons-as-list
+   read-accept-quasiquote
+   use-function-output-syntax))
+
 (define (assert-failed-check failed-check reason? . selector+value-list)
   (check-pred failed-check? failed-check)
   (let ((reason (failed-check-reason failed-check)))
@@ -60,6 +72,50 @@
                unequal-actual 1
                unequal-expected 2)
 
+(check-satisfied (cdr (list 3514)) null)
+(check-failure unsatisfied-error?
+               unsatisfied-error-exn (lambda (e)
+                                       (regexp-match? #rx"application: not a procedure"
+                                                      (exn-message e)))
+               unsatisfied-error/markup-error-markup
+               (lambda (m)
+                 (regexp-match? #rx"function call: expected a function after the open parenthesis, but received '[(][)]"
+                                (with-output-to-string
+                                  (lambda () (display-markup m))))))
+
+(define/isl even1
+  (local [(define/isl (local-even m k)
+            (even? (+ m k)))]
+    local-even))
+
+(define/isl (even2 m k)
+  (even? (+ m k)))
+
+(check-satisfied 4 even1)
+(check-failure unsatisfied-error?
+               unsatisfied-error-exn (lambda (e)
+                                       (regexp-match? #rx"local-even.*arity mismatch"
+                                                      (exn-message e)))
+               unsatisfied-error/markup-error-markup
+               (lambda (m)
+                 (regexp-match? #rx"local-even.*expects 2 arguments.*found only 1"
+                                (with-output-to-string
+                                  (lambda () (display-markup m))))))
+
+(check-satisfied 4 even2)
+(check-failure unsatisfied-error?
+               unsatisfied-error-exn
+               (lambda (e)
+                 (regexp-match?
+                  #rx"check-satisfied.*expects function of one argument.*Given even2"
+                  (exn-message e)))
+               unsatisfied-error/markup-error-markup
+               (lambda (m)
+                 (regexp-match?
+                  #rx"check-satisfied.*expects function of one argument.*Given even2"
+                  (with-output-to-string
+                    (lambda () (display-markup m))))))
+
 (check-satisfied 0 (lambda (n bad) #t))
 (check-exn
  (lambda (e)