lispdoc: implemented the whole URI syntax; updated URIs in all docstrings to be writt...
[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)) (locally ,@body))))
47
48
49 (define-test test/read-identifier ()
50   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
51    (test string=
52          (with-string-check (*objc-readtable*
53                              stream "hello42World:")
54            (read-identifier stream))
55          "hello42World")))
56
57
58 (define-test test/read-type-specifier ()
59   "
60     type-specifier :='(' type-identifier ')' .
61 "
62   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
63    (test equal
64          (with-string-check (*objc-readtable*
65                              stream "(int)arg")
66            (read-type-specifier stream))
67          :int)))
68
69
70 (define-test test/read-method-signature ()
71   "
72     signature          := simple-signature | compound-signature final-signature .
73
74     simple-signature   := objcl-identifier .
75     compound-signature := [objcl-identifier] ':' '(' type-identifier ')' objcl-identifier compound-signature
76                         | [objcl-identifier] ':' '(' type-identifier ')' objcl-identifier .
77 "
78   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
79    (test equal
80          (with-string-check (*objc-readtable*
81                              stream "simpleSelector)")
82            (read-method-signature stream))
83          '("simpleSelector" nil nil))
84    (test equal
85          (with-string-check (*objc-readtable*
86                              stream "singleArgComplexSelector:(int)arg)")
87            (read-method-signature stream))
88          '("singleArgComplexSelector:" ((:int arg)) nil))
89    (test equal
90          (with-string-check (*objc-readtable*
91                              stream "multipleArg:(int)arg1 complexSelector:(int)arg2)")
92            (read-method-signature stream))
93          '("multipleArg:complexSelector:" ((:int arg1) (:int arg2)) nil))
94    (test equal
95          (with-string-check (*objc-readtable*
96                              stream "multipleArgWithEmptyPart:(int)arg1 :(int)arg2)")
97            (read-method-signature stream))
98          '("multipleArgWithEmptyPart::" ((:int arg1) (:int arg2)) nil))
99
100    (test equal
101          (with-string-check (*objc-readtable*
102                              stream "singleArgComplexSelector:(int)arg &rest others)")
103            (read-method-signature stream))
104          '("singleArgComplexSelector:" ((:int arg)) others))
105    (test equal
106          (with-string-check (*objc-readtable*
107                              stream "multipleArg:(int)arg1 complexSelector:(int)arg2  &rest others)")
108            (read-method-signature stream))
109          '("multipleArg:complexSelector:" ((:int arg1) (:int arg2)) others))
110    (test equal
111          (with-string-check (*objc-readtable*
112                              stream "multipleArgWithEmptyPart:(int)arg1 :(int)arg2  &rest others)")
113            (read-method-signature stream))
114          '("multipleArgWithEmptyPart::" ((:int arg1) (:int arg2)) others))))
115
116
117
118 (define-test test/read-final-arguments ()
119   "
120     final-arguments    := | '(' type-identifier ')' objcl-expression  final-arguments .
121     type-identifier    := symbol .
122 "
123   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
124    (test equal
125          (with-string-check (*objc-readtable*
126                              stream "]")
127            (read-final-arguments stream))
128          '())
129    (test equal
130          (with-string-check (*objc-readtable*
131                              stream "(integer)(+ one 2)]")
132            (read-final-arguments stream))
133          '((:integer (+ one 2))))
134    (test equal
135          (with-string-check (*objc-readtable*
136                              stream "(integer)(+ 1 2) (float)(+ 1.0 2.0)]")
137            (read-final-arguments stream))
138          '((:integer (+ 1 2)) (:float (+ 1.0 2.0))))
139    (test eql
140          (handler-case
141              (progn
142                (with-string-check (*objc-readtable*
143                                    stream "(integer)(+ 1 2) (float)]")
144                  (read-final-arguments stream))
145                nil)
146            (error () :success))
147          :success)))
148
149
150
151 (define-test test/read-message ()
152   "
153     message            := simple-selector | compound-selector final-arguments .
154
155     simple-selector    := objcl-identifier .
156     compound-selector  := [objcl-identifier] ':' objcl-expression compound-selector
157                         | [objcl-identifier] ':' objcl-expression .
158 "
159   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
160    (test equal
161          (with-string-check (*objc-readtable*
162                              stream "simpleSelector]")
163            (read-message stream))
164          '("simpleSelector" nil nil))
165    (test equal
166          (with-string-check (*objc-readtable*
167                              stream "singleArgComplexSelector:42]")
168            (read-message stream))
169          '("singleArgComplexSelector:" (42) nil))
170    (test equal
171          (with-string-check (*objc-readtable*
172                              stream "multipleArg:42 complexSelector:24]")
173            (read-message stream))
174          '("multipleArg:complexSelector:" (42 24) nil))
175    (test equal
176          (with-string-check (*objc-readtable*
177                              stream "multipleArg:(+ 4 2) complexSelector:(* 2 4)]")
178            (read-message stream))
179          '("multipleArg:complexSelector:" ((+ 4 2) (* 2 4)) nil))
180    (test equal
181          (with-string-check (*objc-readtable*
182                              stream "multipleArg:[self one] complexSelector:[self two]]")
183            (read-message stream))
184          `("multipleArg:complexSelector:"
185            (,(generate-message-send 'self '"one" 'nil 'nil)
186              ,(generate-message-send 'self '"two" 'nil 'nil))
187            nil))
188    (test equal
189          (with-string-check (*objc-readtable*
190                              stream "multipleArgWithEmptyPart:42 :24]")
191            (read-message stream))
192          '("multipleArgWithEmptyPart::" (42 24) nil))
193    (test equal
194          (with-string-check (*objc-readtable*
195                              stream "singleArgComplexSelectorWithFinalArgs:42
196                                                     (int)1]")
197            (read-message stream))
198          '("singleArgComplexSelectorWithFinalArgs:" (42) ((:int 1))))
199    (test equal
200          (with-string-check (*objc-readtable*
201                              stream "multipleArg:42
202                                complexSelectorWithFinalArgs:24
203                                              (int)1 (float)2.0]")
204            (read-message stream))
205          '("multipleArg:complexSelectorWithFinalArgs:" (42 24) ((:int 1) (:float 2.0))))))
206
207
208 (define-test test/read-message-send ()
209   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
210     (test equal
211           (with-string-check (*objc-readtable*
212                               stream "simpleSelector]")
213             (read-message-send stream 'self (function read-message)))
214           '(self "simpleSelector" nil nil))
215     (test equal
216           (with-string-check (*objc-readtable*
217                               stream "singleArgComplexSelector:42]")
218             (read-message-send stream 'self (function read-message)))
219           '(self "singleArgComplexSelector:" (42) nil))
220     (test equal
221           (with-string-check (*objc-readtable*
222                               stream "multipleArg:42 complexSelector:24]")
223             (read-message-send stream 'self (function read-message)))
224           '(self "multipleArg:complexSelector:" (42 24) nil))
225     (test equal
226           (with-string-check (*objc-readtable*
227                               stream "multipleArg:(+ 4 2) complexSelector:(* 2 4)]")
228             (read-message-send stream 'self (function read-message)))
229           '(self "multipleArg:complexSelector:" ((+ 4 2) (* 2 4)) nil))
230     (test equal
231           (with-string-check (*objc-readtable*
232                               stream "multipleArg:[self one] complexSelector:[self two]]")
233             (read-message-send stream 'self (function read-message)))
234           `(self "multipleArg:complexSelector:"
235                  (,(generate-message-send 'self '"one" 'nil 'nil)
236                    ,(generate-message-send 'self '"two" 'nil 'nil))
237                  nil))
238     (test equal
239           (with-string-check (*objc-readtable*
240                               stream "multipleArgWithEmptyPart:42 :24]")
241             (read-message-send stream 'self (function read-message)))
242           '(self "multipleArgWithEmptyPart::" (42 24) nil))
243     (test equal
244           (with-string-check (*objc-readtable*
245                               stream "singleArgComplexSelectorWithFinalArgs:42
246                                                     (int)1]")
247             (read-message-send stream 'self (function read-message)))
248           '(self "singleArgComplexSelectorWithFinalArgs:" (42) ((:int 1))))
249     (test equal
250           (with-string-check (*objc-readtable*
251                               stream "multipleArg:42
252                                complexSelectorWithFinalArgs:24
253                                              (int)1 (float)2.0]")
254             (read-message-send stream 'self (function read-message)))
255           '(self "multipleArg:complexSelectorWithFinalArgs:" (42 24) ((:int 1) (:float 2.0))))))
256
257
258 (define-test test/message-send ()
259   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))                  
260    (flet ((gen (args) (apply (function generate-message-send) args)))
261      (declare (inline gen))
262      (test equal
263            (gen '(self "simpleSelector" nil nil))
264            '(oclo:send self 'simple-selector))
265      (test equal
266            (gen '(self "singleArgComplexSelector:" (42) nil))
267            '(oclo:send self :single-arg-complex-selector 42))
268      (test equal
269            (gen '(self "multipleArg:complexSelector:" (42 24) nil))
270            '(oclo:send self :multiple-arg 42 :complex-selector 24))
271      (test equal
272            (gen '(self "multipleArg:complexSelector:" ((+ 4 2) (* 2 4)) nil))
273            '(oclo:send self :multiple-arg (+ 4 2) :complex-selector (* 2 4)))
274      (test equal
275            (gen `(self "multipleArg:complexSelector:"
276                        (,(generate-message-send 'self '"one" 'nil 'nil)
277                          ,(generate-message-send 'self '"two" 'nil 'nil))
278                        nil))
279            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
280      (test equal
281            (gen '(self "multipleArgWithEmptyPart::" (42 24) nil))
282            '(oclo:send self :multiple-arg-with-empty-part 42 :|| 24))
283      (test equal
284            (gen '(self "singleArgComplexSelectorWithFinalArgs:" (42) ((:int 1))))
285            '(oclo:send self :single-arg-complex-selector-with-final-args 42 (:int 1)))
286      (test equal
287            (gen '(self "multipleArg:complexSelectorWithFinalArgs:" (42 24) ((:int 1) (:float 2.0))))
288            '(oclo:send self :multiple-arg 42 :complex-selector-with-final-args 24 (:int 1 :float 2.0))))))
289
290
291 (define-test test/read-objcl-message-send ()
292   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
293    (flet ((read-objc (source)
294             (let ((*readtable* *objective-cl-readtable*))
295               (read-from-string source))))
296      (declare (inline read-objc))
297      (test equal
298            (read-objc "[self simpleSelector]")
299            '(oclo:send self 'simple-selector))
300      (test equal
301            (read-objc "[[NSData alloc] init]")
302            '(oclo:send (oclo:send ns:ns-data 'alloc) 'init))
303      (test equal
304            (read-objc "[[my-obj doSomething] doSomethingElse]")
305            '(oclo:send (oclo:send my-obj 'do-something) 'do-something-else))
306      (test equal
307            (read-objc "[self singleArgComplexSelector:42]")
308            '(oclo:send self :single-arg-complex-selector 42))
309      (test equal
310            (read-objc "[self singleArgComplexSelector:(+ 4 2)]")
311            '(oclo:send self :single-arg-complex-selector (+ 4 2)))
312      (test equal
313            (read-objc "[self singleArgComplexSelector:(+ 4 XYZ)]")
314            '(oclo:send self :single-arg-complex-selector (+ 4 xyz)))
315      (test equal
316            (read-objc "[self singleArgComplexSelector:abc]")
317            '(oclo:send self :single-arg-complex-selector abc))
318      (test equal
319            (read-objc "[self multipleArg:42 complexSelector:24]")
320            '(oclo:send self :multiple-arg 42 :complex-selector 24))
321      (test equal
322            (read-objc "[self multipleArg: (+ 4 2) complexSelector: (* 2 4) ]")
323            '(oclo:send self :multiple-arg (+ 4 2) :complex-selector (* 2 4)))
324      (test equal
325            (read-objc "[self multipleArg:[self one]complexSelector:[self two]]")
326            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
327      (test equal
328            (read-objc "[self multipleArg:[self one]
329              complexSelector:[self two]]")
330            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
331      (test equal
332            (read-objc "[self multipleArg: [self one]
333              complexSelector: [self two]  ]")
334            '(oclo:send self :multiple-arg (oclo:send self 'one) :complex-selector (oclo:send self 'two)))
335      (test equal
336            (read-objc "[self multipleArgWithEmptyPart:42 :24]")
337            '(oclo:send self :multiple-arg-with-empty-part 42 :|| 24))
338      (test equal
339            (read-objc "[self multipleArgWithEmptyPart:42 : 24 ]")
340            '(oclo:send self :multiple-arg-with-empty-part 42 :|| 24))
341      (test equal
342            (read-objc "[self multipleArgWithEmptyPart:ABC :DEF]")
343            '(oclo:send self :multiple-arg-with-empty-part abc :|| def))
344      (test equal
345            (read-objc "[self singleArgComplexSelectorWithFinalArgs:42 (:int)1]")
346            '(oclo:send self :single-arg-complex-selector-with-final-args 42 (:int 1)))
347      (test equal
348            (read-objc "[self singleArgComplexSelectorWithFinalArgs:42(:int)  1 ]")
349            '(oclo:send self :single-arg-complex-selector-with-final-args 42 (:int 1)))
350      (test equal
351            (read-objc "[self multipleArg:42 complexSelectorWithFinalArgs:24 (:int)1 (:float)2.0]")
352            '(oclo:send self
353              :multiple-arg 42
354              :complex-selector-with-final-args 24
355              (:int 1 :float 2.0)))
356      (test equal
357            (read-objc "(progn [self simpleSelector]
358                              [self multipleArg:42 complexSelector:24])")
359            '(progn
360              (oclo:send self 'simple-selector)
361              (oclo:send self :multiple-arg 42 :complex-selector 24))))))
362
363 (define-test test/read-objcl-class-definition ()
364   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
365    (flet ((read-objc (source)
366             (let ((*readtable* *objective-cl-readtable*))
367               (read-from-string source))))
368      (declare (inline read-objc))
369      (test equal
370            (read-objc "@[NSObject subClass:Example slots:(
371                          one
372                          two
373                          three)]")
374            '(defclass example (ns:ns-object)
375              (one
376               two
377               three)
378              (:metaclass ns:+ns-object))))))
379
380
381
382 (defun equal-modulo-constant-strings (a b)
383   (cond
384     ((typep a 'ns:ns-string)
385      (and (consp b) (eql '@ (car b))))
386     ((and (consp a) (consp b))
387      (and (equal-modulo-constant-strings (car a) (car b))
388           (equal-modulo-constant-strings (cdr a) (cdr b))))
389     (t
390      (equal a b))))
391
392 (define-test test/read-objcl-class-method-definition ()
393   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
394     (flet ((read-objc (source)
395             (let ((*readtable* *objective-cl-readtable*))
396               (read-from-string source))))
397      (declare (inline read-objc))
398      (test equal-modulo-constant-strings
399            (read-objc "@[Example classMethod:(multipleArg:(:int)a complexSelector:(:int)b)
400                                 resultType:(:id)
401                                       body:
402                          (ns-log @\"Example %d %d\" a b)
403                          [[NSNumber alloc]initWithInteger:(+ a b)]]")
404            '(oclo:define-objc-class-method ((:id :multiple-arg (:int a) :complex-selector (:int b)) example)
405              (ns-log (@ "Example %d %d") a b)
406              (oclo:send (oclo:send ns:ns-number 'alloc) :init-with-integer (+ a b)))))))
407
408
409 (define-test test/read-objcl-instance-method-definition ()
410   (let ((*package* (find-package "COM.INFORMATIMAGO.OBJECTIVE-CL")))
411    (flet ((read-objc (source)
412             (let ((*readtable* *objective-cl-readtable*))
413               (read-from-string source))))
414      (declare (inline read-objc))
415      (test equal-modulo-constant-strings
416            (read-objc "@[Example method:(multipleArg:(:int)a complexSelector:(:int)b)
417                            resultType:(:id)
418                                  body:
419                          (ns-log @\"Example %d %d\" a b)
420                          [[NSNumber alloc]initWithInteger:(+ a b)]]")
421            '(oclo:define-objc-method ((:id :multiple-arg (:int a) :complex-selector (:int b)) example)
422              (ns-log (@ "Example %d %d") a b)
423              (oclo:send (oclo:send ns:ns-number 'alloc) :init-with-integer (+ a b))))
424      )))
425
426
427 (define-test test/all ()
428   (test/read-identifier)
429   (test/read-type-specifier)
430   (test/read-method-signature)
431   (test/read-final-arguments)
432   (test/read-message)
433   (test/read-message-send)
434   (test/message-send)
435   (test/read-objcl-class-definition)
436   (test/read-objcl-class-method-definition)
437   (test/read-objcl-instance-method-definition)
438   (test/read-objcl-message-send))
439
440
441 (test/all)
442
443
444
445 #-(and)
446 (progn
447   
448  '(progn
449    [w alphavalue]
450    [w setalphavalue:0.5]
451    [v mouse:p inrect:r]
452    [[w getframe] mouse:p inrect:r]
453    [nsstring stringwithinteger: (* 42 ten)]
454    [nsstring stringwithformat:@"%f %i %f" (double-float)2 (int)3 (double-float)4]
455    [[nsnumber alloc] initwithint:42]
456    (let ((controller [nswindowcontroller alloc]))
457      [controller initwithwindownibname:@"DataWindow" owner:controller])
458    [self dosomething]
459    [super dosomething])
460
461  (progn
462    (objc:send w 'alpha-value)
463    (objc:send w :set-alpha-value 0.5)
464    (objc:send v :mouse p :in-rect r)
465    (objc:send (objc:send w 'get-frame) :mouse p :in-rect r)
466    (objc:send ns:ns-string :string-with-integer (* 42 ten))
467    (objc:send ns:ns-string :string-with-format (ccl:@ "%f %i %f") (:double-float 2 :int 3 :double-float 4))
468    (objc:send (objc:send ns:ns-number 'alloc) :init-with-int 42)
469    (let ((controller (objc:send ns:ns-window-controller 'alloc)))
470      (objc:send controller :init-with-window-nib-name (ccl:@ "DataWindow") :owner controller))
471    (objc:send self 'do-something)
472    (objc:send-super self 'do-something)))
473
474
475 ;;;; THE END ;;;;