diff options
| -rw-r--r-- | Lisp/method-invocation.lisp | 10 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 11 | ||||
| -rw-r--r-- | Lisp/type-handling.lisp | 26 |
3 files changed, 35 insertions, 12 deletions
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 929162f..dd36dd3 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -415,7 +415,15 @@ easier to use with __apply__. objc-arg-ptrs))) (unless (cffi:null-pointer-p error-cell) (error (make-condition 'exception :pointer error-cell))) - (case (car return-type) + (case (let ((nominal-type (find-if #'(lambda (x) + (and (consp x) + (eq (car x) 'nominally))) + (cadr return-type)))) + ;; Do the modifiers include something like + ;; (NOMINALLY :UNSIGNED-CHAR)? + (if nominal-type + (cadr nominal-type) + (car return-type))) ((id objective-c-class exception selector) (let ((*skip-retaining* (or *skip-retaining* diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 1a63d9d..60e9387 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -23,7 +23,8 @@ #:struct #:union #:pointer #:oneway #:out #:in #:inout #:const #:parse-typespec #:objective-c-class #:bit-field #:opaque #:bycopy #:byref - #:primitive-invoke #:print-typespec-to-string)) + #:primitive-invoke #:print-typespec-to-string + #:nominally)) (in-package #:mulk.objective-cl.tests) (in-root-suite) @@ -194,8 +195,8 @@ (:char ()) (:unsigned-char ())) (struct () "?" - (:int ()) - (:unsigned-int ()))) + (:int ((nominally :char))) + (:unsigned-int ((nominally :unsigned-char))))) :test #'equalp))) (let ((funky-spec (parse-typespec "{?=sS}"))) (is (member funky-spec @@ -203,8 +204,8 @@ (:short ()) (:unsigned-short ())) (struct () "?" - (:int ()) - (:unsigned-int ()))) + (:int ((nominally :short))) + (:unsigned-int ((nominally :unsigned-short))))) :test #'equalp))) (is (equal (parse-typespec "{Mulk=*{Untermulk={Unteruntermulk=}}i}") '(struct () "Mulk" diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp index 601afab..b8ff2a2 100644 --- a/Lisp/type-handling.lisp +++ b/Lisp/type-handling.lisp @@ -175,22 +175,30 @@ Returns: (VALUES typespec byte-position string-position)" (#\c (if (and (eq +runtime-type+ :next) (or return-type-p (featurep 'cffi-features:ppc32))) - :int + (prog1 :int + (push '(nominally :char) + qualifiers)) :char)) (#\C (if (and (eq +runtime-type+ :next) (or return-type-p (featurep 'cffi-features:ppc32))) - :unsigned-int + (prog1 :unsigned-int + (push '(nominally :unsigned-char) + qualifiers)) :unsigned-char)) (#\s (if (and (eq +runtime-type+ :next) (or return-type-p (featurep 'cffi-features:ppc32))) - :int + (prog1 :int + (push '(nominally :short) + qualifiers)) :short)) (#\S (if (and (eq +runtime-type+ :next) (or return-type-p (featurep 'cffi-features:ppc32))) - :unsigned-int + (prog1 :unsigned-int + (push '(nominally :unsigned-short) + qualifiers)) :unsigned-short)) (#\i :int) (#\I :unsigned-int) @@ -233,7 +241,7 @@ Returns: (VALUES typespec byte-position string-position)" (destructuring-bind (type-name modifiers &rest rest) typespec (dolist (modifier modifiers) - (format stream "~A" (ecase modifier + (format stream "~A" (case modifier (const #\r) (in #\n) (inout #\N) @@ -241,7 +249,13 @@ Returns: (VALUES typespec byte-position string-position)" (bycopy #\O) (oneway #\V) (byref #\R) - (opaque "")))) + (opaque "") + (otherwise + (assert (listp modifier)) + (ecase (first modifier) + ((nominally) (setq type-name + (second modifier)))) + "")))) (case type-name ((struct union) (destructuring-bind (name . children) rest (format stream "~C~A" |