Read floating point explicitely as double-float to ensure successful
[com-informatimago:com-informatimago.git] / objcl / test-objcl.lisp
1 ;;;; -*- mode:lisp;coding:utf-8 -*-
2 ;;;;**************************************************************************
3 ;;;;FILE:               test-objcl.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             Common-Lisp
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    Tests the objcl reader macro parser functions.
10 ;;;;    
11 ;;;;AUTHORS
12 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
13 ;;;;MODIFICATIONS
14 ;;;;    2010-12-14 <PJB> Created.
15 ;;;;BUGS
16 ;;;;    Should add more tests for error cases.
17 ;;;;LEGAL
18 ;;;;    AGPL3
19 ;;;;    
20 ;;;;    Copyright Pascal J. Bourguignon 2010 - 2012
21 ;;;;    
22 ;;;;    This program is free software: you can redistribute it and/or modify
23 ;;;;    it under the terms of the GNU Affero General Public License as published by
24 ;;;;    the Free Software Foundation, either version 3 of the License, or
25 ;;;;    (at your option) any later version.
26 ;;;;    
27 ;;;;    This program is distributed in the hope that it will be useful,
28 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
29 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
30 ;;;;    GNU Affero General Public License for more details.
31 ;;;;    
32 ;;;;    You should have received a copy of the GNU Affero General Public License
33 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
34 ;;;;**************************************************************************
35
36 (in-package "COM.INFORMATIMAGO.OBJECTIVE-CL")
37
38
39
40 ;; When reading expressions in the tests, we need to set the package
41 ;; to ensure the symbols are read in the expected package.
42
43
44 (defmacro with-string-check ((readtable stream string) &body body)
45   `(with-input-from-string (,stream ,string)
46      (let ((*readtable* ,readtable)
47            (*read-default-float-format* 'double-float))
48        (locally ,@body))))
49
50
51 (define-test test/read-identifier ()
52   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
53    (test string=
54          (with-string-check (*objc-readtable*
55                              stream "hello42World:")
56            (read-identifier stream))
57          "hello42World")))
58
59
60 (define-test test/read-type-specifier ()
61   "
62     type-specifier :='(' type-identifier ')' .
63 "
64   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
65    (test equal
66          (with-string-check (*objc-readtable*
67                              stream "(int)arg")
68            (read-type-specifier stream))
69          :int)))
70
71
72 (define-test test/read-method-signature ()
73   "
74     signature          := simple-signature | compound-signature final-signature .
75
76     simple-signature   := objcl-identifier .
77     compound-signature := [objcl-identifier] ':' '(' type-identifier ')' objcl-identifier compound-signature
78                         | [objcl-identifier] ':' '(' type-identifier ')' objcl-identifier .
79 "
80   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
81    (test equal
82          (with-string-check (*objc-readtable*
83                              stream "simpleSelector)")
84            (read-method-signature stream))
85          '("simpleSelector" nil nil))
86    (test equal
87          (with-string-check (*objc-readtable*
88                              stream "singleArgComplexSelector:(int)arg)")
89            (read-method-signature stream))
90          '("singleArgComplexSelector:" ((:int arg)) nil))
91    (test equal
92          (with-string-check (*objc-readtable*
93                              stream "multipleArg:(int)arg1 complexSelector:(int)arg2)")
94            (read-method-signature stream))
95          '("multipleArg:complexSelector:" ((:int arg1) (:int arg2)) nil))
96    (test equal
97          (with-string-check (*objc-readtable*
98                              stream "multipleArgWithEmptyPart:(int)arg1 :(int)arg2)")
99            (read-method-signature stream))
100          '("multipleArgWithEmptyPart::" ((:int arg1) (:int arg2)) nil))
101
102    (test equal
103          (with-string-check (*objc-readtable*
104                              stream "singleArgComplexSelector:(int)arg &rest others)")
105            (read-method-signature stream))
106          '("singleArgComplexSelector:" ((:int arg)) others))
107    (test equal
108          (with-string-check (*objc-readtable*
109                              stream "multipleArg:(int)arg1 complexSelector:(int)arg2  &rest others)")
110            (read-method-signature stream))
111          '("multipleArg:complexSelector:" ((:int arg1) (:int arg2)) others))
112    (test equal
113          (with-string-check (*objc-readtable*
114                              stream "multipleArgWithEmptyPart:(int)arg1 :(int)arg2  &rest others)")
115            (read-method-signature stream))
116          '("multipleArgWithEmptyPart::" ((:int arg1) (:int arg2)) others))))
117
118
119
120 (define-test test/read-final-arguments ()
121   "
122     final-arguments    := | '(' type-identifier ')' objcl-expression  final-arguments .
123     type-identifier    := symbol .
124 "
125   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
126    (test equal
127          (with-string-check (*objc-readtable*
128                              stream "]")
129            (read-final-arguments stream))
130          '())
131    (test equal
132          (with-string-check (*objc-readtable*
133                              stream "(integer)(+ one 2)]")
134            (read-final-arguments stream))
135          '((:integer (+ one 2))))
136    (test equal
137          (with-string-check (*objc-readtable*
138                              stream "(integer)(+ 1 2) (float)(+ 1.0 2.0)]")
139            (read-final-arguments stream))
140          '((:integer (+ 1 2)) (:float (+ 1.0d0 2.0d0))))
141    (test eql
142          (handler-case
143              (progn
144                (with-string-check (*objc-readtable*
145                                    stream "(integer)(+ 1 2) (float)]")
146                  (read-final-arguments stream))
147                nil)
148            (error () :success))
149          :success)))
150
151
152
153 (define-test test/read-message ()
154   "
155     message            := simple-selector | compound-selector final-arguments .
156
157     simple-selector    := objcl-identifier .
158     compound-selector  := [objcl-identifier] ':' objcl-expression compound-selector
159                         | [objcl-identifier] ':' objcl-expression .
160 "
161   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
162    (test equal
163          (with-string-check (*objc-readtable*
164                              stream "simpleSelector]")
165            (read-message stream))
166          '("simpleSelector" nil nil))
167    (test equal
168          (with-string-check (*objc-readtable*
169                              stream "singleArgComplexSelector:42]")
170            (read-message stream))
171          '("singleArgComplexSelector:" (42) nil))
172    (test equal
173          (with-string-check (*objc-readtable*
174                              stream "multipleArg:42 complexSelector:24]")
175            (read-message stream))
176          '("multipleArg:complexSelector:" (42 24) nil))
177    (test equal
178          (with-string-check (*objc-readtable*
179                              stream "multipleArg:(+ 4 2) complexSelector:(* 2 4)]")
180            (read-message stream))
181          '("multipleArg:complexSelector:" ((+ 4 2) (* 2 4)) nil))
182    (test equal
183          (with-string-check (*objc-readtable*
184                              stream "multipleArg:[self one] complexSelector:[self two]]")
185            (read-message stream))
186          `("multipleArg:complexSelector:"
187            (,(generate-message-send 'self '"one" 'nil 'nil)
188              ,(generate-message-send 'self '"two" 'nil 'nil))
189            nil))
190    (test equal
191          (with-string-check (*objc-readtable*
192                              stream "multipleArgWithEmptyPart:42 :24]")
193            (read-message stream))
194          '("multipleArgWithEmptyPart::" (42 24) nil))
195    (test equal
196          (with-string-check (*objc-readtable*
197                              stream "singleArgComplexSelectorWithFinalArgs:42
198                                                     (int)1]")
199            (read-message stream))
200          '("singleArgComplexSelectorWithFinalArgs:" (42) ((:int 1))))
201    (test equal
202          (with-string-check (*objc-readtable*
203                              stream "multipleArg:42
204                                complexSelectorWithFinalArgs:24
205                                              (int)1 (float)2.0]")
206            (read-message stream))
207          '("multipleArg:complexSelectorWithFinalArgs:" (42 24) ((:int 1) (:float 2.0d0))))))
208
209
210 (define-test test/read-message-send ()
211   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
212     (test equal
213           (with-string-check (*objc-readtable*
214                               stream "simpleSelector]")
215             (read-message-send stream 'self (function read-message)))
216           '(self "simpleSelector" nil nil))
217     (test equal
218           (with-string-check (*objc-readtable*
219                               stream "singleArgComplexSelector:42]")
220             (read-message-send stream 'self (function read-message)))
221           '(self "singleArgComplexSelector:" (42) nil))
222     (test equal
223           (with-string-check (*objc-readtable*
224                               stream "multipleArg:42 complexSelector:24]")
225             (read-message-send stream 'self (function read-message)))
226           '(self "multipleArg:complexSelector:" (42 24) nil))
227     (test equal
228           (with-string-check (*objc-readtable*
229                               stream "multipleArg:(+ 4 2) complexSelector:(* 2 4)]")
230             (read-message-send stream 'self (function read-message)))
231           '(self "multipleArg:complexSelector:" ((+ 4 2) (* 2 4)) nil))
232     (test equal
233           (with-string-check (*objc-readtable*
234                               stream "multipleArg:[self one] complexSelector:[self two]]")
235             (read-message-send stream 'self (function read-message)))
236           `(self "multipleArg:complexSelector:"
237                  (,(generate-message-send 'self '"one" 'nil 'nil)
238                    ,(generate-message-send 'self '"two" 'nil 'nil))
239                  nil))
240     (test equal
241           (with-string-check (*objc-readtable*
242                               stream "multipleArgWithEmptyPart:42 :24]")
243             (read-message-send stream 'self (function read-message)))
244           '(self "multipleArgWithEmptyPart::" (42 24) nil))
245     (test equal
246           (with-string-check (*objc-readtable*
247                               stream "singleArgComplexSelectorWithFinalArgs:42
248                                                     (int)1]")
249             (read-message-send stream 'self (function read-message)))
250           '(self "singleArgComplexSelectorWithFinalArgs:" (42) ((:int 1))))
251     (test equal
252           (with-string-check (*objc-readtable*
253                               stream "multipleArg:42
254                                complexSelectorWithFinalArgs:24
255                                              (int)1 (float)2.0]")
256             (read-message-send stream 'self (function read-message)))
257           '(self "multipleArg:complexSelectorWithFinalArgs:" (42 24) ((:int 1) (:float 2.0d0))))))
258
259
260 (define-test test/message-send ()
261   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))                  
262    (flet ((gen (args) (apply (function generate-message-send) args)))
263      (declare (inline gen))
264      (test equal
265            (gen '(self "simpleSelector" nil nil))
266            '(oclo:send self 'simple-selector))
267      (test equal
268            (gen '(self "singleArgComplexSelector:" (42) nil))
269            '(oclo:send self :single-arg-complex-selector 42))
270      (test equal
271            (gen '(self "multipleArg:complexSelector:" (42 24) nil))
272            '(oclo:send self :multiple-arg 42 :complex-selector 24))
273      (test equal
274            (gen '(self "multipleArg:complexSelector:" ((+ 4 2) (* 2 4)) nil))
275            '(oclo:send self :multiple-arg (+ 4 2) :complex-selector (* 2 4)))
276      (test equal
277            (gen `(self "multipleArg:complexSelector:"
278                        (,(generate-message-send 'self '"one" 'nil 'nil)
279                          ,(generate-message-send 'self '"two" 'nil 'nil))
280                        nil))
281            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
282      (test equal
283            (gen '(self "multipleArgWithEmptyPart::" (42 24) nil))
284            '(oclo:send self :multiple-arg-with-empty-part 42 :|| 24))
285      (test equal
286            (gen '(self "singleArgComplexSelectorWithFinalArgs:" (42) ((:int 1))))
287            '(oclo:send self :single-arg-complex-selector-with-final-args 42 (:int 1)))
288      (test equal
289            (gen '(self "multipleArg:complexSelectorWithFinalArgs:" (42 24) ((:int 1) (:float 2.0d0))))
290            '(oclo:send self :multiple-arg 42 :complex-selector-with-final-args 24 (:int 1 :float 2.0d0))))))
291
292
293 (define-test test/read-objcl-message-send ()
294   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
295    (flet ((read-objc (source)
296             (let ((*readtable* *objective-cl-readtable*))
297               (read-from-string source))))
298      (declare (inline read-objc))
299      (test equal
300            (read-objc "[self simpleSelector]")
301            '(oclo:send self 'simple-selector))
302      (test equal
303            (read-objc "[[NSData alloc] init]")
304            '(oclo:send (oclo:send ns:ns-data 'alloc) 'init))
305      (test equal
306            (read-objc "[[my-obj doSomething] doSomethingElse]")
307            '(oclo:send (oclo:send my-obj 'do-something) 'do-something-else))
308      (test equal
309            (read-objc "[self singleArgComplexSelector:42]")
310            '(oclo:send self :single-arg-complex-selector 42))
311      (test equal
312            (read-objc "[self singleArgComplexSelector:(+ 4 2)]")
313            '(oclo:send self :single-arg-complex-selector (+ 4 2)))
314      (test equal
315            (read-objc "[self singleArgComplexSelector:(+ 4 XYZ)]")
316            '(oclo:send self :single-arg-complex-selector (+ 4 xyz)))
317      (test equal
318            (read-objc "[self singleArgComplexSelector:abc]")
319            '(oclo:send self :single-arg-complex-selector abc))
320      (test equal
321            (read-objc "[self multipleArg:42 complexSelector:24]")
322            '(oclo:send self :multiple-arg 42 :complex-selector 24))
323      (test equal
324            (read-objc "[self multipleArg: (+ 4 2) complexSelector: (* 2 4) ]")
325            '(oclo:send self :multiple-arg (+ 4 2) :complex-selector (* 2 4)))
326      (test equal
327            (read-objc "[self multipleArg:[self one]complexSelector:[self two]]")
328            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
329      (test equal
330            (read-objc "[self multipleArg:[self one]
331              complexSelector:[self two]]")
332            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
333      (test equal
334            (read-objc "[self multipleArg: [self one]
335              complexSelector: [self two]  ]")
336            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
337      (test equal
338            (read-objc "[self multipleArgWithEmptyPart:42 :24]")
339            '(oclo:send self :multiple-arg-with-empty-part 42 :|| 24))
340      (test equal
341            (read-objc "[self multipleArgWithEmptyPart:42 : 24 ]")
342            '(oclo:send self :multiple-arg-with-empty-part 42 :|| 24))
343      (test equal
344            (read-objc "[self multipleArgWithEmptyPart:ABC :DEF]")
345            '(oclo:send self :multiple-arg-with-empty-part abc :|| def))
346      (test equal
347            (read-objc "[self singleArgComplexSelectorWithFinalArgs:42 (:int)1]")
348            '(oclo:send self :single-arg-complex-selector-with-final-args 42 (:int 1)))
349      (test equal
350            (read-objc "[self singleArgComplexSelectorWithFinalArgs:42(:int)  1 ]")
351            '(oclo:send self :single-arg-complex-selector-with-final-args 42 (:int 1)))
352      (test equal
353            (read-objc "[self multipleArg:42 complexSelectorWithFinalArgs:24 (:int)1 (:float)2.0]")
354            '(oclo:send self
355              :multiple-arg 42
356              :complex-selector-with-final-args 24
357              (:int 1 :float 2.0d0)))
358      (test equal
359            (read-objc "(progn [self simpleSelector]
360                              [self multipleArg:42 complexSelector:24])")
361            '(progn
362              (oclo:send self 'simple-selector)
363              (oclo:send self :multiple-arg 42 :complex-selector 24))))))
364
365 (define-test test/read-objcl-class-definition ()
366   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
367    (flet ((read-objc (source)
368             (let ((*readtable* *objective-cl-readtable*))
369               (read-from-string source))))
370      (declare (inline read-objc))
371      (test equal
372            (read-objc "@[NSObject subClass:Example slots:(
373                          one
374                          two
375                          three)]")
376            '(defclass example (ns:ns-object)
377              (one
378               two
379               three)
380              (:metaclass ns:+ns-object))))))
381
382
383
384 (defun equal-modulo-constant-strings (a b)
385   (cond
386     ((typep a 'ns:ns-string)
387      (and (consp b) (eql '\@ (car b))))
388     ((and (consp a) (consp b))
389      (and (equal-modulo-constant-strings (car a) (car b))
390           (equal-modulo-constant-strings (cdr a) (cdr b))))
391     (t
392      (equal a b))))
393
394 (define-test test/read-objcl-class-method-definition ()
395   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
396     (flet ((read-objc (source)
397             (let ((*readtable* *objective-cl-readtable*))
398               (read-from-string source))))
399      (declare (inline read-objc))
400      (test equal-modulo-constant-strings
401            (read-objc "@[Example classMethod:(multipleArg:(:int)a complexSelector:(:int)b)
402                                 resultType:(:id)
403                                       body:
404                          (ns-log @\"Example %d %d\" a b)
405                          [[NSNumber alloc]initWithInteger:(+ a b)]]")
406            '(oclo:define-objc-class-method ((:id :multiple-arg (:int a) :complex-selector (:int b)) example)
407              (ns-log (@ "Example %d %d") a b)
408              (oclo:send (oclo:send ns:ns-number 'alloc) :init-with-integer (+ a b)))))))
409
410
411 (define-test test/read-objcl-instance-method-definition ()
412   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
413    (flet ((read-objc (source)
414             (let ((*readtable* *objective-cl-readtable*))
415               (read-from-string source))))
416      (declare (inline read-objc))
417      (test equal-modulo-constant-strings
418            (read-objc "@[Example method:(multipleArg:(:int)a complexSelector:(:int)b)
419                            resultType:(:id)
420                                  body:
421                          (ns-log @\"Example %d %d\" a b)
422                          [[NSNumber alloc]initWithInteger:(+ a b)]]")
423            '(oclo:define-objc-method ((:id :multiple-arg (:int a) :complex-selector (:int b)) example)
424              (ns-log (@ "Example %d %d") a b)
425              (oclo:send (oclo:send ns:ns-number 'alloc) :init-with-integer (+ a b))))
426      )))
427
428
429 (define-test test/all ()
430   (test/read-identifier)
431   (test/read-type-specifier)
432   (test/read-method-signature)
433   (test/read-final-arguments)
434   (test/read-message)
435   (test/read-message-send)
436   (test/message-send)
437   (test/read-objcl-class-definition)
438   (test/read-objcl-class-method-definition)
439   (test/read-objcl-instance-method-definition)
440   (test/read-objcl-message-send))
441
442
443 (test/all)
444
445
446
447 #-(and)
448 (progn
449   
450  '(progn
451    [w alphavalue]
452    [w setalphavalue:0.5]
453    [v mouse:p inrect:r]
454    [[w getframe] mouse:p inrect:r]
455    [nsstring stringwithinteger: (* 42 ten)]
456    [nsstring stringwithformat:@"%f %i %f" (double-float)2 (int)3 (double-float)4]
457    [[nsnumber alloc] initwithint:42]
458    (let ((controller [nswindowcontroller alloc]))
459      [controller initwithwindownibname:@"DataWindow" owner:controller])
460    [self dosomething]
461    [super dosomething])
462
463  (progn
464    (objc:send w 'alpha-value)
465    (objc:send w :set-alpha-value 0.5)
466    (objc:send v :mouse p :in-rect r)
467    (objc:send (objc:send w 'get-frame) :mouse p :in-rect r)
468    (objc:send ns:ns-string :string-with-integer (* 42 ten))
469    (objc:send ns:ns-string :string-with-format (ccl:@ "%f %i %f") (:double-float 2 :int 3 :double-float 4))
470    (objc:send (objc:send ns:ns-number 'alloc) :init-with-int 42)
471    (let ((controller (objc:send ns:ns-window-controller 'alloc)))
472      (objc:send controller :init-with-window-nib-name (ccl:@ "DataWindow") :owner controller))
473    (objc:send self 'do-something)
474    (objc:send-super self 'do-something)))
475
476
477 ;;;; THE END ;;;;