Ignore:
Timestamp:
10/09/20 05:55:31 (2 years ago)
Author:
Mark Evenson
Message:

Ensure that SYS:CHECK-REDEFINITION does not signal error conditions

Unfortunately, SLIME v2.26 code can throw errors when compiling Emacs
buffers, namely the pathname may have a device containing the string
"emacs-buffer" whose PATHNAME name denotes the buffer which often
contain wild-pathname characters (e.g. "*slime-scratch*") causing a
naieve PROBE-FILE to throw errors.

TODO redo ABCL SLIME's use of PATHNAME-DEVICE components to mark a
source location.

Use IGNORE-ERRORS to be extra careful.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/fdefinition.lisp

    r14933 r15388  
    3838    (when (and (symbolp name)
    3939               (source-pathname name))
    40       ;; SOURCE-PATHNAME is badly named as it is either a PATHNAMAE
    41       ;; or the symbol :TOP-LEVEL
    42       (let ((old-source
    43              (if (keywordp (source-pathname name))
    44                  (source-pathname name)
    45                  (probe-file (source-pathname name))))
    46             (current-source
    47              (if (not *source*)
    48                  :top-level
    49                  (probe-file *source*))))
    50         (cond ((equal old-source
    51                       current-source)) ; OK
    52               (t
    53                (if (eq current-source :top-level)
    54                    (style-warn "redefining ~S at top level" name)
    55                    (let ((*package* +cl-package+))
    56                      (if (eq old-source :top-level)
    57                          (style-warn "redefining ~S in ~S (previously defined at top level)"
    58                                      name current-source)
    59                          (style-warn "redefining ~S in ~S (previously defined in ~S)"
    60                                      name current-source old-source))))))))))
     40      ;; SOURCE-PATHNAME is badly named as it is either a PATHNAME,
     41      ;; the keyword :TOP-LEVEL.
     42      ;;
     43      ;; Unfortunately, as of SLIME v2.26 the pathname may have a
     44      ;; device containing the string "emacs-buffer" whose PATHNAME
     45      ;; name denotes the buffer, which often contain wild-pathname
     46      ;; characters (e.g. "*slime-scratch*").  We code around that
     47      ;; situation with the following convolution of intelligibility.
     48      (flet ((truename-no-error (p)
     49               (if (and (pathnamep p)
     50      (not (and
     51            (stringp (pathname-device p))
     52            (string= (pathname-device p)
     53               "emacs-buffer")))
     54                        (not (wild-pathname-p p)))
     55                   (probe-file p)
     56                   p)))
     57        (let ((source (source-pathname name)))
     58          (let ((old-source
     59                  (if (keywordp source)
     60                      source
     61                      (truename-no-error source)))
     62                (current-source
     63                  (if (not *source*)
     64                      :top-level
     65                      (truename-no-error source))))
     66            (cond ((equal old-source
     67                          current-source)) ; OK
     68                  (t
     69                   (if (eq current-source :top-level)
     70                       (style-warn "redefining ~S at top level" name)
     71                       (let ((*package* +cl-package+))
     72                         (if (eq old-source :top-level)
     73                             (style-warn "redefining ~S in ~S (previously defined at top level)"
     74                                         name current-source)
     75                             (style-warn "redefining ~S in ~S (previously defined in ~S)"
     76                                     name current-source old-source))))))))))))
    6177
    6278;;; DEPRECATED:  to be removed in abcl-1.7
Note: See TracChangeset for help on using the changeset viewer.