summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-12 17:19:16 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-12 17:19:16 +0100
commit417548a08fd1358cfdbe4d7ce95b0d0220fdfd38 (patch)
treebf91b469da48598845b84fbfe3e59535efd245fc /Lisp
parent17842ec58421437f62b10c1e48024c9676de3726 (diff)
Typespec handling: Change the way unrecognised tokens and NeXT bit fields are dealt with.
darcs-hash:df914eb9a30b938c49e0b42091aff0299bc50002
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/tests.lisp16
-rw-r--r--Lisp/type-handling.lisp89
2 files changed, 53 insertions, 52 deletions
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 0e56866..1a63d9d 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -162,11 +162,11 @@
(:int ())
(:int ()))
'(struct () "?"
- (bit-field (const) nil 123 nil)
+ (bit-field (const) nil 123)
(complex (const) (:float ()))
- (:unrecognised ((:type-specifier #\4)))
- (:unrecognised ((:type-specifier #\5)))
- (:unrecognised ((:type-specifier #\6)))
+ (:unrecognised () #\4)
+ (:unrecognised () #\5)
+ (:unrecognised () #\6)
(:int ())
(:int ())
(:int ())))))
@@ -249,11 +249,11 @@
(:int ())
(:int ()))
'(struct () "?"
- (bit-field (const) nil 123 nil)
+ (bit-field (const) nil 123)
(complex (const) (:float ()))
- (:unrecognised ((:type-specifier #\4)))
- (:unrecognised ((:type-specifier #\5)))
- (:unrecognised ((:type-specifier #\6)))
+ (:unrecognised () #\4)
+ (:unrecognised () #\5)
+ (:unrecognised () #\6)
(:int ())
(:int ())
(:int ()))))
diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp
index e4d15e1..601afab 100644
--- a/Lisp/type-handling.lisp
+++ b/Lisp/type-handling.lisp
@@ -167,51 +167,51 @@ Returns: (VALUES typespec byte-position string-position)"
:start (1+ string-position)
:junk-allowed t)
(setq string-position new-string-pos)
- bit-field-length)
- nil)))
+ bit-field-length))))
(otherwise
- (prog1 (list (case init-char
- (#\B :boolean) ;XXX :int?
- (#\c (if (and (eq +runtime-type+ :next)
- (or return-type-p
- (featurep 'cffi-features:ppc32)))
- :int
- :char))
- (#\C (if (and (eq +runtime-type+ :next)
- (or return-type-p
- (featurep 'cffi-features:ppc32)))
- :unsigned-int
- :unsigned-char))
- (#\s (if (and (eq +runtime-type+ :next)
- (or return-type-p
- (featurep 'cffi-features:ppc32)))
- :int
- :short))
- (#\S (if (and (eq +runtime-type+ :next)
- (or return-type-p
- (featurep 'cffi-features:ppc32)))
- :unsigned-int
- :unsigned-short))
- (#\i :int)
- (#\I :unsigned-int)
- (#\l :long)
- (#\L :unsigned-long)
- (#\q :long-long)
- (#\Q :unsigned-long-long)
- (#\f :float)
- (#\d :double)
- (#\v :void)
- (#\@ 'id)
- (#\# 'objective-c-class)
- (#\: 'selector)
- (#\* :string)
- (#\? :unknown)
- (otherwise
- (prog1 :unrecognised
- (push (list :type-specifier init-char)
- qualifiers))))
- qualifiers)
- (incf string-position))))
+ (let ((children (list)))
+ (prog1 (list* (case init-char
+ (#\B :boolean) ;XXX :int?
+ (#\c (if (and (eq +runtime-type+ :next)
+ (or return-type-p
+ (featurep 'cffi-features:ppc32)))
+ :int
+ :char))
+ (#\C (if (and (eq +runtime-type+ :next)
+ (or return-type-p
+ (featurep 'cffi-features:ppc32)))
+ :unsigned-int
+ :unsigned-char))
+ (#\s (if (and (eq +runtime-type+ :next)
+ (or return-type-p
+ (featurep 'cffi-features:ppc32)))
+ :int
+ :short))
+ (#\S (if (and (eq +runtime-type+ :next)
+ (or return-type-p
+ (featurep 'cffi-features:ppc32)))
+ :unsigned-int
+ :unsigned-short))
+ (#\i :int)
+ (#\I :unsigned-int)
+ (#\l :long)
+ (#\L :unsigned-long)
+ (#\q :long-long)
+ (#\Q :unsigned-long-long)
+ (#\f :float)
+ (#\d :double)
+ (#\v :void)
+ (#\@ 'id)
+ (#\# 'objective-c-class)
+ (#\: 'selector)
+ (#\* :string)
+ (#\? :unknown)
+ (otherwise
+ (prog1 :unrecognised
+ (push init-char children))))
+ qualifiers
+ children)
+ (incf string-position)))))
#+(or) ; too greedy (=> bit-fields can't see their length!)
(multiple-value-bind (byte-position new-string-pos)
(parse-integer typestring
@@ -270,6 +270,7 @@ Returns: (VALUES typespec byte-position string-position)"
(dolist (child children)
(print-typespec child stream))
(format stream "]")))
+ ((:unrecognised) (format stream "~{~A~}" rest))
(t (format stream "~A" (typespec-name->type-id type-name))
(dolist (child rest)
(print-typespec child stream))))))