1 USING: accessors arrays assocs calendar classes classes.algebra
2 classes.private classes.tuple classes.tuple.private columns
3 compiler.errors compiler.units continuations definitions
4 effects eval generic generic.single generic.standard grouping
5 io.streams.string kernel kernel.private math math.constants
6 math.order namespaces parser parser.notes prettyprint
7 quotations random see sequences sequences.private slots
8 slots.private splitting strings summary threads tools.test
9 vectors vocabs words words.symbol ;
10 IN: classes.tuple.tests
13 : <rect> ( x y w h -- rect ) rect boa ;
15 : move ( x rect -- rect )
18 [ f ] [ 10 20 30 40 <rect> dup clone 5 swap move = ] unit-test
20 [ t ] [ 10 20 30 40 <rect> dup clone 0 swap move = ] unit-test
22 ! Make sure we handle tuple class redefinition
23 TUPLE: redefinition-test ;
25 C: <redefinition-test> redefinition-test
27 <redefinition-test> "redefinition-test" set
29 [ t ] [ "redefinition-test" get redefinition-test? ] unit-test
31 "IN: classes.tuple.tests TUPLE: redefinition-test ;" eval( -- )
33 [ t ] [ "redefinition-test" get redefinition-test? ] unit-test
35 ! Make sure we handle changing shapes!
38 [ ] [ 100 200 point boa "p" set ] unit-test
40 ! Use eval to sequence parsing explicitly
41 [ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval( -- ) ] unit-test
43 [ 100 ] [ "p" get x>> ] unit-test
44 [ 200 ] [ "p" get y>> ] unit-test
45 [ f ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
47 [ ] [ "p" get 300 ">>z" "accessors" lookup execute drop ] unit-test
49 [ 3 ] [ "p" get tuple-size ] unit-test
51 [ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
53 [ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" eval( -- ) ] unit-test
55 [ 2 ] [ "p" get tuple-size ] unit-test
57 [ "p" get x>> ] must-fail
58 [ 200 ] [ "p" get y>> ] unit-test
59 [ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
61 TUPLE: predicate-test ;
63 C: <predicate-test> predicate-test
65 : predicate-test ( a -- ? ) drop f ;
67 [ t ] [ <predicate-test> predicate-test? ] unit-test
69 PREDICATE: silly-pred < tuple
72 GENERIC: area ( obj -- n )
73 M: silly-pred area dup w>> swap h>> * ;
75 TUPLE: circle radius ;
76 M: circle area radius>> sq pi * ;
78 [ 200 ] [ T{ rect f 0 0 10 20 } area ] unit-test
85 [ t ] [ <empty> hashcode fixnum? ] unit-test
88 [ t length ] [ object>> t eq? ] must-fail-with
90 [ "<constructor-test>" ]
91 [ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval( -- ) word name>> ] unit-test
93 TUPLE: size-test a b c d ;
96 T{ size-test } tuple-size
97 size-test tuple-layout second =
100 GENERIC: <yo-momma> ( a -- b )
104 [ ] [ "IN: classes.tuple.tests C: <yo-momma> yo-momma" eval( -- ) ] unit-test
106 [ f ] [ \ <yo-momma> generic? ] unit-test
110 [ t ] [ \ yo-momma class? ] unit-test
111 [ ] [ \ yo-momma forget ] unit-test
112 [ ] [ \ <yo-momma> forget ] unit-test
113 [ f ] [ \ yo-momma update-map get values memq? ] unit-test
114 ] with-compilation-unit
116 TUPLE: loc-recording ;
118 [ f ] [ \ loc-recording where not ] unit-test
120 ! 'forget' wasn't robust enough
122 TUPLE: forget-robustness ;
124 GENERIC: forget-robustness-generic ( a -- b )
126 M: forget-robustness forget-robustness-generic ;
128 M: integer forget-robustness-generic ;
131 [ ] [ \ forget-robustness-generic forget ] unit-test
132 [ ] [ \ forget-robustness forget ] unit-test
133 [ ] [ M\ forget-robustness forget-robustness-generic forget ] unit-test
134 ] with-compilation-unit
136 ! rapido found this one
137 GENERIC# m1 0 ( s n -- n )
138 GENERIC# m2 1 ( s n -- v )
162 [ 1 ] [ 1 <t4> m1 ] unit-test
163 [ 1 ] [ <t4> 1 m2 ] unit-test
165 ! another combination issue
166 GENERIC: silly ( obj -- obj obj )
168 UNION: my-union slice repetition column array vector reversed ;
170 M: my-union silly "x" ;
174 M: column silly "fdsfds" ;
176 M: repetition silly "zzz" ;
178 M: reversed silly "zz" ;
180 M: slice silly "tt" ;
182 M: string silly "t" ;
184 M: vector silly "z" ;
186 [ "zz" ] [ 123 <reversed> silly nip ] unit-test
189 SYMBOL: not-a-tuple-class
192 [ not-a-tuple-class boa ] must-fail
193 [ not-a-tuple-class new ] must-fail
195 TUPLE: erg's-reshape-problem a b c d ;
197 C: <erg's-reshape-problem> erg's-reshape-problem
200 TUPLE: computer cpu ram ;
201 C: <computer> computer
203 [ "TUPLE: computer cpu ram ;" ] [
204 [ \ computer see ] with-string-writer string-lines second
207 TUPLE: laptop < computer battery ;
210 [ t ] [ laptop tuple-class? ] unit-test
211 [ t ] [ laptop tuple class<= ] unit-test
212 [ t ] [ laptop computer class<= ] unit-test
213 [ t ] [ laptop computer classes-intersect? ] unit-test
215 [ ] [ "Pentium" 128 3 hours <laptop> "laptop" set ] unit-test
216 [ t ] [ "laptop" get laptop? ] unit-test
217 [ t ] [ "laptop" get computer? ] unit-test
218 [ t ] [ "laptop" get tuple? ] unit-test
220 : test-laptop-slot-values ( -- )
221 [ laptop ] [ "laptop" get class ] unit-test
222 [ "Pentium" ] [ "laptop" get cpu>> ] unit-test
223 [ 128 ] [ "laptop" get ram>> ] unit-test
224 [ t ] [ "laptop" get battery>> 3 hours = ] unit-test ;
226 test-laptop-slot-values
228 [ "TUPLE: laptop < computer battery ;" ] [
229 [ \ laptop see ] with-string-writer string-lines second
232 [ { tuple computer laptop } ] [ laptop superclasses ] unit-test
234 TUPLE: server < computer rackmount ;
237 [ t ] [ server tuple-class? ] unit-test
238 [ t ] [ server tuple class<= ] unit-test
239 [ t ] [ server computer class<= ] unit-test
240 [ t ] [ server computer classes-intersect? ] unit-test
242 [ ] [ "PowerPC" 64 "1U" <server> "server" set ] unit-test
243 [ t ] [ "server" get server? ] unit-test
244 [ t ] [ "server" get computer? ] unit-test
245 [ t ] [ "server" get tuple? ] unit-test
247 : test-server-slot-values ( -- )
248 [ server ] [ "server" get class ] unit-test
249 [ "PowerPC" ] [ "server" get cpu>> ] unit-test
250 [ 64 ] [ "server" get ram>> ] unit-test
251 [ "1U" ] [ "server" get rackmount>> ] unit-test ;
253 test-server-slot-values
255 [ f ] [ "server" get laptop? ] unit-test
256 [ f ] [ "laptop" get server? ] unit-test
258 [ f ] [ server laptop class<= ] unit-test
259 [ f ] [ laptop server class<= ] unit-test
260 [ f ] [ laptop server classes-intersect? ] unit-test
262 [ f ] [ 1 2 <computer> laptop? ] unit-test
263 [ f ] [ \ + server? ] unit-test
265 [ "TUPLE: server < computer rackmount ;" ] [
266 [ \ server see ] with-string-writer string-lines second
270 "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" eval( -- )
273 ! Dynamically changing inheritance hierarchy
274 TUPLE: electronic-device ;
276 [ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
278 [ f ] [ electronic-device laptop class<= ] unit-test
279 [ t ] [ server electronic-device class<= ] unit-test
280 [ t ] [ laptop server class-or electronic-device class<= ] unit-test
282 [ t ] [ "laptop" get electronic-device? ] unit-test
283 [ t ] [ "laptop" get computer? ] unit-test
284 [ t ] [ "laptop" get laptop? ] unit-test
285 [ f ] [ "laptop" get server? ] unit-test
287 [ t ] [ "server" get electronic-device? ] unit-test
288 [ t ] [ "server" get computer? ] unit-test
289 [ f ] [ "server" get laptop? ] unit-test
290 [ t ] [ "server" get server? ] unit-test
292 [ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
294 [ f ] [ "laptop" get electronic-device? ] unit-test
295 [ t ] [ "laptop" get computer? ] unit-test
297 [ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
299 test-laptop-slot-values
300 test-server-slot-values
302 [ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
304 test-laptop-slot-values
305 test-server-slot-values
307 TUPLE: make-me-some-accessors voltage grounded? ;
309 [ f ] [ "laptop" get voltage>> ] unit-test
310 [ f ] [ "server" get voltage>> ] unit-test
312 [ ] [ "laptop" get 220 >>voltage drop ] unit-test
313 [ ] [ "server" get 110 >>voltage drop ] unit-test
315 [ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ; C: <computer> computer" eval( -- ) ] unit-test
317 test-laptop-slot-values
318 test-server-slot-values
320 [ 220 ] [ "laptop" get voltage>> ] unit-test
321 [ 110 ] [ "server" get voltage>> ] unit-test
323 [ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
325 test-laptop-slot-values
326 test-server-slot-values
328 [ 220 ] [ "laptop" get voltage>> ] unit-test
329 [ 110 ] [ "server" get voltage>> ] unit-test
331 ! Reshaping superclass and subclass simultaneously
332 [ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
334 test-laptop-slot-values
335 test-server-slot-values
337 [ 220 ] [ "laptop" get voltage>> ] unit-test
338 [ 110 ] [ "server" get voltage>> ] unit-test
341 TUPLE: test1 a ; TUPLE: test2 < test1 b ;
343 "a" "b" test2 boa "test" set
346 [ "a" ] [ "test" get a>> ] unit-test
347 [ "b" ] [ "test" get b>> ] unit-test ;
351 [ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval( -- ) ] unit-test
355 [ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval( -- ) ] unit-test
359 ! Twice in the same compilation unit
361 test1 tuple { "a" "x" "y" } define-tuple-class
362 test1 tuple { "a" "y" } define-tuple-class
363 ] with-compilation-unit
367 ! Moving slots up and down
368 TUPLE: move-up-1 a b ;
369 TUPLE: move-up-2 < move-up-1 c ;
371 T{ move-up-2 f "a" "b" "c" } "move-up" set
373 : test-move-up ( -- )
374 [ "a" ] [ "move-up" get a>> ] unit-test
375 [ "b" ] [ "move-up" get b>> ] unit-test
376 [ "c" ] [ "move-up" get c>> ] unit-test ;
380 [ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval( -- ) ] unit-test
384 [ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval( -- ) ] unit-test
388 [ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval( -- ) ] unit-test
392 [ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval( -- ) ] unit-test
394 ! Constructors must be recompiled when changing superclass
395 TUPLE: constructor-update-1 xxx ;
397 TUPLE: constructor-update-2 < constructor-update-1 yyy zzz ;
399 : <constructor-update-2> ( a b c -- tuple ) constructor-update-2 boa ;
401 { 3 1 } [ <constructor-update-2> ] must-infer-as
403 [ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval( -- ) ] unit-test
405 { 3 1 } [ <constructor-update-2> ] must-infer-as
407 [ 1 2 3 4 5 <constructor-update-2> ] [ not-compiled? ] must-fail-with
409 [ ] [ [ \ <constructor-update-2> forget ] with-compilation-unit ] unit-test
411 ! Redefinition problem
412 TUPLE: redefinition-problem ;
414 UNION: redefinition-problem' redefinition-problem integer ;
416 [ t ] [ 3 redefinition-problem'? ] unit-test
418 TUPLE: redefinition-problem-2 ;
420 "IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval( -- )
422 [ t ] [ 3 redefinition-problem'? ] unit-test
424 ! Hardcore unit tests
426 \ thread "slots" word-prop "slots" set
430 \ thread tuple { "xxx" } "slots" get append
432 ] with-compilation-unit
434 [ 1337 sleep ] "Test" spawn drop
437 \ thread tuple "slots" get
439 ] with-compilation-unit
442 \ vocab "slots" word-prop "slots" set
446 \ vocab tuple { "xxx" } "slots" get append
448 ] with-compilation-unit
453 \ vocab tuple "slots" get
455 ] with-compilation-unit
458 [ "USE: words T{ word }" eval( -- ) ]
459 [ error>> T{ no-method f word new } = ]
462 ! Accessors not being forgotten...
464 "IN: classes.tuple.tests TUPLE: forget-accessors-test x y z ;"
466 "forget-accessors-test" parse-stream
469 [ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
471 : accessor-exists? ( name -- ? )
472 [ "forget-accessors-test" "classes.tuple.tests" lookup ] dip
473 ">>" append "accessors" lookup method >boolean ;
475 [ t ] [ "x" accessor-exists? ] unit-test
476 [ t ] [ "y" accessor-exists? ] unit-test
477 [ t ] [ "z" accessor-exists? ] unit-test
480 "IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b )"
482 "forget-accessors-test" parse-stream
485 [ f ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
487 [ f ] [ "x" accessor-exists? ] unit-test
488 [ f ] [ "y" accessor-exists? ] unit-test
489 [ f ] [ "z" accessor-exists? ] unit-test
491 TUPLE: another-forget-accessors-test ;
495 "IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b )"
497 "another-forget-accessors-test" parse-stream
500 [ t ] [ \ another-forget-accessors-test class? ] unit-test
506 "IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval( -- )
507 ] with-string-writer empty?
511 ! Missing error check
512 [ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" eval( -- ) ] must-fail
514 ! Class forget messyness
515 TUPLE: subclass-forget-test ;
517 TUPLE: subclass-forget-test-1 < subclass-forget-test ;
518 TUPLE: subclass-forget-test-2 < subclass-forget-test ;
519 TUPLE: subclass-forget-test-3 < subclass-forget-test-2 ;
521 [ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" eval( -- ) ] unit-test
523 [ { subclass-forget-test-2 } ]
524 [ subclass-forget-test-2 class-usages ]
527 [ { subclass-forget-test-3 } ]
528 [ subclass-forget-test-3 class-usages ]
531 [ f ] [ subclass-forget-test-1 tuple-class? ] unit-test
532 [ f ] [ subclass-forget-test-2 tuple-class? ] unit-test
533 [ subclass-forget-test-3 new ] must-fail
535 [ "IN: classes.tuple.tests TUPLE: subclass-forget-test-4 < subclass-forget-test-2 ;" eval( -- ) ] must-fail
538 DEFER: subclass-reset-test
539 DEFER: subclass-reset-test-1
540 DEFER: subclass-reset-test-2
541 DEFER: subclass-reset-test-3
543 GENERIC: break-me ( obj -- )
545 [ ] [ [ M\ integer break-me forget ] with-compilation-unit ] unit-test
547 [ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
548 [ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" eval( -- ) ] unit-test
549 [ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-2 < subclass-reset-test ;" eval( -- ) ] unit-test
550 [ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-3 < subclass-reset-test-2 ;" eval( -- ) ] unit-test
552 [ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" eval( -- ) ] unit-test
554 [ ] [ "IN: classes.tuple.tests : subclass-reset-test ( -- ) ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
556 [ f ] [ subclass-reset-test-1 tuple-class? ] unit-test
557 [ f ] [ subclass-reset-test-2 tuple-class? ] unit-test
558 [ subclass-forget-test-3 new ] must-fail
560 [ t ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test
562 [ ] [ "IN: classes.tuple.tests USE: math USE: kernel M: integer break-me drop ;" eval( -- ) ] unit-test
564 [ f ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test
566 ! Insufficient type checking
567 [ \ vocab tuple>array drop ] must-fail
569 ! Check type declarations
570 TUPLE: declared-types { n fixnum } { m string } ;
572 [ T{ declared-types f 0 "hi" } ]
573 [ { declared-types 0 "hi" } >tuple ]
576 [ { declared-types "hi" 0 } >tuple ]
577 [ T{ bad-slot-value f "hi" fixnum } = ]
580 [ T{ declared-types f 0 "hi" } ]
581 [ 0.0 "hi" declared-types boa ] unit-test
583 : foo ( a b -- c ) declared-types boa ;
585 \ foo def>> must-infer
587 [ T{ declared-types f 0 "hi" } ] [ 0.0 "hi" foo ] unit-test
589 [ "hi" 0.0 declared-types boa ]
590 [ T{ no-method f "hi" >fixnum } = ]
593 [ 0 { } declared-types boa ]
594 [ T{ bad-slot-value f { } string } = ]
598 [ T{ no-method f "hi" >fixnum } = ]
602 [ T{ bad-slot-value f { } string } = ]
605 [ T{ declared-types f 0 "" } ] [ declared-types new ] unit-test
607 : blah ( -- vec ) vector new ;
609 [ vector new ] must-infer
611 [ V{ } ] [ blah ] unit-test
613 ! Test reshaping with type declarations and slot attributes
614 TUPLE: reshape-test x ;
616 T{ reshape-test f "hi" } "tuple" set
618 [ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval( -- ) ] unit-test
620 [ f ] [ \ reshape-test \ (>>x) method ] unit-test
622 [ "tuple" get 5 >>x ] must-fail
624 [ "hi" ] [ "tuple" get x>> ] unit-test
626 [ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" eval( -- ) ] unit-test
628 [ 0 ] [ "tuple" get x>> ] unit-test
630 [ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval( -- ) ] unit-test
632 [ 0 ] [ "tuple" get x>> ] unit-test
634 TUPLE: boa-coercer-test { x array-capacity } ;
636 [ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class ] unit-test
638 [ T{ boa-coercer-test f 0 } ] [ T{ boa-coercer-test } ] unit-test
641 ERROR: error-class-test a b c ;
643 [ "( a b c -- * )" ] [ \ error-class-test stack-effect effect>string ] unit-test
644 [ f ] [ \ error-class-test "inline" word-prop ] unit-test
646 [ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" eval( -- ) ]
647 [ error>> error>> redefine-error? ] must-fail-with
651 [ ] [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test
653 [ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval( -- ) ] unit-test
655 [ f ] [ \ error-y tuple-class? ] unit-test
657 [ t ] [ \ error-y generic? ] unit-test
659 [ ] [ "IN: classes.tuple.tests ERROR: error-y ;" eval( -- ) ] unit-test
661 [ t ] [ \ error-y tuple-class? ] unit-test
663 [ f ] [ \ error-y generic? ] unit-test
666 "IN: classes.tuple.tests TUPLE: forget-subclass-test ; TUPLE: forget-subclass-test' < forget-subclass-test ;"
667 <string-reader> "forget-subclass-test" parse-stream
671 [ ] [ "forget-subclass-test'" "classes.tuple.tests" lookup new "bad-object" set ] unit-test
674 "IN: classes.tuple.tests TUPLE: forget-subclass-test a ;"
675 <string-reader> "forget-subclass-test" parse-stream
680 "IN: sequences TUPLE: reversed { seq read-only } ;" eval( -- )
683 TUPLE: bogus-hashcode-1 x ;
685 TUPLE: bogus-hashcode-2 x ;
687 M: bogus-hashcode-1 hashcode* 2drop 0 >bignum ;
689 [ ] [ T{ bogus-hashcode-2 f T{ bogus-hashcode-1 } } hashcode drop ] unit-test
691 DEFER: change-slot-test
695 "IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
696 <string-reader> "change-slot-test" parse-stream
700 [ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test
703 "IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test kex ;"
704 <string-reader> "change-slot-test" parse-stream
708 [ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test
711 "IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
712 <string-reader> "change-slot-test" parse-stream
716 [ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test
717 [ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test
719 DEFER: redefine-tuple-twice
721 [ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
723 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test
725 [ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval( -- ) ] unit-test
727 [ t ] [ \ redefine-tuple-twice deferred? ] unit-test
729 [ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
731 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test