]> git.eshelyaron.com Git - emacs.git/commitdiff
Don't call home from test/src/process-tests.el
authorLars Ingebrigtsen <larsi@gnus.org>
Mon, 11 Jul 2022 11:19:48 +0000 (13:19 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Mon, 11 Jul 2022 11:19:48 +0000 (13:19 +0200)
* test/src/process-tests.el (process-num-processors): Move from
here...
* test/manual/process-callout-tests.el: ... to here (bug#55858).

test/manual/process-callout-tests.el [new file with mode: 0644]
test/src/process-tests.el

diff --git a/test/manual/process-callout-tests.el b/test/manual/process-callout-tests.el
new file mode 100644 (file)
index 0000000..0bb960c
--- /dev/null
@@ -0,0 +1,64 @@
+;;; process-callout-tests.el --- Testing the process facilities -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 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/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+
+;;; This test is here in test/manual instead of
+;;; test/src/process-tests.el for two reasons: The test suite
+;;; shouldn't "call home" automatically, because that's against our
+;;; privacy principles, and as a practical matter, the server may have
+;;; problems, and that shouldn't trigger a test error.
+
+(ert-deftest process-async-https-with-delay ()
+  "Bug#49449: asynchronous TLS connection with delayed completion."
+  (skip-unless (and internet-is-working (gnutls-available-p)))
+  (let* ((status nil)
+         (buf (url-http
+                 #s(url "https" nil nil "elpa.gnu.org" nil
+                        "/packages/archive-contents" nil nil t silent t t)
+                 (lambda (s) (setq status s))
+                 '(nil) nil 'tls)))
+    (unwind-protect
+        (progn
+          ;; Busy-wait for 1 s to allow for the TCP connection to complete.
+          (let ((delay 1.0)
+                (t0 (float-time)))
+            (while (< (float-time) (+ t0 delay))))
+          ;; Wait for the entire operation to finish.
+          (let ((limit 4.0)
+                (t0 (float-time)))
+            (while (and (null status)
+                        (< (float-time) (+ t0 limit)))
+              (sit-for 0.1)))
+          (should status)
+          (should-not (plist-get status ':error))
+          (should buf)
+          (should (> (buffer-size buf) 0))
+          )
+      (when buf
+        (kill-buffer buf)))))
+
+;;; process-callout-tests.el ends here
index 824c6da11913a99119b84d9a84ac8d97408de071..f1ed7e18d5b7bd4766c1302b1ceffe7a9bff6f51 100644 (file)
@@ -909,35 +909,6 @@ Return nil if FILENAME doesn't exist."
       ;; ...and the change description should be "interrupt".
       (should (equal '("interrupt\n") events)))))
 
-(ert-deftest process-async-https-with-delay ()
-  "Bug#49449: asynchronous TLS connection with delayed completion."
-  (skip-unless (and internet-is-working (gnutls-available-p)))
-  (let* ((status nil)
-         (buf (url-http
-                 #s(url "https" nil nil "elpa.gnu.org" nil
-                        "/packages/archive-contents" nil nil t silent t t)
-                 (lambda (s) (setq status s))
-                 '(nil) nil 'tls)))
-    (unwind-protect
-        (progn
-          ;; Busy-wait for 1 s to allow for the TCP connection to complete.
-          (let ((delay 1.0)
-                (t0 (float-time)))
-            (while (< (float-time) (+ t0 delay))))
-          ;; Wait for the entire operation to finish.
-          (let ((limit 4.0)
-                (t0 (float-time)))
-            (while (and (null status)
-                        (< (float-time) (+ t0 limit)))
-              (sit-for 0.1)))
-          (should status)
-          (should-not (plist-get status ':error))
-          (should buf)
-          (should (> (buffer-size buf) 0))
-          )
-      (when buf
-        (kill-buffer buf)))))
-
 (ert-deftest process-num-processors ()
   "Sanity checks for num-processors."
   (should (equal (num-processors) (num-processors)))