Merge remote-tracking branch 'savannah/master' into native-comp

7 files changed, 102 insertions, 13 deletions

diff --git a/test/src/character-tests.el b/test/src/character-tests.el
new file mode 100644
index 00000000000..f630b32a5ee
--- /dev/null
+++ b/test/src/character-tests.el
@@ -0,0 +1,45 @@
+;;; character-tests.el --- tests for character.c  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest character-test-string-width ()
+  "Test `string-width' with and without compositions."
+  (should (= (string-width "1234") 4))
+  (should (= (string-width "12\t34") (+ 4 tab-width)))
+  (should (= (string-width "áëòç") 4))
+  (should (= (string-width "áëòç") 4))
+  (should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
+  (should (= (string-width "1234" 1 3) 2))
+  (should (= (string-width "1234" nil -1) 3))
+  (should (= (string-width "1234" 2) 2))
+  (should-error (string-width "1234" nil 5))
+  (should-error (string-width "1234" -5))
+  (should (= (string-width "12\t34") (+ 4 tab-width)))
+  (should (= (string-width "1234\t56") (+ 6 tab-width)))
+  (should (= (string-width "áëòç") 4))
+  (should (= (string-width "áëòç" nil 3) 3))
+  (should (= (string-width "áëòç" 1 3) 2))
+  (should (= (string-width "áëòç" nil 2) 1))
+  (should (= (string-width "áëòç" nil 3) 2))
+  (should (= (string-width "áëòç" nil 4) 2))
+  (should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
+  (should (= (string-width "הַרְבֵּה אַהֲבָה" nil 8) 4)))
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index ea80da4819c..a731a95ccf0 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -1,4 +1,4 @@
-;;; editfns-tests.el -- tests for editfns.c  -*- lexical-binding:t -*-
+;;; editfns-tests.el --- tests for editfns.c  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index af5bc2a0baf..0a68d51e3eb 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -1,4 +1,4 @@
-;;; emacs-module-tests --- Test GNU Emacs modules.  -*- lexical-binding: t; -*-
+;;; emacs-module-tests.el --- Test GNU Emacs modules.  -*- lexical-binding: t; -*-
 
 ;; Copyright 2015-2021 Free Software Foundation, Inc.
 
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
index 09f9a248efb..87c3e84cdd2 100644
--- a/test/src/emacs-tests.el
+++ b/test/src/emacs-tests.el
@@ -144,12 +144,14 @@ to `make-temp-file', which see."
     (should-not (file-remote-p filter))
     (cl-callf file-name-unquote filter)
     (with-temp-buffer
-      (let ((status (call-process
+      (let ((start-time (current-time))
+            (status (call-process
                      emacs nil t nil
                      "--quick" "--batch"
                      (concat "--seccomp=" filter)
-                     (format "--eval=%S" '(message "Hi")))))
-        (ert-info ((format "Process output: %s" (buffer-string)))
+                     (format "--eval=%S" '(message "Hi"))))
+            (end-time (current-time)))
+        (ert-info ((emacs-tests--seccomp-debug start-time end-time))
           (should (eql status 0)))
         (should (equal (string-trim (buffer-string)) "Hi"))))))
 
@@ -167,14 +169,16 @@ to `make-temp-file', which see."
     (should-not (file-remote-p filter))
     (cl-callf file-name-unquote filter)
     (with-temp-buffer
-      (let ((status
+      (let ((start-time (current-time))
+            (status
              (call-process
               emacs nil t nil
               "--quick" "--batch"
               (concat "--seccomp=" filter)
               (format "--eval=%S" `(call-process ,emacs nil nil nil
-                                                 "--version")))))
-        (ert-info ((format "Process output: %s" (buffer-string)))
+                                                 "--version"))))
+            (end-time (current-time)))
+        (ert-info ((emacs-tests--seccomp-debug start-time end-time))
           (should-not (eql status 0)))))))
 
 (ert-deftest emacs-tests/bwrap/allows-stdout ()
@@ -205,9 +209,49 @@ to `make-temp-file', which see."
                           " ")
                " 20< "
                (shell-quote-argument (file-name-unquote filter))))
-             (status (call-process bash nil t nil "-c" command)))
-        (ert-info ((format "Process output: %s" (buffer-string)))
+             (start-time (current-time))
+             (status (call-process bash nil t nil "-c" command))
+             (end-time (current-time)))
+        (ert-info ((emacs-tests--seccomp-debug start-time end-time))
           (should (eql status 0)))
         (should (equal (string-trim (buffer-string)) "Hi"))))))
 
+(defun emacs-tests--seccomp-debug (start-time end-time)
+  "Return potentially useful debugging information for Seccomp.
+Assume that the current buffer contains subprocess output for the
+failing process.  START-TIME and END-TIME are time values between
+which the process was running."
+  ;; Add a bit of slack for the timestamps.
+  (cl-callf time-subtract start-time 5)
+  (cl-callf time-add end-time 5)
+  (with-output-to-string
+    (princ "Process output:")
+    (terpri)
+    (princ (buffer-substring-no-properties (point-min) (point-max)))
+    ;; Search audit logs for Seccomp messages.
+    (when-let ((ausearch (executable-find "ausearch")))
+      (terpri)
+      (princ "Potentially relevant Seccomp audit events:")
+      (terpri)
+      (let ((process-environment '("LC_TIME=C")))
+        (call-process ausearch nil standard-output nil
+                      "--message" "SECCOMP"
+                      "--start"
+                      (format-time-string "%D" start-time)
+                      (format-time-string "%T" start-time)
+                      "--end"
+                      (format-time-string "%D" end-time)
+                      (format-time-string "%T" end-time)
+                      "--interpret")))
+    ;; Print coredump information if available.
+    (when-let ((coredumpctl (executable-find "coredumpctl")))
+      (terpri)
+      (princ "Potentially useful coredump information:")
+      (terpri)
+      (call-process coredumpctl nil standard-output nil
+                    "info"
+                    "--since" (format-time-string "%F %T" start-time)
+                    "--until" (format-time-string "%F %T" end-time)
+                    "--no-pager"))))
+
 ;;; emacs-tests.el ends here
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 7f193d4eeab..b989c97fe6b 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -1,4 +1,4 @@
-;;; unit tests for src/fileio.c      -*- lexical-binding: t; -*-
+;;; fileio-tests.el --- unit tests for src/fileio.c      -*- lexical-binding: t; -*-
 
 ;; Copyright 2017-2021 Free Software Foundation, Inc.
 
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 0e1ca76fd9c..fc7bc7441b7 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -1,4 +1,4 @@
-;;; threads.el --- tests for threads. -*- lexical-binding: t -*-
+;;; thread-tests.el --- tests for threads. -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
 
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index e55bd1eb4ee..0a450a7573f 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -1,4 +1,4 @@
-;;; timefns-tests.el -- tests for timefns.c -*- lexical-binding: t -*-
+;;; timefns-tests.el --- tests for timefns.c -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2016-2021 Free Software Foundation, Inc.