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 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
  15 ! Regression
  16 GENERIC: method-forget-test ( obj -- obj )
  17 TUPLE: method-forget-class ;
  18 M: method-forget-class method-forget-test ;
  19
  20 [ f ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
  21 [ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
  22 [ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
  23
  24 [ { } { } ] [
  25     all-words [ class? ] filter
  26     implementors-map get keys
  27     [ natural-sort ] bi@
  28     [ diff ] [ swap diff ] 2bi
  29 ] unit-test
  30
  31 ! Long-standing problem
  32 USE: multiline
  33
  34 ! So the user has some code...
  35 [ ] [
  36     """IN: classes.test.a
  37     GENERIC: g ( a -- b )
  38     TUPLE: x ;
  39     M: x g ;
  40     TUPLE: z < x ;""" <string-reader>
  41     "class-intersect-no-method-a" parse-stream drop
  42 ] unit-test
  43
  44 ! Note that q inlines M: x g ;
  45 [ ] [
  46     """IN: classes.test.b
  47     USE: classes.test.a
  48     USE: kernel
  49     : q ( -- b ) z new g ;""" <string-reader>
  50     "class-intersect-no-method-b" parse-stream drop
  51 ] unit-test
  52
  53 ! Now, the user removes the z class and adds a method,
  54 [ ] [
  55     """IN: classes.test.a
  56     GENERIC: g ( a -- b )
  57     TUPLE: x ;
  58     M: x g ;
  59     TUPLE: j ;
  60     M: j g ;""" <string-reader>
  61     "class-intersect-no-method-a" parse-stream drop
  62 ] unit-test
  63
  64 ! And changes the definition of q
  65 [ ] [
  66     """IN: classes.test.b
  67     USE: classes.test.a
  68     USE: kernel
  69     : q ( -- b ) j new g ;""" <string-reader>
  70     "class-intersect-no-method-b" parse-stream drop
  71 ] unit-test
  72
  73 ! Similar problem, but with anonymous classes
  74 [ ] [
  75     """IN: classes.test.c
  76     USE: kernel
  77     GENERIC: g ( a -- b )
  78     M: object g ;
  79     TUPLE: z ;""" <string-reader>
  80     "class-intersect-no-method-c" parse-stream drop
  81 ] unit-test
  82
  83 [ ] [
  84     """IN: classes.test.d
  85     USE: classes.test.c
  86     USE: kernel
  87     : q ( a -- b ) dup z? [ g ] unless ;""" <string-reader>
  88     "class-intersect-no-method-d" parse-stream drop
  89 ] unit-test
  90
  91 ! Now, the user removes the z class and adds a method,
  92 [ ] [
  93     """IN: classes.test.c
  94     USE: kernel
  95     GENERIC: g ( a -- b )
  96     M: object g ;
  97     TUPLE: j ;
  98     M: j g ;""" <string-reader>
  99     "class-intersect-no-method-c" parse-stream drop
 100 ] unit-test
 101
 102 ! Forget the above crap
 103 [
 104     { "classes.test.a" "classes.test.b" "classes.test.c" "classes.test.d" }
 105     [ forget-vocab ] each
 106 ] with-compilation-unit
 107
 108 TUPLE: forgotten-predicate-test ;
 109
 110 [ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
 111 [ f ] [ \ forgotten-predicate-test? predicate? ] unit-test
 112
 113 GENERIC: generic-predicate? ( a -- b )
 114
 115 [ ] [ "IN: classes.tests TUPLE: generic-predicate ;" eval( -- ) ] unit-test
 116
 117 [ f ] [ \ generic-predicate? generic? ] unit-test