From 061de95d5951642d19cc9445ddbe063e1e2019bb Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 11 Jul 2022 13:19:48 +0200 Subject: [PATCH] Don't call home from test/src/process-tests.el * 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 | 64 ++++++++++++++++++++++++++++ test/src/process-tests.el | 29 ------------- 2 files changed, 64 insertions(+), 29 deletions(-) create mode 100644 test/manual/process-callout-tests.el diff --git a/test/manual/process-callout-tests.el b/test/manual/process-callout-tests.el new file mode 100644 index 00000000000..0bb960cf909 --- /dev/null +++ b/test/manual/process-callout-tests.el @@ -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 . + +;;; 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 diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 824c6da1191..f1ed7e18d5b 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -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))) -- 2.39.5