]> gitweb.factorcode.org Git - factor.git/blob - basis/cocoa/cocoa-tests.factor
4b5af2e39d3ce533aa8b24b0a7512df388b15edc
[factor.git] / basis / cocoa / cocoa-tests.factor
1 IN: cocoa.tests
2 USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
3 compiler kernel namespaces cocoa.classes tools.test memory
4 compiler.units math core-graphics.types ;
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