Move netrc tests to auth-source-tests.el

This commit is contained in:
Lars Ingebrigtsen 2022-08-04 17:33:34 +02:00
parent 8810330f30
commit cdaddc4d72
5 changed files with 25 additions and 67 deletions

View file

@ -27,7 +27,7 @@
;;; Code:
(require 'ert)
(eval-when-compile (require 'ert-x))
(require 'ert-x)
(require 'cl-lib)
(require 'auth-source)
(require 'secrets)
@ -410,5 +410,29 @@ machine c1 port c2 user c3 password c4\n"
;; this is actually the same as `auth-source-search'.
(should (equal found expected)))))
(ert-deftest test-netrc-credentials ()
(let ((data (auth-source-netrc-parse-all (ert-resource-file "authinfo"))))
(should data)
(let ((imap (seq-find (lambda (elem)
(equal (cdr (assoc "machine" elem))
"imap.example.org"))
data)))
(should (equal (cdr (assoc "login" imap)) "jrh@example.org"))
(should (equal (cdr (assoc "password" imap)) "*foobar*")))
(let ((imap (seq-find (lambda (elem)
(equal (cdr (assoc "machine" elem))
"ftp.example.org"))
data)))
(should (equal (cdr (assoc "login" imap)) "jrh"))
(should (equal (cdr (assoc "password" imap)) "*baz*")))))
(ert-deftest test-netrc-credentials-2 ()
(let ((data (auth-source-netrc-parse-all
(ert-resource-file "netrc-folding"))))
(should
(equal data
'((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
(("machine" . "YM") ("login" . "YL") ("password" . "YP")))))))
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here

View file

@ -1,6 +0,0 @@
tcpmux 1/tcp # TCP port service multiplexer
smtp 25/tcp mail
http 80/tcp www # WorldWideWeb HTTP
kerberos 88/tcp kerberos5 krb5 kerberos-sec # Kerberos v5
kerberos 88/udp kerberos5 krb5 kerberos-sec # Kerberos v5
rtmp 1/ddp # Routing Table Maintenance Protocol

View file

@ -1,60 +0,0 @@
;;; netrc-tests.el --- Tests for netrc.el -*- lexical-binding:t -*-
;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
;; 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)
(require 'ert-x)
(require 'netrc)
(ert-deftest test-netrc-parse-services ()
(let ((netrc-services-file (ert-resource-file "services")))
(should (equal (netrc-parse-services)
'(("tcpmux" 1 tcp)
("smtp" 25 tcp)
("http" 80 tcp)
("kerberos" 88 tcp)
("kerberos" 88 udp)
("rtmp" 1 ddp))))))
(ert-deftest test-netrc-find-service-name ()
(let ((netrc-services-file (ert-resource-file "services")))
(should (equal (netrc-find-service-name 25) "smtp"))
(should (equal (netrc-find-service-name 88 'udp) "kerberos"))
(should-not (netrc-find-service-name 12345))))
(ert-deftest test-netrc-credentials ()
(let ((netrc-file (ert-resource-file "authinfo")))
(should (equal (netrc-credentials "imap.example.org")
'("jrh@example.org" "*foobar*")))
(should (equal (netrc-credentials "ftp.example.org")
'("jrh" "*baz*")))))
(ert-deftest test-netrc-credentials-2 ()
(let ((netrc-file (ert-resource-file "netrc-folding")))
(should
(equal (netrc-parse netrc-file)
'((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
(("machine" . "YM")) (("login" . "YL")) (("password" . "YP")))))))
(provide 'netrc-tests)
;;; netrc-tests.el ends here