Subject: bug#28997: closed (Re: bug#28997: 27.0.50; Error in async shell-command process filter)

From: [email-masked] (GNU bug Tracking System)
Date: Fri, 03 Nov 2017 09:53:01 +0000

Your bug report

#28997: 27.0.50; Error in async shell-command process filter

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
28997: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=28997
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#28997: 27.0.50; Error in async shell-command process filter
From: Eli Zaretskii <[email-masked]>
To: "Basil L. Contovounesios" <[email-masked]>
Cc: [email-masked]
Date: Fri, 03 Nov 2017 11:52:35 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

> From: "Basil L. Contovounesios" <[email-masked]>
> Date: Wed, 25 Oct 2017 16:50:01 +0100
> 
> 1) emacs -Q
> 2) M-x set-variable RET
>    async-shell-command-display-buffer RET
>    nil RET
> 3) M-: (async-shell-command
>         "ls ~" (generate-new-buffer "home")) RET
> 
> This results in the following error:
> 
>   error in process filter: Wrong type argument:
>     stringp, #<buffer home>
> 
> I attach the relevant backtrace.

Thanks, I've pushed your changes to fix this bug, and I'm marking this
bug report as done.

Subject: 27.0.50; Error in async shell-command process filter
From: "Basil L. Contovounesios" <[email-masked]>
To: [email-masked]
Date: Wed, 25 Oct 2017 16:50:01 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

>From 064e4e4d9958fcfc0980091f302a0dd31bdc4581 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <[email-masked]>
Date: Wed, 25 Oct 2017 16:15:19 +0100
Subject: [PATCH 1/2] Fix buffer name comparison in async shell-command

When async-shell-command-display-buffer is nil, the async
shell-command process filter passed output-buffer, which could be a
buffer object, to string=, resulting in an error.

* lisp/simple.el (shell-command): Keep track of output-buffer name to
fix this and DRY.  Replace quoted lambda with closure.
---
 lisp/simple.el | 35 ++++++++++++++---------------------
 1 file changed, 14 insertions(+), 21 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 12d65e50c3..96f5a321f3 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3487,10 +3487,11 @@ shell-command
 	(save-match-data
 	  (if (string-match "[ \t]*&[ \t]*\\'" command)
 	      ;; Command ending with ampersand means asynchronous.
-	      (let ((buffer (get-buffer-create
-			     (or output-buffer "*Async Shell Command*")))
-		    (directory default-directory)
-		    proc)
+              (let* ((buffer (get-buffer-create
+                              (or output-buffer "*Async Shell Command*")))
+                     (name (buffer-name buffer))
+                     (directory default-directory)
+                     proc)
 		;; Remove the ampersand.
 		(setq command (substring command 0 (match-beginning 0)))
 		;; Ask the user what to do with already running process.
@@ -3505,30 +3506,24 @@ shell-command
 		   ((eq async-shell-command-buffer 'confirm-new-buffer)
 		    ;; If will create a new buffer, query first.
 		    (if (yes-or-no-p "A command is running in the default buffer.  Use a new buffer? ")
-			(setq buffer (generate-new-buffer
-				      (or (and (bufferp output-buffer) (buffer-name output-buffer))
-					  output-buffer "*Async Shell Command*")))
+                        (setq buffer (generate-new-buffer name))
 		      (error "Shell command in progress")))
 		   ((eq async-shell-command-buffer 'new-buffer)
 		    ;; It will create a new buffer.
-		    (setq buffer (generate-new-buffer
-				  (or (and (bufferp output-buffer) (buffer-name output-buffer))
-				      output-buffer "*Async Shell Command*"))))
+                    (setq buffer (generate-new-buffer name)))
 		   ((eq async-shell-command-buffer 'confirm-rename-buffer)
 		    ;; If will rename the buffer, query first.
 		    (if (yes-or-no-p "A command is running in the default buffer.  Rename it? ")
 			(progn
 			  (with-current-buffer buffer
 			    (rename-uniquely))
-			  (setq buffer (get-buffer-create
-					(or output-buffer "*Async Shell Command*"))))
+                          (setq buffer (get-buffer-create name)))
 		      (error "Shell command in progress")))
 		   ((eq async-shell-command-buffer 'rename-buffer)
 		    ;; It will rename the buffer.
 		    (with-current-buffer buffer
 		      (rename-uniquely))
-		    (setq buffer (get-buffer-create
-				  (or output-buffer "*Async Shell Command*"))))))
+                    (setq buffer (get-buffer-create name)))))
 		(with-current-buffer buffer
                   (shell-command--save-pos-or-erase)
 		  (setq default-directory directory)
@@ -3543,13 +3538,11 @@ shell-command
                   (if async-shell-command-display-buffer
                       (display-buffer buffer '(nil (allow-no-window . t)))
                     (add-function :before (process-filter proc)
-                                  `(lambda (process string)
-                                     (when (and (= 0 (buffer-size (process-buffer process)))
-                                                (string= (buffer-name (process-buffer process))
-                                                    ,(or output-buffer "*Async Shell Command*")))
-                                       (display-buffer (process-buffer process))))
-                                  ))
-                  ))
+                                  (lambda (process _string)
+                                    (let ((buf (process-buffer process)))
+                                      (when (and (zerop (buffer-size buf))
+                                                 (string= (buffer-name buf) name))
+                                        (display-buffer buf))))))))
 	    ;; Otherwise, command is executed synchronously.
 	    (shell-command-on-region (point) (point) command
 				     output-buffer nil error-buffer)))))))
-- 
2.14.2

>From 6e192d6bb5c2c8c3565df14505b15327fb061d48 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <[email-masked]>
Date: Wed, 25 Oct 2017 16:22:06 +0100
Subject: [PATCH 2/2] * lisp/simple.el (shell-command): Simplify cond with
 pcase

---
 lisp/simple.el | 54 +++++++++++++++++++++++++++---------------------------
 1 file changed, 27 insertions(+), 27 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 96f5a321f3..147cc34646 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3497,33 +3497,33 @@ shell-command
 		;; Ask the user what to do with already running process.
 		(setq proc (get-buffer-process buffer))
 		(when proc
-		  (cond
-		   ((eq async-shell-command-buffer 'confirm-kill-process)
-		    ;; If will kill a process, query first.
-		    (if (yes-or-no-p "A command is running in the default buffer.  Kill it? ")
-			(kill-process proc)
-		      (error "Shell command in progress")))
-		   ((eq async-shell-command-buffer 'confirm-new-buffer)
-		    ;; If will create a new buffer, query first.
-		    (if (yes-or-no-p "A command is running in the default buffer.  Use a new buffer? ")
-                        (setq buffer (generate-new-buffer name))
-		      (error "Shell command in progress")))
-		   ((eq async-shell-command-buffer 'new-buffer)
-		    ;; It will create a new buffer.
-                    (setq buffer (generate-new-buffer name)))
-		   ((eq async-shell-command-buffer 'confirm-rename-buffer)
-		    ;; If will rename the buffer, query first.
-		    (if (yes-or-no-p "A command is running in the default buffer.  Rename it? ")
-			(progn
-			  (with-current-buffer buffer
-			    (rename-uniquely))
-                          (setq buffer (get-buffer-create name)))
-		      (error "Shell command in progress")))
-		   ((eq async-shell-command-buffer 'rename-buffer)
-		    ;; It will rename the buffer.
-		    (with-current-buffer buffer
-		      (rename-uniquely))
-                    (setq buffer (get-buffer-create name)))))
+                  (pcase async-shell-command-buffer
+                    ('confirm-kill-process
+                     ;; If will kill a process, query first.
+                     (if (yes-or-no-p "A command is running in the default buffer.  Kill it? ")
+                         (kill-process proc)
+                       (error "Shell command in progress")))
+                    ('confirm-new-buffer
+                     ;; If will create a new buffer, query first.
+                     (if (yes-or-no-p "A command is running in the default buffer.  Use a new buffer? ")
+                         (setq buffer (generate-new-buffer name))
+                       (error "Shell command in progress")))
+                    ('new-buffer
+                     ;; It will create a new buffer.
+                     (setq buffer (generate-new-buffer name)))
+                    ('confirm-rename-buffer
+                     ;; If will rename the buffer, query first.
+                     (if (yes-or-no-p "A command is running in the default buffer.  Rename it? ")
+                         (progn
+                           (with-current-buffer buffer
+                             (rename-uniquely))
+                           (setq buffer (get-buffer-create name)))
+                       (error "Shell command in progress")))
+                    ('rename-buffer
+                     ;; It will rename the buffer.
+                     (with-current-buffer buffer
+                       (rename-uniquely))
+                     (setq buffer (get-buffer-create name)))))
 		(with-current-buffer buffer
                   (shell-command--save-pos-or-erase)
 		  (setq default-directory directory)
-- 
2.14.2

# Steps to reproduce

1) emacs -Q
2) M-x set-variable RET
   async-shell-command-display-buffer RET
   nil RET
3) M-: (async-shell-command
        "ls ~" (generate-new-buffer "home")) RET

This results in the following error:

  error in process filter: Wrong type argument:
    stringp, #<buffer home>

I attach the relevant backtrace.

# Diagnosis

When async-shell-command-display-buffer is nil, the async
shell-command process filter passes output-buffer, which
could be a buffer object, to string=.

# Patch

I attach two patches to address this issue.

The first patch replaces the quoted lambda process filter
with a closure over the name of output-buffer.  By keeping
track of this name, a lot of the surrounding
buffer-name-determining code can be simplified via DRY.

The second patch is purely aesthetic and simplifies the cond
that is touched by my first patch into an equivalent pcase.

# Environment

In GNU Emacs 27.0.50 (build 1, x86_64-pc-linux-gnu, X toolkit, Xaw3d scroll bars)
 of 2017-10-25 built on thunk
Repository revision: 090f4f157eea6f0d0d13963520f5e05706de142f
Windowing system distributor 'The X.Org Foundation', version 11.0.11905000
System Description:	Debian GNU/Linux testing (buster)

Recent messages:
Configuring package avy...done
Configuring package ace-window...done
Configuring package mm-decode...done
Configuring package dired...done
Loading /home/blc/.emacs.d/eudc-options...
Loading eudcb-bbdb...
Configuring package bbdb...done
Loading eudcb-bbdb...done
Loading /home/blc/.emacs.d/eudc-options...done
Configuring package message...done

Configured using:
 'configure --prefix=/home/blc/.local
 --enable-locallisppath= --with-mailutils --with-sound=yes
 --with-x-toolkit=lucid --with-xpm --with-jpeg --with-tiff
 --with-gif --with-png --with-rsvg --with-libsystemd
 --with-xml2 --with-imagemagick --with-xft --with-libotf
 --with-m17n-flt --with-toolkit-scroll-bars --with-xaw3d
 --with-xim --with-gpm --with-dbus --with-gsettings
 --with-selinux --with-gnutls --with-zlib --with-modules
 --with-threads --with-file-notification=yes --with-x
 --without-gconf --with-lcms2 'CFLAGS=-flto
 -fomit-frame-pointer -march=native -maes -mavx -mcrc32
 -mf16c -mfpmath=sse -mfsgsbase -mfxsr
 -minline-all-stringops -mmmx -mpclmul -mpopcnt -msahf
 -msse4.2 -mxsave -mxsaveopt -mvzeroupper -O3 -pipe'
 LDFLAGS=-flto'

Configured features:
XAW3D XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS
GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE
M17N_FLT LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS LUCID X11
MODULES LIBSYSTEMD LCMS2

Important settings:
  value of $LANG: en_IE.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  ace-window-display-mode: t
  shell-dirtrack-mode: t
  counsel-mode: t
  bug-reference-prog-mode: t
  fic-mode: t
  global-paren-face-mode: t
  paren-face-mode: t
  xterm-mouse-mode: t
  winner-mode: t
  global-whitespace-mode: t
  display-time-mode: t
  global-subword-mode: t
  subword-mode: t
  save-place-mode: t
  show-paren-mode: t
  global-hi-lock-mode: t
  hi-lock-mode: t
  engine-mode: t
  delete-selection-mode: t
  display-battery-mode: t
  override-global-mode: t
  blc-dropbox-mode: t
  blc-rainbow-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  window-divider-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  column-number-mode: t
  line-number-mode: t
  transient-mark-mode: t
  auto-save-visited-mode: t

Features:
(shadow sort footnote face-remap mail-extr gnus-msg gnus-art
mm-uu mml2015 mm-view mml-smime smime dig mailcap gnus-sum
gnus-group gnus-undo gnus-start gnus-cloud nnimap nnmail
mail-source tls gnutls utf7 netrc nnoo parse-time gnus-spec
gnus-int gnus-range gnus-win gnus nnheader emacsbug
eudcb-bbdb bbdb-com crm bbdb bbdb-site timezone eudc
eudc-options-file cus-edit eudc-vars wid-edit message rmc
puny git-annex dired-x dired dired-loaddefs format-spec
rfc822 mml mml-sec epa derived epg gnus-util rmail
rmail-loaddefs xdg mm-decode mm-bodies mm-encode mail-parse
rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047
rfc2045 ietf-drums mm-util mail-prsvr mail-utils ace-window
avy cl-print debug shell pcomplete comint ansi-color
cus-start cus-load colir color counsel jka-compr esh-util
etags xref project swiper ivy flx ivy-overlay ffap thingatpt
server bug-reference fic-mode fill-column-indicator
paren-face elec-pair xt-mouse winner ring disp-table
whitespace time cap-words superword subword saveplace paren
ibuf-macs highlight-escape-sequences hi-lock time-date
engine-mode delsel battery edmacro kmacro cl-extra help-mode
delight advice zenburn-theme browse-url use-package diminish
bind-key finder-inf tex-site info package easymenu
epg-config url-handlers url-parse auth-source cl-seq eieio
eieio-core cl-macs eieio-loaddefs password-cache url-vars
blc-macs blc-lib easy-mmode rx pcase thunk subr-x map seq
byte-opt gv bytecomp byte-compile cconv cl-loaddefs cl-lib
realpath mule-util tooltip eldoc electric uniquify
ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt
fringe tabulated-list replace newcomment text-mode
elisp-mode lisp-mode prog-mode register page menu-bar
rfn-eshadow isearch timer select scroll-bar mouse jit-lock
font-lock syntax facemenu font-core term/tty-colors frame
cl-generic cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932
hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite charscript charprop case-table
epa-hook jka-cmpr-hook help simple abbrev obarray minibuffer
cl-preloaded nadvice loaddefs button faces cus-face macroexp
files text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget hashtable-print-readable
backquote dbusbind inotify lcms2 dynamic-setting
system-font-setting font-render-setting x-toolkit x
multi-tty make-network-process emacs)

Memory information:
((conses 16 359441 89175)
 (symbols 48 41275 27)
 (miscs 40 1373 2435)
 (strings 32 101726 9595)
 (string-bytes 1 3144509)
 (vectors 16 36288)
 (vector-slots 8 830885 84664)
 (floats 8 420 172)
 (intervals 56 1018 82)
 (buffers 992 17))

Thanks,

-- 
Basil