core/classes/classes-tests.factor

   1 USING: alien arrays generic assocs hashtables io
   2 io.streams.string kernel math namespaces parser prettyprint
   3 sequences strings tools.test vectors words quotations classes
   4 classes.private classes.union classes.mixin classes.predicate
   5 classes.algebra vectors definitions source-files compiler.units
   6 kernel.private sorting vocabs memory eval accessors sets ;
   7 IN: classes.tests
   8
   9 [ t ] [ 3 object instance? ] unit-test
  10 [ t ] [ 3 fixnum instance? ] unit-test
  11 [ f ] [ 3 float instance? ] unit-test
  12 [ t ] [ 3 number instance? ] unit-test
  13 [ f ] [ 3 null instance? ] unit-test
  14 [ t ] [ "hi" \ hi-tag instance? ] unit-test
  15
  16 ! Regression
  17 GENERIC: method-forget-test ( obj -- obj )
  18 TUPLE: method-forget-class ;
  19 M: method-forget-class method-forget-test ;
  20
  21 [ f ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
  22 [ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
  23 [ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
  24
  25 [ { } { } ] [
  26     all-words [ class? ] filter
  27     implementors-map get keys
  28     [ natural-sort ] bi@
  29     [ diff ] [ swap diff ] 2bi
  30 ] unit-test
  31
  32 ! Minor leak
  33 [ ] [ "IN: classes.tests TUPLE: forget-me ;" eval( -- ) ] unit-test
  34 [ ] [ f \ word set-global ] unit-test
  35 [ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval( -- ) ] unit-test
  36 [ ] [ "IN: classes.tests FORGET: forget-me" eval( -- ) ] unit-test
  37 [ 0 ] [
  38     [ word? ] instances
  39     [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
  40 ] unit-test
  41
  42 ! Long-standing problem
  43 USE: multiline
  44
  45 ! So the user has some code...
  46 [ ] [
  47     <" IN: classes.test.a
  48     GENERIC: g ( a -- b )
  49     TUPLE: x ;
  50     M: x g ;
  51     TUPLE: z < x ;"> <string-reader>
  52     "class-intersect-no-method-a" parse-stream drop
  53 ] unit-test
  54
  55 ! Note that q inlines M: x g ;
  56 [ ] [
  57     <" IN: classes.test.b
  58     USE: classes.test.a
  59     USE: kernel
  60     : q ( -- b ) z new g ;"> <string-reader>
  61     "class-intersect-no-method-b" parse-stream drop
  62 ] unit-test
  63
  64 ! Now, the user removes the z class and adds a method,
  65 [ ] [
  66     <" IN: classes.test.a
  67     GENERIC: g ( a -- b )
  68     TUPLE: x ;
  69     M: x g ;
  70     TUPLE: j ;
  71     M: j g ;"> <string-reader>
  72     "class-intersect-no-method-a" parse-stream drop
  73 ] unit-test
  74
  75 ! And changes the definition of q
  76 [ ] [
  77     <" IN: classes.test.b
  78     USE: classes.test.a
  79     USE: kernel
  80     : q ( -- b ) j new g ;"> <string-reader>
  81     "class-intersect-no-method-b" parse-stream drop
  82 ] unit-test
  83
  84 ! Similar problem, but with anonymous classes
  85 [ ] [
  86     <" IN: classes.test.c
  87     USE: kernel
  88     GENERIC: g ( a -- b )
  89     M: object g ;
  90     TUPLE: z ;"> <string-reader>
  91     "class-intersect-no-method-c" parse-stream drop
  92 ] unit-test
  93
  94 [ ] [
  95     <" IN: classes.test.d
  96     USE: classes.test.c
  97     USE: kernel
  98     : q ( a -- b ) dup z? [ g ] unless ;"> <string-reader>
  99     "class-intersect-no-method-d" parse-stream drop
 100 ] unit-test
 101
 102 ! Now, the user removes the z class and adds a method,
 103 [ ] [
 104     <" IN: classes.test.c
 105     USE: kernel
 106     GENERIC: g ( a -- b )
 107     M: object g ;
 108     TUPLE: j ;
 109     M: j g ;"> <string-reader>
 110     "class-intersect-no-method-c" parse-stream drop
 111 ] unit-test
 112
 113 TUPLE: forgotten-predicate-test ;
 114
 115 [ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
 116 [ f ] [ \ forgotten-predicate-test? predicate? ] unit-test