basis/cocoa/cocoa-tests.factor

   1 USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
   2 compiler kernel namespaces cocoa.classes tools.test memory
   3 compiler.units math core-graphics.types ;
   4 IN: cocoa.tests
   5
   6 CLASS: {
   7     { +superclass+ "NSObject" }
   8     { +name+ "Foo" }
   9 } {
  10     "foo:"
  11     "void"
  12     { "id" "SEL" "NSRect" }
  13     [ gc "x" set 2drop ]
  14 } ;
  15
  16 : test-foo ( -- )
  17     Foo -> alloc -> init
  18     dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
  19     -> release ;
  20
  21 test-foo
  22
  23 [ 1.0 ] [ "x" get CGRect-x ] unit-test
  24 [ 2.0 ] [ "x" get CGRect-y ] unit-test
  25 [ 101.0 ] [ "x" get CGRect-w ] unit-test
  26 [ 102.0 ] [ "x" get CGRect-h ] unit-test
  27
  28 CLASS: {
  29     { +superclass+ "NSObject" }
  30     { +name+ "Bar" }
  31 } {
  32     "bar"
  33     "NSRect"
  34     { "id" "SEL" }
  35     [ 2drop test-foo "x" get ]
  36 } ;
  37
  38 Bar [
  39     -> alloc -> init
  40     dup -> bar "x" set
  41     -> release
  42 ] compile-call
  43
  44 [ 1.0 ] [ "x" get CGRect-x ] unit-test
  45 [ 2.0 ] [ "x" get CGRect-y ] unit-test
  46 [ 101.0 ] [ "x" get CGRect-w ] unit-test
  47 [ 102.0 ] [ "x" get CGRect-h ] unit-test
  48
  49 ! Make sure that we can add methods
  50 CLASS: {
  51     { +superclass+ "NSObject" }
  52     { +name+ "Bar" }
  53 } {
  54     "bar"
  55     "NSRect"
  56     { "id" "SEL" }
  57     [ 2drop test-foo "x" get ]
  58 } {
  59     "babb"
  60     "int"
  61     { "id" "SEL" "int" }
  62     [ 2nip sq ]
  63 } ;
  64
  65 [ 144 ] [
  66     Bar [
  67         -> alloc -> init
  68         dup 12 -> babb
  69         swap -> release
  70     ] compile-call
  71 ] unit-test