diff options
| -rw-r--r-- | Lisp/defpackage.lisp | 6 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 20 | ||||
| -rw-r--r-- | Lisp/utilities.lisp | 82 | ||||
| -rw-r--r-- | objective-cl-tests.asd | 9 | ||||
| -rw-r--r-- | objective-cl.asd | 51 |
5 files changed, 136 insertions, 32 deletions
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index c3fcc2e..6fd992a 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -1,6 +1,8 @@ (defpackage #:mulk.objective-cl (:nicknames #:objcl #:objective-cl #:mulk.objcl) (:use #:cl #:cffi #:split-sequence) + (:shadow #:equal + #:equalp) ;; Functions (:export #:initialise-runtime @@ -11,6 +13,10 @@ #:find-objc-class #:find-selector + ;; Generic functions + #:equal + #:equalp + ;; Special variables #:*trace-method-calls* diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp new file mode 100644 index 0000000..7c2b496 --- /dev/null +++ b/Lisp/tests.lisp @@ -0,0 +1,20 @@ +(defpackage #:mulk.objective-cl.tests + (:use #:cl #:lift #:mulk.objective-cl)) +(in-package #:mulk.objective-cl.tests) + + +(defun run-all-tests () + (run-tests :suite 'objective-cl)) + + +(deftestsuite objective-cl () + ()) + + +(deftestsuite method-invocation (objective-cl) + () + (:equality-test #'equal) + (:tests + ((ensure (functionp (fn #'+ _ 10)))) + ((ensure-same (mapcar (fn (cons _ _)) '(1 2 3)) + '((1 . 1) (2 . 2) (3 . 3)))))) diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp index f35a4d8..a82e123 100644 --- a/Lisp/utilities.lisp +++ b/Lisp/utilities.lisp @@ -1,10 +1,78 @@ (in-package #:mulk.objective-cl) -(defun apply-macro (macro-name arg &rest args) - "Because FOREIGN-FUNCALL is a macro. Why, oh why is this?" - (funcall - (compile nil - `(lambda () - (,macro-name ,@(butlast (cons arg args)) - ,@(car (last (cons arg args))))))))
\ No newline at end of file +(defgeneric equal (x y)) +(defgeneric equalp (x y)) + + +(defun truep (b) + (not (or (zerop b) + (null b)))) + + +(defun id-equal (x y) + (declare (type (or id objc-class exception) x y)) + (truep (invoke x :is-equal y))) + + +(defmethod equal (x y) + (cl:equal x y)) + +(defmethod equal ((x id) y) + (id-equal x y)) + +(defmethod equal (x (y id)) + (id-equal x y)) + +(defmethod equal ((x objc-class) y) + (id-equal x y)) + +(defmethod equal (x (y objc-class)) + (id-equal x y)) + +(defmethod equal ((x exception) y) + (id-equal x y)) + +(defmethod equal (x (y exception)) + (id-equal x y)) + +(defmethod equal ((x selector) (y selector)) + (equal (selector-name x) (selector-name y))) + +(defmethod equal ((x selector) (y string)) + (equal (selector-name x) y)) + +(defmethod equal ((x string) (y selector)) + (equal x (selector-name y))) + + +(defmethod equalp (x y) + (cl:equalp x y)) + +(defmethod equalp ((x id) y) + (equal x y)) + +(defmethod equalp (x (y id)) + (equal x y)) + +(defmethod equalp ((x objc-class) y) + (equal x y)) + +(defmethod equalp (x (y objc-class)) + (equal x y)) + +(defmethod equalp ((x exception) y) + (equal x y)) + +(defmethod equalp (x (y exception)) + (equal x y)) + +;; FIXME: Does this even make sense? +(defmethod equalp ((x selector) (y selector)) + (equalp (selector-name x) (selector-name y))) + +(defmethod equalp ((x selector) (y string)) + (equalp (selector-name x) y)) + +(defmethod equalp ((x string) (y selector)) + (equalp x (selector-name y))) diff --git a/objective-cl-tests.asd b/objective-cl-tests.asd new file mode 100644 index 0000000..62bf3a0 --- /dev/null +++ b/objective-cl-tests.asd @@ -0,0 +1,9 @@ +(defsystem "objective-cl-tests" + :description "Unit tests for Objective CL." + :version "0.0.1" + :author "Matthias Benkard <matthias@benkard.de>" + :licence "GNU General Public License, version 3 or higher" + :depends-on (#:objective-cl #:lift) + :components + ((:module "Lisp" + :components ((:file "tests"))))) diff --git a/objective-cl.asd b/objective-cl.asd index 080f9ba..61354bf 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -7,29 +7,30 @@ :components ((:module "Lisp" :components ((:file "defpackage") - (:file "constant-data" :depends-on ("defpackage")) - (:file "data-types" :depends-on ("defpackage")) - (:file "parameters" :depends-on ("defpackage")) - (:file "name-conversion" :depends-on ("defpackage")) - (:file "type-conversion" :depends-on ("defpackage" - "data-types")) - (:file "libobjcl" :depends-on ("defpackage" - "data-types" - "name-conversion" - "type-conversion")) - (:file "utilities" :depends-on ("defpackage")) - (:file "weak-hash-tables" :depends-on ("defpackage")) - (:file "memory-management" :depends-on ("defpackage" - "weak-hash-tables" - "data-types" - "method-invocation" - "parameters")) - (:file "method-invocation" :depends-on ("defpackage" - "name-conversion" - "type-conversion" - "libobjcl" - "utilities" - "parameters")) - (:file "reader-syntax" :depends-on ("defpackage" - "method-invocation"))))) + (:file "constant-data" :depends-on ("defpackage")) + (:file "data-types" :depends-on ("defpackage")) + (:file "parameters" :depends-on ("defpackage")) + (:file "name-conversion" :depends-on ("defpackage")) + (:file "type-conversion" :depends-on ("defpackage" + "data-types")) + (:file "libobjcl" :depends-on ("defpackage" + "data-types" + "name-conversion" + "type-conversion")) + (:file "utilities" :depends-on ("defpackage")) + (:file "internal-utilities" :depends-on ("defpackage")) + (:file "weak-hash-tables" :depends-on ("defpackage")) + (:file "memory-management" :depends-on ("defpackage" + "weak-hash-tables" + "data-types" + "method-invocation" + "parameters")) + (:file "method-invocation" :depends-on ("defpackage" + "name-conversion" + "type-conversion" + "libobjcl" + "internal-utilities" + "parameters")) + (:file "reader-syntax" :depends-on ("defpackage" + "method-invocation"))))) :serial t) |