From 52955a05962f3066c8a4c4bf83a6fcd87f718be4 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Wed, 20 Feb 2008 12:32:06 +0100
Subject: Make PARSE-TYPESPEC aware of typespec suffix strings.

darcs-hash:96d2fe4eab2e4db49c60491c3e109bdab2600086
---
 Lisp/tests.lisp         | 14 +++++++++++++-
 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)
-- 
cgit v1.2.3