bug#44173: 28.0.50; gdb-mi mangles strings with octal escapes

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 1109 bytes --]

23 okt. 2020 kl. 20.20 skrev Eli Zaretskii <eliz@gnu.org>:

> I don't understand your answers and don't see how they
> resolve the issues I raised.

Sorry if I've been communicating badly (but it takes two to do it).
I honestly thought I did address your concerns but must have misunderstood you.
Please tell me what you believe I have not explained properly, and I promise I'll do my best to answer it without referring to any previous message.

Meanwhile, here is a proof of concept which may clarify what I failed to put in words. It actually runs both the old and new value parsers on data sent by GDB, and logs an error message if discrepancies are found. They seem to work identically unless there are strings with octal escapes, which are handled correctly by the new parser. (Of course, a proper patch would not retain the old parser.)

If gdb-mi-decode-strings is non-nil, then file names, string contents etc are properly decoded as UTF-8 as expected, without any of the bugginess of the current code. Otherwise raw bytes are shown as octal escapes, which also fixes the original bug.


[-- Attachment #2: gdb-mi.diff --]
[-- Type: application/octet-stream, Size: 6251 bytes --]

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 9e8af84a60..867e13b38a 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -2516,8 +2516,9 @@ gud-gdbmi-marker-filter
   "Filter GDB/MI output."
 
   ;; If required, decode non-ASCII text encoded with octal escapes.
-  (or (null gdb-mi-decode-strings)
-      (setq string (gdb-mi-decode string)))
+;; FIXME: Now done in gdb-mi--parse-c-string; this can go away
+;;  (or (null gdb-mi-decode-strings)
+;;      (setq string (gdb-mi-decode string)))
 
   ;; Record transactions if logging is enabled.
   (when gdb-enable-debug
@@ -2833,7 +2834,7 @@ gdb-jsonify-buffer
     (goto-char (point-max))
     (insert "}")))
 
-(defun gdb-json-read-buffer (&optional fix-key fix-list)
+(defun gdb-json-read-buffer-old (&optional fix-key fix-list)
   "Prepare and parse GDB/MI output in current buffer with `json-read'.
 
 FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
@@ -2843,6 +2844,140 @@ gdb-json-read-buffer
     (let ((json-array-type 'list))
       (json-read))))
 
+;; Parse result records: this process converts key=value to the cons pair
+;; (variable . value) where variable is a symbol.  Lists and tuples become
+;; Lisp lists.
+
+(defun gdb-mi--parse-tuple-or-list (end-char)
+  "Parse a GDB/MI tuple or list, both returned as a Lisp list.
+END-CHAR is the ending delimiter; will stop at end-of-buffer otherwise."
+  (let ((items nil))
+    (while (not (or (eobp)
+                    (eq (following-char) end-char)))
+      (let ((item (gdb-mi--parse-result-or-value)))
+        (push item items)
+        (when (eq (following-char) ?,)
+          (forward-char))))
+    (when (eq (following-char) end-char)
+      (forward-char))
+    (nreverse items)))
+
+(defun gdb-mi--parse-c-string ()
+  (let ((start (point))
+        (pieces nil)
+        (octals-used nil))
+    (while (and (re-search-forward (rx (or ?\\ ?\")))
+                (not (eq (preceding-char) ?\")))
+      (push (buffer-substring start (1- (point))) pieces)
+      (cond
+       ((looking-at (rx (** 1 3 (any "0-7")))) ;FIXME: optimise
+        (push (unibyte-string (string-to-number (match-string 0) 8)) pieces)
+        (setq octals-used t)
+        (goto-char (match-end 0)))
+       ((looking-at (rx (any "ntrvfab\"\\")))
+        (push (cdr (assq (following-char)
+                         '((?n . "\n")
+                           (?t . "\t")
+                           (?r . "\r")
+                           (?v . "\v")
+                           (?f . "\f")
+                           (?a . "\a")
+                           (?b . "\b")
+                           (?\" . "\"")
+                           (?\\ . "\\"))))
+              pieces)
+        (forward-char))
+       (t
+        (error "Unrecognised escape char: %c" (following-char))))
+      (setq start (point)))
+    (push (buffer-substring start (1- (point))) pieces)
+    (let ((s (apply #'concat (nreverse pieces))))
+      (if (and octals-used gdb-mi-decode-strings)
+          (let ((coding
+                 (if (coding-system-p gdb-mi-decode-strings)
+                     gdb-mi-decode-strings
+                   ;; FIXME: try making this cheaper
+                   (buffer-local-value
+                    'buffer-file-coding-system
+                    (gdb-get-buffer-create 'gdb-partial-output-buffer)))))
+            (decode-coding-string s coding))
+        s))))
+
+(defun gdb-mi--parse-value ()
+  "Parse a value."
+  (cond
+   ((eq (following-char) ?\{)
+    (forward-char)
+    (gdb-mi--parse-tuple-or-list ?\}))
+   ((eq (following-char) ?\[)
+    (forward-char)
+    (gdb-mi--parse-tuple-or-list ?\]))
+   ((eq (following-char) ?\")
+    (forward-char)
+    (gdb-mi--parse-c-string))
+   (t (error "Bad start of result or value: %c" (following-char)))))
+    
+(defun gdb-mi--parse-result-or-value ()
+  "Parse a result (key=value) or value."
+  (if (looking-at (rx (group (+ (any "a-zA-Z" ?_ ?-))) "="))
+      (progn
+        (goto-char (match-end 0))
+        (let* ((variable (intern (match-string 1)))
+               (value (gdb-mi--parse-value)))
+          (cons variable value)))
+    (gdb-mi--parse-value)))
+
+(defun gdb-mi--parse-results ()
+  "Parse zero or more result productions as a list."
+  (gdb-mi--parse-tuple-or-list nil))
+
+(defun gdb-mi--fix-key (key value)
+  "Convert any result (key-value pair) in VALUE whose key is KEY to its value."
+  (cond
+   ((atom value) value)
+   ((symbolp (car value))
+    (if (eq (car value) key)
+        (cdr value)
+      (cons (car value) (gdb-mi--fix-key key (cdr value)))))
+   (t (mapcar (lambda (x) (gdb-mi--fix-key key x)) value))))
+
+(defun gdb-mi--extend-fullname (remote value)
+  "Prepend REMOTE to any result string with `fullname' as the key."
+  (cond
+   ((atom value) value)
+   ((symbolp (car value))
+    (if (and (eq (car value) 'fullname)
+             (stringp (cdr value)))
+        (cons 'fullname (concat remote (cdr value)))
+      (cons (car value) (gdb-mi--extend-fullname remote (cdr value)))))
+   (t (mapcar (lambda (x) (gdb-mi--extend-fullname remote x)) value))))
+
+(defun gdb-json-read-buffer-new (&optional fix-key _fix-list)
+  (goto-char (point-min))
+  (let ((results (gdb-mi--parse-results)))
+    (let ((remote (file-remote-p default-directory)))
+      (when remote
+        (setq results (gdb-mi--extend-fullname remote results))))
+    (when fix-key
+      ;; FIXME: fix-key should be a symbol.
+      (setq results (gdb-mi--fix-key (intern fix-key) results)))
+    ;; FIXME: fix-list is irrelevant since tuples and lists in the
+    ;; input both yield Lisp lists.
+    results))
+
+(defun gdb-json-read-buffer (&optional fix-key fix-list)
+  (save-excursion
+    (let* ((input (buffer-string))
+           (new (gdb-json-read-buffer-new fix-key fix-list))
+           (_ (cl-assert (equal (buffer-string) input)))
+           (old (gdb-json-read-buffer-old fix-key fix-list)))
+      (unless (equal old new)
+        (message "ERROR: input=%S" input)
+        (message "OLD: %S" old)
+        (message "NEW: %S" new))
+      new)))
+
+
 (defun gdb-json-string (string &optional fix-key fix-list)
   "Prepare and parse STRING containing GDB/MI output with `json-read'.