Skip to content
Snippets Groups Projects
Commit 9daadaf3 authored by ram's avatar ram
Browse files

Tweaked source-path-context to check if the source path in in bounds for the

form so that we don't get bus errors, etc., if the file has been modified.
parent ccf52692
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.59 1993/05/28 05:20:44 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.60 1993/07/22 00:02:08 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -3042,8 +3042,11 @@ ...@@ -3042,8 +3042,11 @@
;; context and path. ;; context and path.
(let ((path (reverse (butlast (cdr path))))) (let ((path (reverse (butlast (cdr path)))))
(dotimes (i (- (length path) context)) (dotimes (i (- (length path) context))
(setq form (elt form (first path))) (let ((index (first path)))
(setq path (rest path))) (unless (and (listp form) (< index (length form)))
(error "Source path no longer exists."))
(setq form (elt form index))
(setq path (rest path))))
;; ;;
;; Recursively rebuild the source form resulting from the above descent, ;; Recursively rebuild the source form resulting from the above descent,
;; copying the beginning of each subform up to the next subform we descend ;; copying the beginning of each subform up to the next subform we descend
...@@ -3055,10 +3058,12 @@ ...@@ -3055,10 +3058,12 @@
(if (zerop context) (if (zerop context)
form form
`(#:***here*** ,form)) `(#:***here*** ,form))
(let* ((n (first path)) (let ((n (first path)))
(res (frob (elt form n) (rest path) (1- level)))) (unless (and (listp form) (< n (length form)))
(nconc (subseq form 0 n) (error "Source path no longer exists."))
(cons res (nthcdr (1+ n) form))))))) (let ((res (frob (elt form n) (rest path) (1- level))))
(nconc (subseq form 0 n)
(cons res (nthcdr (1+ n) form))))))))
(frob form path context)))) (frob form path context))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment