summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-08-07 17:05:22 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-08-07 17:05:22 +0200
commit89c02a59d6f2696a5ae1ebc77298fc8137506415 (patch)
treed6cc1cc612bd105ac11c3829c35daedb48f26dff
parent414d2bf6f6f75db5ec3babb164d8ed7d46d65080 (diff)
Overload EQUAL and EQUALP for Objective C objects.
darcs-hash:6548e8584e8dd49cb17f6055c0cedd6927cba7f1
-rw-r--r--Lisp/defpackage.lisp6
-rw-r--r--Lisp/tests.lisp20
-rw-r--r--Lisp/utilities.lisp82
-rw-r--r--objective-cl-tests.asd9
-rw-r--r--objective-cl.asd51
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)