From 417548a08fd1358cfdbe4d7ce95b0d0220fdfd38 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Tue, 12 Feb 2008 17:19:16 +0100 Subject: Typespec handling: Change the way unrecognised tokens and NeXT bit fields are dealt with. darcs-hash:df914eb9a30b938c49e0b42091aff0299bc50002 --- Lisp/tests.lisp | 16 ++++----- Lisp/type-handling.lisp | 89 +++++++++++++++++++++++++------------------------ 2 files changed, 53 insertions(+), 52 deletions(-) (limited to 'Lisp') 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)))))) -- cgit v1.2.3