/[slime]/slime/swank-allegro.lisp
ViewVC logotype

Diff of /slime/swank-allegro.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.130 by sboukarev, Fri Dec 11 03:37:17 2009 UTC revision 1.131 by trittweiler, Mon Jan 25 10:50:10 2010 UTC
# Line 233  Line 233 
233  (defun compiler-note-p (object)  (defun compiler-note-p (object)
234    (member (type-of object) '(excl::compiler-note compiler::compiler-note)))    (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
235    
236    (defun redefinition-p (condition)
237      (and (typep condition 'style-warning)
238           (every #'char-equal "redefin" (princ-to-string condition))))
239    
240  (defun compiler-undefined-functions-called-warning-p (object)  (defun compiler-undefined-functions-called-warning-p (object)
241    (typep object 'excl:compiler-undefined-functions-called-warning))    (typep object 'excl:compiler-undefined-functions-called-warning))
242    
243  (deftype compiler-note ()  (deftype compiler-note ()
244    `(satisfies compiler-note-p))    `(satisfies compiler-note-p))
245    
246    (deftype redefinition ()
247      `(satisfies redefinition-p))
248    
249  (defun signal-compiler-condition (&rest args)  (defun signal-compiler-condition (&rest args)
250    (signal (apply #'make-condition 'compiler-condition args)))    (signal (apply #'make-condition 'compiler-condition args)))
251    
# Line 251  Line 258 
258           (signal-compiler-condition           (signal-compiler-condition
259            :original-condition condition            :original-condition condition
260            :severity (etypecase condition            :severity (etypecase condition
261                        (warning :warning)                        (redefinition  :redefinition)
262                          (style-warning :style-warning)
263                          (warning       :warning)
264                        (compiler-note :note)                        (compiler-note :note)
265                        (reader-error :read-error))                        (reader-error  :read-error)
266                          (error         :error))
267            :message (format nil "~A" condition)            :message (format nil "~A" condition)
268            :location (if (typep condition 'reader-error)            :location (if (typep condition 'reader-error)
269                          (location-for-reader-error condition)                          (location-for-reader-error condition)

Legend:
Removed from v.1.130  
changed lines
  Added in v.1.131

  ViewVC Help
Powered by ViewVC 1.1.5