diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-20 12:32:06 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-20 12:32:06 +0100 |
| commit | 52955a05962f3066c8a4c4bf83a6fcd87f718be4 (patch) | |
| tree | 6d47a170ec10b8e1d31700c172cc3da67e26318a | |
| parent | a28a7dbb793b69dc8a174bc124d16fc3532c388f (diff) | |
Make PARSE-TYPESPEC aware of typespec suffix strings.
darcs-hash:96d2fe4eab2e4db49c60491c3e109bdab2600086
| -rw-r--r-- | Lisp/tests.lisp | 14 | ||||
| -rw-r--r-- | Lisp/type-handling.lisp | 25 |
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) |