[slime-cvs] CVS slime

trittweiler trittweiler at common-lisp.net
Sat Jul 26 23:05:59 UTC 2008


Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv16867

Modified Files:
	swank.lisp swank-sbcl.lisp swank-backend.lisp ChangeLog 
Log Message:

* swank.lisp (swank-compiler): Fix bug when invoking an abort
restart on a failed compilation attempt.

* swank-sbcl.lisp (swank-compile-string): If a compilation attempt
fails, COMPILE-FILE returns NIL which we tried to LOAD. Fix that.

* swank-backend.lisp (swank-compile-string, swank-compile-file):
Document return value.


--- /project/slime/cvsroot/slime/swank.lisp	2008/07/16 16:14:50	1.547
+++ /project/slime/cvsroot/slime/swank.lisp	2008/07/26 23:05:59	1.548
@@ -46,7 +46,7 @@
            #:buffer-first-change
            #:frame-source-location-for-emacs
            #:restart-frame
-           #:sldb-step
+           #:sldb-step 
            #:sldb-break
            #:sldb-break-on-return
            #:profiled-functions
@@ -1025,7 +1025,7 @@
     (flet ((handler ()   
 	     (cond ((null *swank-state-stack*)
 		    (with-reader-error-handler (connection)
-		      (process-available-input 
+		      (process-available-input
 		       client (lambda () (handle-request connection)))))
 		   ((eq (car *swank-state-stack*) :read-next-form))
 		   (t 
@@ -2263,7 +2263,8 @@
                                                  (setf notes-p t)
                                                  (record-note-for-condition c))))
             (measure-time-interval function)))
-      (when result (setf result (if notes-p :complained t)))
+      (when result        (setf result (if notes-p :complained t)))
+      (when (eql usecs t) (setf usecs 0)) ; compilation aborted.
       (push result (swank-compilation-unit.results *swank-compilation-unit*))
       (push usecs  (swank-compilation-unit.durations *swank-compilation-unit*))
       (swank-compilation-unit-for-emacs *swank-compilation-unit*))))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/07/17 22:19:11	1.199
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/07/26 23:05:59	1.200
@@ -461,20 +461,22 @@
     #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
     (when debug
       (sb-ext:restrict-compiler-policy 'debug debug))
-    (flet ((compile-it (fn)
+    (flet ((load-it (filename)
+             (when filename (load filename)))
+           (compile-it (cont)
              (with-compilation-hooks ()
                (with-compilation-unit
                    (:source-plist (list :emacs-buffer buffer
                                         :emacs-directory directory
                                         :emacs-string string
                                         :emacs-position position))
-                 (funcall fn (compile-file filename))))))
+                 (funcall cont (compile-file filename))))))
       (with-open-file (s filename :direction :output :if-exists :error)
         (write-string string s))
       (unwind-protect
            (if *trap-load-time-warnings*
-               (compile-it #'load)
-               (load (compile-it #'identity)))
+               (compile-it #'load-it)
+               (load-it (compile-it #'identity)))
         (ignore-errors
           #+#.(swank-backend::sbcl-with-symbol
                'restrict-compiler-policy 'sb-ext)
@@ -527,16 +529,18 @@
              (structure-class    :structure-class)
              (class              :class)
              (method-combination :method-combination)
+             (package            :package)
+             (condition          :condition)             
              (structure-object   :structure-object)
              (standard-object    :standard-object)
-             (condition          :condition)
              (t                  :thing)))
          (to-string (obj)
            (typecase obj
+             (package (princ-to-string obj)) ; Packages are possibly named entities.
              ((or structure-object standard-object condition)
               (with-output-to-string (s)
                 (print-unreadable-object (obj s :type t :identity t))))
-             (t (format nil "~A" obj)))))
+             (t (princ-to-string obj)))))
     (handler-case
         (make-definition-source-location
          (sb-introspect:find-definition-source obj) (general-type-of obj) (to-string obj))
@@ -751,7 +755,7 @@
   #'(lambda (condition old-hook)
       ;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before
       ;; *DEBUGGER-HOOK*, so we have to make sure that the latter gets
-      ;; run when it was established locally by a user.
+      ;; run when it was established locally by a user (i.e. changed meanwhile.)
       (if *debugger-hook*
           (funcall *debugger-hook* condition old-hook)
           (funcall hook condition old-hook))))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/07/17 22:19:12	1.134
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/07/26 23:05:59	1.135
@@ -348,14 +348,18 @@
 
 If DEBUG is supplied, and non-NIL, it may be used by certain
 implementations to compile with a debug optimization quality of its
-value..
+value.
+
+Should return T on successfull compilation, NIL otherwise.
 ")
 
 (definterface swank-compile-file (filename load-p external-format)
    "Compile FILENAME signalling COMPILE-CONDITIONs.
 If LOAD-P is true, load the file after compilation.
 EXTERNAL-FORMAT is a value returned by find-external-format or
-:default.")
+:default.
+
+Should return T on successfull compilation, NIL otherwise.")
 
 (deftype severity () 
   '(member :error :read-error :warning :style-warning :note))
@@ -766,7 +770,7 @@
 OBJECT. E.g. on a STANDARD-OBJECT, the source location of the
 respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the
 respective DEFSTRUCT definition, and so on."
-  ;; This returns _ source location and not a list of locations. It's
+  ;; This returns one source location and not a list of locations. It's
   ;; supposed to return the location of the DEFGENERIC definition on
   ;; #'SOME-GENERIC-FUNCTION.
   )
--- /project/slime/cvsroot/slime/ChangeLog	2008/07/23 14:29:26	1.1374
+++ /project/slime/cvsroot/slime/ChangeLog	2008/07/26 23:05:59	1.1375
@@ -1,3 +1,14 @@
+2008-07-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank.lisp (swank-compiler): Fix bug when invoking an abort
+	restart on a failed compilation attempt.
+
+	* swank-sbcl.lisp (swank-compile-string): If a compilation attempt
+	fails, COMPILE-FILE returns NIL which we tried to LOAD. Fix that.
+
+	* swank-backend.lisp (swank-compile-string, swank-compile-file):
+	Document return value.
+
 2008-07-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-loader.lisp (*contribs*): Added `swank-package-fu'.




More information about the slime-cvs mailing list