From bf493da4b078dbc875b6a95bef4bfa8b6cabaac2 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 11 Oct 2022 20:55:27 -0700 Subject: [PATCH] add tests to check known counterexamples to seeming equivalences --- qi-test/tests/flow.rkt | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index 9c94ba3e..6b32f33f 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -1483,7 +1483,32 @@ (check-equal? ((☯ (~> (pass positive?) +)) 1 -3 5) 6 - "runtime arity changes in threading form")))) + "runtime arity changes in threading form")) + + (test-suite + "nonlocal semantics" + ;; these are collected from counterexamples to candidate equivalences + ;; that turned up during code review. They ensure that some tempting + ;; "equivalences" that are not really equivalences are formally checked + (let () + (define-flow g (-< add1 sub1)) + (define-flow f positive?) + (define (f* x y) (= (sub1 x) (add1 y))) + (define (amp-pass g f) (☯ (~> (>< g) (pass f) ▽))) + (define (amp-if g f) (☯ (~> (>< (~> g (if f _ ground))) ▽))) + (check-equal? (apply (amp-pass g f) (range -3 4)) + (list 1 2 3 1 4 2)) + (check-exn exn:fail? + (thunk (apply (amp-if g f) (range -3 4)))) + (check-exn exn:fail? + (thunk (apply (amp-pass g f*) (range -3 4)))) + (check-equal? (apply (amp-if g f*) (range -3 4)) + (list -2 -4 -1 -3 0 -2 1 -1 2 0 3 1 4 2))) + (let () + (check-equal? ((☯ (~> (>< string->number) (pass _))) "a" "2" "c") + 2) + (check-equal? ((☯ (~> (>< (if _ string->number ground)) ▽)) "a" "2" "c") + (list #f 2 #f)))))) (module+ main (void (run-tests tests)))