cond-let-test.rkt (6246B)
1 #lang racket 2 3 (require anaphoric/cond-let 4 rackunit) 5 6 (define lst '(x y z a b c)) 7 (define seen 0) 8 9 ;; With else branch 10 (check-equal? (cond-let 11 [[x (member 'a lst)] (set! seen (add1 seen)) 12 (check-equal? x '(a b c)) 13 'seen-01] 14 [[x (member 'b lst)] (fail "cond-let chose wrong branch")] 15 [else (fail "cond-let chose wrong branch")]) 16 'seen-01) 17 (check-equal? seen 1) ;; multiple body statements 18 19 (check-equal? (cond-let 20 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 21 [[x (member 'b lst)] (begin (check-equal? x '(b c)) 22 'seen-02)] 23 [else (fail "cond-let chose wrong branch")]) 24 'seen-02) 25 26 (check-equal? (cond-let 27 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 28 [[x (member 'absent2 lst)] (fail "cond-let chose wrong branch")] 29 [else 'seen-03]) 30 'seen-03) 31 32 ;; Common variable name, with else branch 33 (check-equal? (cond-let x 34 [(member 'a lst) (set! seen (add1 seen)) 35 (check-equal? x '(a b c)) 36 'seen-01] 37 [(member 'b lst) (fail "cond-let chose wrong branch")] 38 [else (fail "cond-let chose wrong branch")]) 39 'seen-01) 40 (check-equal? seen 2) ;; multiple body statements 41 42 (check-equal? (cond-let x 43 [(member 'absent lst) (fail "cond-let chose wrong branch")] 44 [(member 'b lst) (begin (check-equal? x '(b c)) 45 'seen-02)] 46 [else (fail "cond-let chose wrong branch")]) 47 'seen-02) 48 49 (check-equal? (cond-let x 50 [(member 'absent lst) (fail "cond-let chose wrong branch")] 51 [(member 'absent2 lst) (fail "cond-let chose wrong branch")] 52 [else 'seen-03]) 53 'seen-03) 54 55 ;; Different variable names 56 (check-equal? (cond-let 57 [[x (member 'a lst)] (begin (check-equal? x '(a b c)) 58 'seen-02)] 59 [[y (member 'b lst)] (fail "cond-let chose wrong branch")] 60 [else (fail "cond-let chose wrong branch")]) 61 'seen-02) 62 63 (check-equal? (cond-let 64 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 65 [[y (member 'b lst)] (begin (check-equal? y '(b c)) 66 'seen-02)] 67 [else (fail "cond-let chose wrong branch")]) 68 'seen-02) 69 70 ;; Shadowing 71 (check-equal? (let ([x 'outerx] [y 'outery]) 72 (cond-let 73 [[x (member 'a lst)] (begin (check-equal? x '(a b c)) 74 'seen-02)] 75 [[y (member 'b lst)] (fail "cond-let chose wrong branch")] 76 [else (fail "cond-let chose wrong branch")])) 77 'seen-02) 78 79 (check-equal? (let ([x 'outerx] [y 'outery]) 80 (cond-let 81 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 82 [[y (member 'b lst)] (begin (check-equal? y '(b c)) 83 'seen-02)] 84 [else (fail "cond-let chose wrong branch")])) 85 'seen-02) 86 87 (check-equal? (let ([x 'outerx] [y 'outery]) 88 (cond-let 89 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 90 [[y (member 'absent lst)] (fail "cond-let chose wrong branch")] 91 [else (list x y)])) 92 '(outerx outery)) 93 94 ;; Just else branch 95 (check-equal? (cond-let 96 [else 'seen-04]) 97 'seen-04) 98 99 ;; Common variable name, just else branch 100 (check-equal? (cond-let x 101 [else 'seen-04]) 102 'seen-04) 103 104 ;; Multiple body statements 105 106 (check-equal? (cond-let 107 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 108 [[x (member 'absent2 lst)] (fail "cond-let chose wrong branch")] 109 [else (set! seen (add1 seen)) 110 'seen-05]) 111 'seen-05) 112 (check-equal? seen 3) 113 114 ;; Without else branch 115 (check-equal? (cond-let 116 [[x (member 'a lst)] (set! seen (add1 seen)) 117 (check-equal? x '(a b c)) 118 'seen-06] 119 [[x (member 'b lst)] (fail "cond-let chose wrong branch")]) 120 'seen-06) 121 (check-equal? seen 4) 122 123 (check-equal? (cond-let 124 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 125 [[x (member 'b lst)] (begin (check-equal? x '(b c)) 126 'seen-07)]) 127 'seen-07) 128 129 (check-equal? (cond-let 130 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")] 131 [[x (member 'absent2 lst)] (fail "cond-let chose wrong branch")]) 132 (void)) 133 134 ;; Common variable name, without else branch 135 (check-equal? (cond-let x 136 [(member 'a lst) (set! seen (add1 seen)) 137 (check-equal? x '(a b c)) 138 'seen-06] 139 [(member 'b lst) (fail "cond-let chose wrong branch")]) 140 'seen-06) 141 (check-equal? seen 5) 142 143 (check-equal? (cond-let x 144 [(member 'absent lst) (fail "cond-let chose wrong branch")] 145 [(member 'b lst) (begin (check-equal? x '(b c)) 146 'seen-07)]) 147 'seen-07) 148 149 (check-equal? (cond-let x 150 [(member 'absent lst) (fail "cond-let chose wrong branch")] 151 [(member 'absent2 lst) (fail "cond-let chose wrong branch")]) 152 (void)) 153 154 ;; No branch 155 (check-equal? (cond-let) 156 (void)) 157 158 ;; Single branch 159 (check-equal? (cond-let 160 [[x (member 'a lst)] (begin (check-equal? x '(a b c)) 161 'seen-09)]) 162 'seen-09) 163 164 (check-equal? (cond-let 165 [[x (member 'absent lst)] (fail "cond-let chose wrong branch")]) 166 (void))