summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-20 12:32:06 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-20 12:32:06 +0100
commit52955a05962f3066c8a4c4bf83a6fcd87f718be4 (patch)
tree6d47a170ec10b8e1d31700c172cc3da67e26318a
parenta28a7dbb793b69dc8a174bc124d16fc3532c388f (diff)
Make PARSE-TYPESPEC aware of typespec suffix strings.
darcs-hash:96d2fe4eab2e4db49c60491c3e109bdab2600086
-rw-r--r--Lisp/tests.lisp14
-rw-r--r--Lisp/type-handling.lisp25
2 files changed, 25 insertions, 14 deletions
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index d2d89c9..0bdd750 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -218,7 +218,19 @@
(is (equal (parse-typespec "^^{OpaqueStruct}")
'(pointer ()
(pointer ()
- (struct (opaque) "OpaqueStruct"))))))
+ (struct (opaque) "OpaqueStruct")))))
+ (is (equal (parse-typespec "^{_GSKeyBinding=ii@\"GSKeyBindingAction\"@\"GSKeyBindingTable\"}")
+ '(pointer ()
+ (struct () "_GSKeyBinding"
+ (:int ())
+ (:int ())
+ (id ((:type "GSKeyBindingAction")))
+ (id ((:type "GSKeyBindingTable")))))))
+ (is (equal (parse-typespec "{?=\"next\"@\"GCObject\"\"previous\"@\"GCObject\"\"flags\"{?=}}")
+ '(struct () "?"
+ (id ((:type "GCObject") (:name "next")))
+ (id ((:type "GCObject") (:name "previous")))
+ (struct ((:name "flags")) "?")))))
(deftest printing-typespecs ()
diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp
index 1a299b6..45aaf22 100644
--- a/Lisp/type-handling.lisp
+++ b/Lisp/type-handling.lisp
@@ -42,10 +42,10 @@ Returns: (VALUES typespec byte-position string-position)"
(#\O 'bycopy)
(#\V 'oneway)
(#\R 'byref)
- (#\" 'name))))
+ (#\" :name))))
(and qualifier
(incf string-position)
- (if (eq qualifier 'name)
+ (if (eq qualifier :name)
(let ((name-end (position #\"
typestring
:start string-position)))
@@ -57,7 +57,8 @@ Returns: (VALUES typespec byte-position string-position)"
(setf string-position (1+ name-end))
qualifier)
(push qualifier qualifiers)))))
- (values (case init-char
+ (let ((typespec
+ (case init-char
((#\{ #\()
(let* ((=-token (position #\= typestring :start start))
(closing-delim (position (ecase init-char
@@ -219,16 +220,14 @@ Returns: (VALUES typespec byte-position string-position)"
(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
- :start string-position
- :junk-allowed t)
- (setq string-position new-string-pos)
- byte-position)
- #-(or) nil
- string-position)))
+ (incf string-position)))))))
+ (when (and (> (length typestring) string-position)
+ (char= (char typestring string-position) #\"))
+ (let ((type-end (position #\" typestring :start (1+ string-position))))
+ (push (list :type (subseq typestring (1+ string-position) type-end))
+ (cadr typespec))
+ (setf string-position (1+ type-end))))
+ (values typespec nil string-position))))
(defun print-typespec-to-string (typespec)