Infinite loop in slime-presentation-start

[corngood]

I'm not sure if this is a problem with slime, or company, or something else, but company completion in a slime buffer, after having evaluating some large-ish strings in repl, results in what seems to be an infinite loop here:

  (let ((change-point (previous-single-property-change point presentation object (point-min)))) (if change-point nil (throw '--cl-block-slime-presentation-start-- (cl-values (cond ((bufferp object) (save-current-buffer (set-buffer object) 1)) ((stringp object) 0) ((error "cl-etypecase failed: %s, %s" object '...) nil)) nil))) (setq this-presentation (get-text-property change-point presentation object)) (if this-presentation nil (throw '--cl-block-slime-presentation-start-- (cl-values point nil))) (setq point change-point))
  (while (not (slime-presentation-start-p this-presentation)) (let ((change-point (previous-single-property-change point presentation object (point-min)))) (if change-point nil (throw '--cl-block-slime-presentation-start-- (cl-values (cond ((bufferp object) (save-current-buffer ... 1)) ((stringp object) 0) ((error "cl-etypecase failed: %s, %s" object ...) nil)) nil))) (setq this-presentation (get-text-property change-point presentation object)) (if this-presentation nil (throw '--cl-block-slime-presentation-start-- (cl-values point nil))) (setq point change-point)))
  (let* ((this-presentation (get-text-property point presentation object))) (while (not (slime-presentation-start-p this-presentation)) (let ((change-point (previous-single-property-change point presentation object (point-min)))) (if change-point nil (throw '--cl-block-slime-presentation-start-- (cl-values (cond (... ...) (... 0) (... nil)) nil))) (setq this-presentation (get-text-property change-point presentation object)) (if this-presentation nil (throw '--cl-block-slime-presentation-start-- (cl-values point nil))) (setq point change-point))) (cl-values point t))
  (catch '--cl-block-slime-presentation-start-- (let* ((this-presentation (get-text-property point presentation object))) (while (not (slime-presentation-start-p this-presentation)) (let ((change-point (previous-single-property-change point presentation object (point-min)))) (if change-point nil (throw '--cl-block-slime-presentation-start-- (cl-values (cond ... ... ...) nil))) (setq this-presentation (get-text-property change-point presentation object)) (if this-presentation nil (throw '--cl-block-slime-presentation-start-- (cl-values point nil))) (setq point change-point))) (cl-values point t)))
  (progn (if --cl-rest-- (signal 'wrong-number-of-arguments (list 'slime-presentation-start (+ 3 (length --cl-rest--))))) (catch '--cl-block-slime-presentation-start-- (let* ((this-presentation (get-text-property point presentation object))) (while (not (slime-presentation-start-p this-presentation)) (let ((change-point (previous-single-property-change point presentation object ...))) (if change-point nil (throw '--cl-block-slime-presentation-start-- (cl-values ... nil))) (setq this-presentation (get-text-property change-point presentation object)) (if this-presentation nil (throw '--cl-block-slime-presentation-start-- (cl-values point nil))) (setq point change-point))) (cl-values point t))))
  (let* ((object (if --cl-rest-- (car-safe (prog1 --cl-rest-- (setq --cl-rest-- (cdr --cl-rest--)))) (current-buffer)))) (progn (if --cl-rest-- (signal 'wrong-number-of-arguments (list 'slime-presentation-start (+ 3 (length --cl-rest--))))) (catch '--cl-block-slime-presentation-start-- (let* ((this-presentation (get-text-property point presentation object))) (while (not (slime-presentation-start-p this-presentation)) (let ((change-point ...)) (if change-point nil (throw ... ...)) (setq this-presentation (get-text-property change-point presentation object)) (if this-presentation nil (throw ... ...)) (setq point change-point))) (cl-values point t)))))
  slime-presentation-start(1 #s(slime-presentation :text "[...]" :id 1) #<buffer  *company-sps*>)
  slime-presentation-bounds(1 #s(slime-presentation :text "[...]" :id 1) #<buffer  *company-sps*>)
  #<subr F616e6f6e796d6f75732d6c616d626461_anonymous_lambda_15>(#s(slime-presentation :text "[...]" :id 1) 1)
  slime-for-each-presentation-in-region(1 77 #<subr F616e6f6e796d6f75732d6c616d626461_anonymous_lambda_16>)
  slime-after-change-function(1 77)
  #<subr delete-region>(1 77)
  ad-Advice-delete-region(#<subr delete-region> 1 77)
  apply(ad-Advice-delete-region #<subr delete-region> (1 77))
  delete-region(1 77)
  company-safe-pixel-substring("" 0 64)
  company--replacement-string((#(" force-output -f------    ..." 0 1 (mouse-face ... face ...) 1 13 (flags "-f------" score "28.70" mouse-face ... face ...) 13 22 (mouse-face ... face ...) 22 46 (mouse-face ... face ...) 46 47 (display ... mouse-face ... face ...) 47 48 (face company-tooltip-scrollbar-thumb display ...)) #(" *forcibly-terminate-threa..." 0 1 (mouse-face ... face company-tooltip) 1 37 (flags "b-------" score "27.99" mouse-face ... face company-tooltip) 37 46 (mouse-face ... face ...) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-thumb display ...)) #(" asdf/footer: -------p    ..." 0 1 (mouse-face ... face company-tooltip) 1 13 (flags "-------p" score "25.35" mouse-face ... face company-tooltip) 13 22 (mouse-face ... face ...) 22 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" stream-force-output -fg--..." 0 1 (mouse-face ... face company-tooltip) 1 20 (flags "-fg-----" score "24.59" mouse-face ... face company-tooltip) 20 29 (mouse-face ... face ...) 29 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" fold-identical-code -f---..." 0 1 (mouse-face ... face company-tooltip) 1 20 (flags "-f------" score "21.29" mouse-face ... face company-tooltip) 20 29 (mouse-face ... face ...) 29 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" floating-point-overflow -..." 0 1 (mouse-face ... face company-tooltip) 1 24 (flags "---ct---" score "19.48" mouse-face ... face company-tooltip) 24 33 (mouse-face ... face ...) 33 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" floating-point-invalid-op..." 0 1 (mouse-face ... face company-tooltip) 1 33 (flags "---ct---" score "19.33" mouse-face ... face company-tooltip) 33 42 (mouse-face ... face ...) 42 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" step-form-condition ---ct..." 0 1 (mouse-face ... face company-tooltip) 1 20 (flags "---ct---" score "17.59" mouse-face ... face company-tooltip) 20 29 (mouse-face ... face ...) 29 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" make-load-form-saving-slo..." 0 1 (mouse-face ... face company-tooltip) 1 28 (flags "-f------" score "17.40" mouse-face ... face company-tooltip) 28 37 (mouse-face ... face ...) 37 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...)) #(" simple-condition-format-c..." 0 1 (mouse-face ... face company-tooltip) 1 32 (flags "-f------" score "17.34" mouse-face ... face company-tooltip) 32 41 (mouse-face ... face ...) 41 46 (mouse-face ... face company-tooltip) 46 47 (display ... mouse-face ... face company-tooltip) 47 48 (face company-tooltip-scrollbar-track display ...))) 1 nil 9 t nil)
  company-pseudo-tooltip-show(2 9 0)
  company-pseudo-tooltip-show-at-point(90768 3)
  company-pseudo-tooltip-frontend(post-command)
  company-pseudo-tooltip-unless-just-one-frontend(post-command)
  company-call-frontends(post-command)
  company-post-command()
  company-idle-begin(#<buffer *slime-repl sbcl*> #<window 44 on *slime-repl sbcl*> 387 90768)
  apply(company-idle-begin (#<buffer *slime-repl sbcl*> #<window 44 on *slime-repl sbcl*> 387 90768))
  timer-event-handler([t 26079 46127 9718 nil company-idle-begin (#<buffer *slime-repl sbcl*> #<window 44 on *slime-repl sbcl*> 387 90768) nil 276000 nil])

slime-presentation-start is looping infinitely because point is 1, the buffer is *company-sps*, get-text-property returns :interior, and previous-single-property-change returns 1.

It should be easy enough to avoid the infinite loop, but there's something deeper going on.

I'm currently trying to understand why slime-after-change-function is getting called for this buffer, but only in some situations.

I've reproduced this on emacs 29.1 and 28.2. slime-20240226.1721, company-20240218.1812

[corngood]

I'm currently trying to understand why slime-after-change-function is getting called for this buffer, but only in some situations.

So what's happening is that slime is doing:

      (add-text-properties start end
                           `(modification-hooks (slime-after-change-function)
                             insert-in-front-hooks (slime-after-change-function)
                             insert-behind-hooks (slime-after-change-function)

But then company-safe-pixel-substring copies these characters to a temporary buffer, where the hooks still run.

In terms of solving it:

1. slime-presentation-start could throw an error instead of looping. this is probably a good defensive change
2. company-safe-pixel-substring could inhibit modification hooks in this temporary buffer

Beyond that I'm not sure. I'll have to do a bit of searching for a similar case.