From 800230afe4bab552fb4409432a27307ac1e9fabb Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Mon, 4 Feb 2008 21:58:45 +0100
Subject: Parse NeXT-style bit field typespecs properly.
darcs-hash:fb2c911e17afaa24da33c223619fad9fc33bb96b
---
Lisp/tests.lisp | 22 +++++++++++++-----
Lisp/type-handling.lisp | 59 +++++++++++++++++++++++++++++++------------------
2 files changed, 53 insertions(+), 28 deletions(-)
(limited to 'Lisp')
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index e362774..b031200 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -172,12 +172,22 @@
((ensure-same (parse-typespec "(?=)")
'(union () "?")))
((ensure-same (parse-typespec "{?=rb123rjf456iii}")
- '(struct () "?"
- (bit-field (const) 123 456
- (complex (const) (:float ())))
- (:int ())
- (:int ())
- (:int ()))))
+ (if (eq objcl::+runtime-type+ :gnu)
+ '(struct () "?"
+ (bit-field (const) 123 456
+ (complex (const) (:float ())))
+ (:int ())
+ (:int ())
+ (:int ()))
+ '(struct () "?"
+ (bit-field (const) nil 123 nil)
+ (complex (const) (:float ()))
+ (:unrecognised ((:type-specifier #\4)))
+ (:unrecognised ((:type-specifier #\5)))
+ (:unrecognised ((:type-specifier #\6)))
+ (:int ())
+ (:int ())
+ (:int ())))))
((ensure-same (parse-typespec "^[100{?=ii}]")
'(pointer ()
(array () 100
diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp
index 0d10560..58adc7e 100644
--- a/Lisp/type-handling.lisp
+++ b/Lisp/type-handling.lisp
@@ -137,27 +137,38 @@ Returns: (VALUES typespec byte-position string-position)"
(prog1 typespec
(setq string-position new-str-pos)))))
(#\b
- (let (bit-field-starting-pos
- bit-field-typespec
- bit-field-length
- byte-position)
- (multiple-value-setq (bit-field-starting-pos string-position)
- (parse-integer typestring
- :start (1+ string-position)
- :junk-allowed t))
- (multiple-value-setq (bit-field-typespec
- byte-position
- string-position)
- (parse-typespec typestring nil string-position))
- (multiple-value-setq (bit-field-length string-position)
- (parse-integer typestring
- :start string-position
- :junk-allowed t))
- (list 'bit-field
- qualifiers
- bit-field-starting-pos
- bit-field-length
- bit-field-typespec)))
+ (if (eq +runtime-type+ :gnu)
+ (let (bit-field-starting-pos
+ bit-field-typespec
+ bit-field-length
+ byte-position)
+ (multiple-value-setq (bit-field-starting-pos string-position)
+ (parse-integer typestring
+ :start (1+ string-position)
+ :junk-allowed t))
+ (multiple-value-setq (bit-field-typespec
+ byte-position
+ string-position)
+ (parse-typespec typestring nil string-position))
+ (multiple-value-setq (bit-field-length string-position)
+ (parse-integer typestring
+ :start string-position
+ :junk-allowed t))
+ (list 'bit-field
+ qualifiers
+ bit-field-starting-pos
+ bit-field-length
+ bit-field-typespec))
+ (list 'bit-field
+ qualifiers
+ nil
+ (multiple-value-bind (bit-field-length new-string-pos)
+ (parse-integer typestring
+ :start (1+ string-position)
+ :junk-allowed t)
+ (setq string-position new-string-pos)
+ bit-field-length)
+ nil)))
(otherwise
(prog1 (list (case init-char
(#\B :boolean) ;XXX :int?
@@ -194,7 +205,11 @@ Returns: (VALUES typespec byte-position string-position)"
(#\# 'objective-c-class)
(#\: 'selector)
(#\* :string)
- (#\? :unknown))
+ (#\? :unknown)
+ (otherwise
+ (prog1 :unrecognised
+ (push (list :type-specifier init-char)
+ qualifiers))))
qualifiers)
(incf string-position))))
#+(or) ; too greedy (=> bit-fields can't see their length!)
--
cgit v1.2.3