basis/cocoa/cocoa-tests.factor

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