core/classes/classes-tests.factor

   1 USING: alien arrays definitions 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 ;
   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 [ t ] [
  26     all-words [ class? ] filter
  27     implementors-map get keys
  28     [ natural-sort ] bi@ =
  29 ] unit-test
  30
  31 ! Minor leak
  32 [ ] [ "IN: classes.tests TUPLE: forget-me ;" eval ] unit-test
  33 [ ] [ f \ word set-global ] unit-test
  34 [ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval ] unit-test
  35 [ ] [ "IN: classes.tests FORGET: forget-me" eval ] unit-test
  36 [ 0 ] [
  37     [ word? ] instances
  38     [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
  39 ] unit-test
  40
  41 ! Long-standing problem
  42 USE: multiline
  43
  44 ! So the user has some code...
  45 [ ] [
  46     <" IN: classes.test.a
  47     GENERIC: g ( a -- b )
  48     TUPLE: x ;
  49     M: x g ;
  50     TUPLE: z < x ;"> <string-reader>
  51     "class-intersect-no-method-a" parse-stream drop
  52 ] unit-test
  53
  54 ! Note that q inlines M: x g ;
  55 [ ] [
  56     <" IN: classes.test.b
  57     USE: classes.test.a
  58     USE: kernel
  59     : q ( -- b ) z new g ;"> <string-reader>
  60     "class-intersect-no-method-b" parse-stream drop
  61 ] unit-test
  62
  63 ! Now, the user removes the z class and adds a method,
  64 [ ] [
  65     <" IN: classes.test.a
  66     GENERIC: g ( a -- b )
  67     TUPLE: x ;
  68     M: x g ;
  69     TUPLE: j ;
  70     M: j g ;"> <string-reader>
  71     "class-intersect-no-method-a" parse-stream drop
  72 ] unit-test
  73
  74 ! And changes the definition of q
  75 [ ] [
  76     <" IN: classes.test.b
  77     USE: classes.test.a
  78     USE: kernel
  79     : q ( -- b ) j new g ;"> <string-reader>
  80     "class-intersect-no-method-b" parse-stream drop
  81 ] unit-test
  82
  83 ! Similar problem, but with anonymous classes
  84 [ ] [
  85     <" IN: classes.test.c
  86     USE: kernel
  87     GENERIC: g ( a -- b )
  88     M: object g ;
  89     TUPLE: z ;"> <string-reader>
  90     "class-intersect-no-method-c" parse-stream drop
  91 ] unit-test
  92
  93 [ ] [
  94     <" IN: classes.test.d
  95     USE: classes.test.c
  96     USE: kernel
  97     : q ( a -- b ) dup z? [ g ] unless ;"> <string-reader>
  98     "class-intersect-no-method-d" parse-stream drop
  99 ] unit-test
 100
 101 ! Now, the user removes the z class and adds a method,
 102 [ ] [
 103     <" IN: classes.test.c
 104     USE: kernel
 105     GENERIC: g ( a -- b )
 106     M: object g ;
 107     TUPLE: j ;
 108     M: j g ;"> <string-reader>
 109     "class-intersect-no-method-c" parse-stream drop
 110 ] unit-test
 111
 112 TUPLE: forgotten-predicate-test ;
 113
 114 [ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
 115 [ f ] [ \ forgotten-predicate-test? predicate? ] unit-test