eq-equal.k (11602B)
1 ;; check.k & test-helpers.k should be loaded 2 ;; 3 ;; Tests of eq? and equal?. 4 ;; 5 ;; The form ($check-predicate ($let ... (equal? ...))) 6 ;; is preferred over ($let ... ($check-predicate (equal? ...))), 7 ;; because it prints more detailed error message. 8 ;; 9 10 ;;; 11 ;;; Basic Functionality 12 ;;; 13 14 ($check-predicate (applicative? eq?)) 15 ($check-predicate (applicative? equal?)) 16 17 ;; 18 ;; no arguments 19 ;; 20 ($check-predicate (eq?)) 21 ($check-predicate (equal?)) 22 23 ;; 24 ;; 1 argument eq? 25 ;; 26 ($check-predicate (eq? ((unwrap list) . symbol))) 27 ($check-predicate (eq? ())) 28 ($check-predicate (eq? (cons () ()))) 29 ($check-predicate (eq? #ignore)) 30 ($check-predicate (eq? (make-environment))) 31 ($check-predicate (eq? #inert)) 32 ($check-predicate (eq? $vau)) 33 ($check-predicate (eq? wrap)) 34 ($check-predicate (eq? (call/cc ($lambda (c) c)))) 35 ($check-predicate (eq? ($let (((enc . #ignore) 36 (make-encapsulation-type))) 37 (enc #inert)))) 38 ($check-predicate (eq? (memoize #inert))) 39 ($check-predicate (eq? 1)) 40 ($check-predicate (eq? -1/2)) 41 ($check-predicate (eq? 1.0)) 42 ($check-predicate (eq? #e+infinity)) 43 ($check-predicate (eq? #i+infinity)) 44 ($check-predicate (eq? #undefined)) 45 ($check-predicate (eq? #real)) 46 ($check-predicate (eq? "string")) 47 ($check-predicate (eq? #\a)) 48 ($check-predicate (eq? (get-current-input-port))) 49 ($check-predicate (eq? (bytevector 1 2 3))) 50 ($check-predicate (eq? (vector 1 2 3))) 51 ($check-predicate (eq? #:keyword)) 52 53 ;; 54 ;; 1 argument equal? 55 ;; 56 ($check-predicate (equal? ((unwrap list) . symbol))) 57 ($check-predicate (equal? ())) 58 ($check-predicate (equal? (cons () ()))) 59 ($check-predicate (equal? #ignore)) 60 ($check-predicate (equal? (make-environment))) 61 ($check-predicate (equal? #inert)) 62 ($check-predicate (equal? $vau)) 63 ($check-predicate (equal? wrap)) 64 ($check-predicate (equal? (call/cc ($lambda (c) c)))) 65 ($check-predicate (equal? ($let (((enc . #ignore) 66 (make-encapsulation-type))) 67 (enc #inert)))) 68 ($check-predicate (equal? (memoize #inert))) 69 ($check-predicate (equal? 1)) 70 ($check-predicate (equal? -1/2)) 71 ($check-predicate (equal? 1.0)) 72 ($check-predicate (equal? #e+infinity)) 73 ($check-predicate (equal? #i+infinity)) 74 ($check-predicate (equal? #undefined)) 75 ($check-predicate (equal? #real)) 76 ($check-predicate (equal? "string")) 77 ($check-predicate (equal? #\a)) 78 ($check-predicate (equal? (get-current-input-port))) 79 ($check-predicate (equal? (bytevector 1 2 3))) 80 ($check-predicate (equal? (vector 1 2 3))) 81 ($check-predicate (equal? #:keyword)) 82 83 ;; 84 ;; two-argument eq? 85 ;; 86 ($check-predicate (eq? ((unwrap list) . symbol) ((unwrap list) . symbol))) 87 ($check-predicate (eq? () ())) 88 ($let ((p (cons () ()))) 89 ($check-predicate (eq? p p))) 90 ($check-not-predicate (eq? (cons () ()) (cons () ()))) 91 ($check-predicate (eq? #ignore #ignore)) 92 ($let ((e (make-environment))) 93 ($check-predicate (eq? e e))) 94 ($check-not-predicate (eq? (make-environment) (make-environment))) 95 ($check-predicate (eq? #inert #inert)) 96 ($check-predicate (eq? $vau $vau)) 97 ($check-predicate (eq? wrap wrap)) 98 ($let/cc c 99 ($check-predicate (eq? c c))) 100 ($let* (((enc . #ignore) 101 (make-encapsulation-type)) 102 (e (enc #inert))) 103 ($check-predicate (eq? e e)) 104 ($check-not-predicate (eq? e (enc #inert)))) 105 ($let ((p (memoize #inert))) 106 ($check-predicate (eq? p p)) 107 ($check-not-predicate (eq? p #inert))) 108 ($check-predicate (eq? 1 1)) 109 ($check-predicate (eq? -1/2 -1/2)) 110 ($check-predicate (eq? 1.0 1.0)) 111 ($check-not-predicate (eq? 1 1.0)) 112 ($check-not-predicate (eq? 1/2 0.5)) 113 ($check-predicate (eq? #e+infinity #e+infinity)) 114 ($check-predicate (eq? #i+infinity #i+infinity)) 115 ($check-not-predicate (eq? #e+infinity #i+infinity)) 116 ($check-predicate (eq? #undefined #undefined)) 117 ($check-predicate (eq? #real #real)) 118 ($check-not-predicate (eq? #undefined #real)) 119 ($check-predicate ($let ((s "string")) (eq? s s))) 120 ($check-not-predicate (eq? (string #\c) (string #\c))) 121 ($check-predicate (eq? #\a #\a)) 122 ($check-predicate (eq? (get-current-input-port) (get-current-input-port))) 123 ($check-predicate ($let ((v (vector 1 2))) (eq? v v))) 124 ($check-predicate ($let ((v (bytevector 1 2))) (eq? v v))) 125 126 ;; 127 ;; two-argument equal? - opaque types 128 ;; 129 ($check-predicate (equal? () ())) 130 ($check-predicate (equal? #ignore #ignore)) 131 ($check-predicate ($let ((e (make-environment))) (equal? e e))) 132 ($check-not-predicate (equal? (make-environment) (make-environment))) 133 ($check-predicate (equal? #inert #inert)) 134 ($check-predicate (equal? $vau $vau)) 135 ($check-predicate (equal? wrap wrap)) 136 ($check-predicate (equal? (get-current-input-port) (get-current-input-port))) 137 ($check-predicate ($let/cc c (equal? c c))) 138 139 ($let* (((enc . #ignore) 140 (make-encapsulation-type)) 141 (e (enc #inert))) 142 ($check-predicate (equal? e e)) 143 ($check-not-predicate (equal? e (enc #inert)))) 144 ($let ((p (memoize #inert))) 145 ($check-predicate (equal? p p)) 146 ($check-not-predicate (equal? p #inert))) 147 148 ;; 149 ;; two-argument equal? - number-like types 150 ;; 151 ($check-predicate (equal? 1 1)) 152 ($check-not-predicate (equal? 1 2)) 153 ($check-predicate (equal? -1/2 -1/2)) 154 ($check-not-predicate (equal? -1/2 1/2)) 155 ($check-predicate (equal? 1.0 1.0)) 156 ($check-not-predicate (equal? 1.0 2.0)) 157 ($check-not-predicate (equal? 1 1.0)) 158 ($check-not-predicate (equal? 1/2 0.5)) 159 ($check-predicate (equal? #e+infinity #e+infinity)) 160 ($check-predicate (equal? #i+infinity #i+infinity)) 161 ($check-not-predicate (equal? #e+infinity #i+infinity)) 162 ($check-predicate (equal? #undefined #undefined)) 163 ($check-predicate (equal? #real #real)) 164 ($check-not-predicate (equal? #undefined #real)) 165 ($check-predicate (equal? #\a #\a)) 166 ($check-not-predicate (equal? #\a #\b)) 167 168 ;; 169 ;; two-argument equal? - string-like types 170 ;; 171 ($check-predicate ($let ((s ($quote symbol))) (equal? s s))) 172 ($check-predicate (equal? ($quote symbol) ($quote symbol))) 173 ($check-predicate (equal? ($quote symbol) ($quote SYMBOL))) 174 ($check-not-predicate (equal? ($quote symbol) ($quote other-symbol))) 175 176 ($check-predicate ($let ((s "string")) (equal? s s))) 177 ($check-predicate (equal? "string" "string")) 178 ($check-predicate (equal? (string #\c) (string #\c))) 179 ($check-predicate (equal? "string" (string #\s #\t #\r #\i #\n #\g))) 180 ($check-not-predicate (equal? "string" "another-string")) 181 ($check-not-predicate (equal? "string" "str")) 182 ($check-not-predicate (equal? "string" "STRING")) 183 184 ($check-predicate ($let ((k #:keyword)) (equal? k k))) 185 ($check-predicate (equal? #:keyword #:keyword)) 186 ($check-not-predicate (equal? #:keyword #:another-keyword)) 187 ($check-not-predicate (equal? #:keyword #:key)) 188 ($check-predicate (equal? #:keyword #:KEYWORD)) 189 190 ($check-predicate ($let ((v (bytevector 1 2 3))) (equal? v v))) 191 ($check-predicate (equal? (bytevector 1 2) (bytevector 1 2))) 192 ($check-not-predicate (equal? (bytevector 1 2) (bytevector 3 4))) 193 ($check-not-predicate (equal? (bytevector 1) (bytevector))) 194 195 ;; 196 ;; two-argument equal? - lists and vectors 197 ;; 198 ($check-predicate (equal? (cons () ()) (cons () ()))) 199 ($check-predicate (equal? (list 1 2 3) (list 1 2 3))) 200 ($check-not-predicate (equal? (list 1 2 3) (list 4 5 6))) 201 ($check-not-predicate (equal? (list 1 2 3) (list 1 2))) 202 ($check-not-predicate (equal? (list 1 2) (list 3 4))) 203 204 ($check-predicate 205 ($let ((p1 (list 1 2 1 2)) 206 (p2 (list 1 2))) 207 (encycle! p1 2 2) 208 (encycle! p2 0 2) 209 (equal? p1 p2))) 210 211 ($check-predicate 212 ($let* ((L1 (list 1)) 213 (L2 (list L1)) 214 (L3 (list L1 L2))) 215 (equal? L3 (list (list 1) (list (list 1)))))) 216 217 ($check-not-predicate 218 ($let* ((L1 (list 1)) 219 (L2 (list L1)) 220 (L3 (list L1 L2))) 221 (equal? L3 (list (list 1) (list (list 2)))))) 222 223 ($check-predicate 224 ($let* ((a (cons #t 0)) 225 (b (cons #f 0)) 226 (c (cons #t 0)) 227 (d (cons #f 0))) 228 (set-cdr! a b) 229 (set-cdr! b c) 230 (set-cdr! c d) 231 (set-cdr! d a) 232 (equal? a c))) 233 234 ($check-not-predicate 235 ($let* ((a (cons #t 0)) 236 (b (cons #f 0)) 237 (c (cons #t 0)) 238 (d (cons #f 0))) 239 (set-cdr! a b) 240 (set-cdr! b c) 241 (set-cdr! c d) 242 (set-cdr! d a) 243 (equal? a b))) 244 245 ($check-predicate 246 ($let* ((a (list 1 5)) 247 (b (list a 5)) 248 (c (list b 5)) 249 (x (list 1 5))) 250 (set-car! a c) 251 (set-car! x x) 252 (equal? a x))) 253 254 ($check-not-predicate 255 ($let* ((a (list 1 5)) 256 (b (list a 555)) 257 (c (list b 5)) 258 (x (list 1 5))) 259 (set-car! a c) 260 (set-car! x x) 261 (equal? a x))) 262 263 ($check-predicate ($let ((v (vector 1 2 3))) (equal? v v))) 264 ($check-predicate (equal? (vector 1 2 3) (vector 1 2 3))) 265 ($check-not-predicate (equal? (vector 1 2 3) (vector 4 5 6))) 266 ($check-not-predicate (equal? (vector 1 2 3) (vector 1 2))) 267 ($check-not-predicate (equal? (vector 1 2 3) (vector 2 3))) 268 269 ($check equal? 270 ($let ((v (vector 1 2)) (w (vector 1 3))) 271 (list (equal? v w) (equal? v w) (equal? v w) (equal? v w))) 272 (list #f #f #f #f)) 273 274 ($check-predicate 275 ($let* ((a (make-vector 100 1)) 276 (b (make-vector 100 1)) 277 (v (make-vector 100 a)) 278 (w (make-vector 100 b))) 279 (equal? v w))) 280 281 ($check-not-predicate 282 ($let* ((a (make-vector 100 1)) 283 (b (make-vector 100 1)) 284 (c (make-vector 100 1)) 285 (v (make-vector 100 a)) 286 (w (make-vector 100 b))) 287 (vector-set! c 50 2) 288 (vector-set! v 50 c) 289 (equal? v w))) 290 291 292 ($check-not-predicate 293 ($let ((v (make-vector 100000 #f)) 294 (w (make-vector 100000 #f))) 295 (vector-set! v 50000 #t) 296 (equal? v w))) 297 298 ($check-predicate 299 ($let* ((v1 (vector 1)) 300 (v2 (vector 1 v1)) 301 (v3 (vector 1 v1 v2))) 302 (equal? 303 v3 304 (vector 1 (vector 1) (vector 1 (vector 1)))))) 305 306 ($check-not-predicate 307 ($let* ((v1 (vector 1)) 308 (v2 (vector 1 v1)) 309 (v3 (vector 1 v1 v2))) 310 (equal? 311 v3 312 (vector 1 (vector 2) (vector 1 (vector 1)))))) 313 314 ($check-predicate 315 ($let* ((a (vector 1 5)) 316 (b (vector a 5)) 317 (c (vector b 5)) 318 (x (vector 1 5))) 319 (vector-set! a 0 c) 320 (vector-set! x 0 x) 321 (equal? a x))) 322 323 ($check-not-predicate 324 ($let* ((a (vector 1 5)) 325 (b (vector a 555)) 326 (c (vector b 5)) 327 (x (vector 1 5))) 328 (vector-set! a 0 c) 329 (vector-set! x 0 x) 330 (equal? a x))) 331 332 ($check-predicate 333 ($let* ((a (list 0 0 0)) 334 (b (list 0 0 0)) 335 (c (list 0 0 0)) 336 (v (vector a b c)) 337 (w (vector b a c))) 338 (set-car! a b) 339 (set-car! b c) 340 (set-car! c a) 341 (equal? v w))) 342 343 ($check-not-predicate 344 ($let* ((a (list 0 0 1)) 345 (b (list 0 0 2)) 346 (c (list 0 0 3)) 347 (v (vector a b c)) 348 (w (vector b a c))) 349 (set-car! a b) 350 (set-car! b c) 351 (set-car! c a) 352 (equal? v w))) 353 354 ;; 355 ;; two-argument equal? - different argument types 356 ;; 357 358 ($check-not-predicate (equal? 0 ())) 359 ($check-not-predicate (equal? 0 #f)) 360 ($check-not-predicate (equal? (vector) ())) 361 ($check-not-predicate (equal? (vector 1 2 3) (list 1 2 3))) 362 ($check-not-predicate (equal? (vector 1 2 3) (bytevector 1 2 3))) 363 ($check-not-predicate (equal? (string #\a) (list #\a))) 364 365 ;; 366 ;; 3 or more arguments 367 ;; 368 ($check-predicate (eq? 1 1 1)) 369 ($check-not-predicate (eq? #t #t #f)) 370 ($check-predicate (eq? #t #t . #0=(#t . #0#))) 371 ($check-not-predicate (eq? #t #t . #0=(#inert . #0#))) 372 373 ($check-predicate (equal? 1 1 1)) 374 ($check-not-predicate (equal? #t #t #f)) 375 ($check-predicate (equal? #t #t . #0=(#t . #0#))) 376 ($check-not-predicate (equal? #t #t . #0=(#inert . #0#))) 377 378 ($let ((p1 (list 1 2 1 2)) 379 (p2 (list 1 2))) 380 (encycle! p1 2 2) 381 (encycle! p2 0 2) 382 ($check-predicate (equal? p1 p2 . #0=(p2 p1 . #0#)))) 383 384 ;;; 385 ;;; Error Checking and Robustness 386 ;;; 387 388 ;; boolean? 389 ($check-error (eq? #t . #f)) 390 391 ($check-error (equal? #t . #f))