122 lines
3.4 KiB
Factor
122 lines
3.4 KiB
Factor
USING: alien arrays generic assocs hashtables io
|
|
io.streams.string kernel math namespaces parser prettyprint
|
|
sequences strings tools.test vectors words quotations classes
|
|
classes.private classes.union classes.mixin classes.predicate
|
|
classes.algebra definitions source-files compiler.units
|
|
kernel.private sorting vocabs memory eval accessors sets ;
|
|
IN: classes.tests
|
|
|
|
[ t ] [ 3 object instance? ] unit-test
|
|
[ t ] [ 3 fixnum instance? ] unit-test
|
|
[ f ] [ 3 float instance? ] unit-test
|
|
[ t ] [ 3 number instance? ] unit-test
|
|
[ f ] [ 3 null instance? ] unit-test
|
|
|
|
! Regression
|
|
GENERIC: method-forget-test ( obj -- obj )
|
|
TUPLE: method-forget-class ;
|
|
M: method-forget-class method-forget-test ;
|
|
|
|
[ f ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
|
|
[ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
|
|
[ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
|
|
|
|
[ { } { } ] [
|
|
all-words [ class? ] filter
|
|
implementors-map get keys
|
|
[ natural-sort ] bi@
|
|
[ diff ] [ swap diff ] 2bi
|
|
] unit-test
|
|
|
|
! Minor leak
|
|
[ ] [ "IN: classes.tests TUPLE: forget-me ;" eval( -- ) ] unit-test
|
|
[ ] [ f \ word set-global ] unit-test
|
|
[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval( -- ) ] unit-test
|
|
[ ] [ "IN: classes.tests FORGET: forget-me" eval( -- ) ] unit-test
|
|
[ 0 ] [
|
|
[ word? ] instances
|
|
[ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
|
|
] unit-test
|
|
|
|
! Long-standing problem
|
|
USE: multiline
|
|
|
|
! So the user has some code...
|
|
[ ] [
|
|
"""IN: classes.test.a
|
|
GENERIC: g ( a -- b )
|
|
TUPLE: x ;
|
|
M: x g ;
|
|
TUPLE: z < x ;""" <string-reader>
|
|
"class-intersect-no-method-a" parse-stream drop
|
|
] unit-test
|
|
|
|
! Note that q inlines M: x g ;
|
|
[ ] [
|
|
"""IN: classes.test.b
|
|
USE: classes.test.a
|
|
USE: kernel
|
|
: q ( -- b ) z new g ;""" <string-reader>
|
|
"class-intersect-no-method-b" parse-stream drop
|
|
] unit-test
|
|
|
|
! Now, the user removes the z class and adds a method,
|
|
[ ] [
|
|
"""IN: classes.test.a
|
|
GENERIC: g ( a -- b )
|
|
TUPLE: x ;
|
|
M: x g ;
|
|
TUPLE: j ;
|
|
M: j g ;""" <string-reader>
|
|
"class-intersect-no-method-a" parse-stream drop
|
|
] unit-test
|
|
|
|
! And changes the definition of q
|
|
[ ] [
|
|
"""IN: classes.test.b
|
|
USE: classes.test.a
|
|
USE: kernel
|
|
: q ( -- b ) j new g ;""" <string-reader>
|
|
"class-intersect-no-method-b" parse-stream drop
|
|
] unit-test
|
|
|
|
! Similar problem, but with anonymous classes
|
|
[ ] [
|
|
"""IN: classes.test.c
|
|
USE: kernel
|
|
GENERIC: g ( a -- b )
|
|
M: object g ;
|
|
TUPLE: z ;""" <string-reader>
|
|
"class-intersect-no-method-c" parse-stream drop
|
|
] unit-test
|
|
|
|
[ ] [
|
|
"""IN: classes.test.d
|
|
USE: classes.test.c
|
|
USE: kernel
|
|
: q ( a -- b ) dup z? [ g ] unless ;""" <string-reader>
|
|
"class-intersect-no-method-d" parse-stream drop
|
|
] unit-test
|
|
|
|
! Now, the user removes the z class and adds a method,
|
|
[ ] [
|
|
"""IN: classes.test.c
|
|
USE: kernel
|
|
GENERIC: g ( a -- b )
|
|
M: object g ;
|
|
TUPLE: j ;
|
|
M: j g ;""" <string-reader>
|
|
"class-intersect-no-method-c" parse-stream drop
|
|
] unit-test
|
|
|
|
! Forget the above crap
|
|
[
|
|
{ "classes.test.a" "classes.test.b" "classes.test.c" "classes.test.d" }
|
|
[ forget-vocab ] each
|
|
] with-compilation-unit
|
|
|
|
TUPLE: forgotten-predicate-test ;
|
|
|
|
[ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
|
|
[ f ] [ \ forgotten-predicate-test? predicate? ] unit-test
|