[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv18632

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (tokenize-symbol-thoroughly): Return NIL
instead of throwing an error.
(parse-symbol): Handle null result of tokenize-symbol-thoroughly.

This fixes a bug reported by Derrell Piper.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/31 22:41:03	1.1903
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/02 00:24:52	1.1904
@@ -1,3 +1,11 @@
+2009-11-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank.lisp (tokenize-symbol-thoroughly): Return NIL
+	instead of throwing an error.
+	(parse-symbol): Handle null result of tokenize-symbol-thoroughly.
+
+	This fixes a bug reported by Derrell Piper.
+
 2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-bug): Deleted.
--- /project/slime/cvsroot/slime/swank.lisp	2009/10/31 22:13:55	1.669
+++ /project/slime/cvsroot/slime/swank.lisp	2009/11/02 00:24:52	1.670
@@ -2014,7 +2014,7 @@
              (vector-push-extend char token))
             ((char= char #\:)
              (cond ((and package internp)
-                    (error "More than two colons in ~S" string))
+                    (return-from tokenize-symbol-thoroughly))
                    (package
                     (setq internp t))
                    (t
@@ -2024,9 +2024,8 @@
                                             :fill-pointer 0)))))
             (t
              (vector-push-extend (casify-char char) token))))
-    (when vertical
-      (error "Unclosed vertical bar in ~S" string))
-    (values token package (or (not package) internp))))
+    (unless vertical
+          (values token package (or (not package) internp)))))
 
 (defun untokenize-symbol (package-name internal-p symbol-name)
   "The inverse of TOKENIZE-SYMBOL.
@@ -2061,16 +2060,17 @@
 Return the symbol and a flag indicating whether the symbols was found."
   (multiple-value-bind (sname pname internalp)
       (tokenize-symbol-thoroughly string)
-    (let ((package (cond ((string= pname "") keyword-package)
-                         (pname              (find-package pname))
-                         (t                  package))))
-      (if package
-          (multiple-value-bind (symbol flag)
-              (if internalp
-                  (find-symbol sname package)
-                  (find-symbol-with-status sname ':external package))
-            (values symbol flag sname package))
-          (values nil nil nil nil)))))
+    (when sname
+     (let ((package (cond ((string= pname "") keyword-package)
+                          (pname              (find-package pname))
+                          (t                  package))))
+       (if package
+           (multiple-value-bind (symbol flag)
+               (if internalp
+                   (find-symbol sname package)
+                   (find-symbol-with-status sname ':external package))
+             (values symbol flag sname package))
+           (values nil nil nil nil))))))
 
 (defun parse-symbol-or-lose (string &optional (package *package*))
   (multiple-value-bind (symbol status) (parse-symbol string package)