[jackhill/guix/guix.git] / tests / lint.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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 Guix 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 Guix.  If not, see <http://www.gnu.org/licenses/>.


(define-module (test-packages)
  #:use-module (guix build download)
  #:use-module (guix build-system gnu)
  #:use-module (guix packages)
  #:use-module (guix scripts lint)
  #:use-module (guix ui)
  #:use-module (gnu packages)
  #:use-module (gnu packages pkg-config)
  #:use-module (web server)
  #:use-module (web server http)
  #:use-module (web response)
  #:use-module (ice-9 threads)
  #:use-module (srfi srfi-9 gnu)
  #:use-module (srfi srfi-64))

;; Test the linter.

(define %http-server-port
  ;; TCP port to use for the stub HTTP server.
  9999)

(define %local-url
  ;; URL to use for 'home-page' tests.
  (string-append "http://localhost:" (number->string %http-server-port)
                 "/foo/bar"))

(define %http-server-socket
  ;; Socket used by the Web server.
  (catch 'system-error
    (lambda ()
      (let ((sock (socket PF_INET SOCK_STREAM 0)))
        (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
        (bind sock
              (make-socket-address AF_INET INADDR_LOOPBACK
                                   %http-server-port))
        sock))
    (lambda args
      (let ((err (system-error-errno args)))
        (format (current-error-port)
                "warning: cannot run Web server for tests: ~a~%"
                (strerror err))
        #f))))

(define (http-write server client response body)
  "Write RESPONSE."
  (let* ((response (write-response response client))
         (port     (response-port response)))
    (cond
     ((not body))                                 ;pass
     (else
      (write-response-body response body)))
    (close-port port)
    (quit #t)                                     ;exit the server thread
    (values)))

(define-server-impl stub-http-server
  ;; Stripped-down version of Guile's built-in HTTP server.
  (@@ (web server http) http-open)
  (@@ (web server http) http-read)
  http-write
  (@@ (web server http) http-close))

(define (call-with-http-server code thunk)
  "Call THUNK with an HTTP server running and returning CODE on HTTP
requests."
  (define (server-body)
    (define (handle request body)
      (values (build-response #:code code
                              #:reason-phrase "Such is life")
              "Hello, world."))

    (catch 'quit
      (lambda ()
        (run-server handle stub-http-server
                    `(#:socket ,%http-server-socket)))
      (const #t)))

  (let* ((server (make-thread server-body)))
    ;; Normally SERVER exits automatically once it has received a request.
    (thunk)))

(define-syntax-rule (with-http-server code body ...)
  (call-with-http-server code (lambda () body ...)))

\f
(test-begin "lint")

(define-syntax-rule (dummy-package name* extra-fields ...)
  (package extra-fields ... (name name*) (version "0") (source #f)
           (build-system gnu-build-system)
           (synopsis #f) (description #f)
           (home-page #f) (license #f) ))

(define (call-with-warnings thunk)
  (let ((port (open-output-string)))
    (parameterize ((guix-warning-port port))
      (thunk))
    (get-output-string port)))

(test-assert "description: not empty"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (description ""))))
                          (check-description-style pkg))))
                    "description should not be empty")))

(test-assert "description: does not start with an upper-case letter"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (description "bad description."))))
                          (check-description-style pkg))))
                    "description should start with an upper-case letter")))

(test-assert "description: may start with a digit"
  (string-null?
   (call-with-warnings
    (lambda ()
      (let ((pkg (dummy-package "x"
                                (description "2-component library."))))
        (check-description-style pkg))))))

(test-assert "description: may start with lower-case package name"
  (string-null?
   (call-with-warnings
    (lambda ()
      (let ((pkg (dummy-package "x"
                   (description "x is a dummy package."))))
        (check-description-style pkg))))))

(test-assert "description: two spaces after end of sentence"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (description "Bad. Quite bad."))))
                          (check-description-style pkg))))
                    "sentences in description should be followed by two spaces")))

(test-assert "description: end-of-sentence detection with abbreviations"
  (string-null?
   (call-with-warnings
    (lambda ()
      (let ((pkg (dummy-package "x"
                   (description
                    "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
        (check-description-style pkg))))))

(test-assert "synopsis: not empty"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis ""))))
                          (check-synopsis-style pkg))))
                    "synopsis should not be empty")))

(test-assert "synopsis: does not start with an upper-case letter"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis "bad synopsis."))))
                          (check-synopsis-style pkg))))
                    "synopsis should start with an upper-case letter")))

(test-assert "synopsis: may start with a digit"
  (string-null?
   (call-with-warnings
    (lambda ()
      (let ((pkg (dummy-package "x"
                   (synopsis "5-dimensional frobnicator"))))
        (check-synopsis-style pkg))))))

(test-assert "synopsis: ends with a period"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis "Bad synopsis."))))
                          (check-synopsis-style pkg))))
                    "no period allowed at the end of the synopsis")))

(test-assert "synopsis: ends with 'etc.'"
  (string-null? (call-with-warnings
                 (lambda ()
                   (let ((pkg (dummy-package "x"
                                (synopsis "Foo, bar, etc."))))
                     (check-synopsis-style pkg))))))

(test-assert "synopsis: starts with 'A'"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis "A bad synopŝis"))))
                          (check-synopsis-style pkg))))
                    "no article allowed at the beginning of the synopsis")))

(test-assert "synopsis: starts with 'An'"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis "An awful synopsis"))))
                        (check-synopsis-style pkg))))
                    "no article allowed at the beginning of the synopsis")))

(test-assert "synopsis: starts with 'a'"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis "a bad synopsis"))))
                        (check-synopsis-style pkg))))
                    "no article allowed at the beginning of the synopsis")))

(test-assert "synopsis: starts with 'an'"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis "an awful synopsis"))))
                        (check-synopsis-style pkg))))
                    "no article allowed at the beginning of the synopsis")))

(test-assert "synopsis: too long"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (synopsis (make-string 80 #\x)))))
                          (check-synopsis-style pkg))))
                    "synopsis should be less than 80 characters long")))

(test-assert "synopsis: start with package name"
  (->bool
   (string-contains (call-with-warnings
                      (lambda ()
                        (let ((pkg (dummy-package "x"
                                     (name "foo")
                                     (synopsis "foo, a nice package"))))
                          (check-synopsis-style pkg))))
                    "synopsis should not start with the package name")))

(test-assert "synopsis: start with package name prefix"
  (string-null?
   (call-with-warnings
    (lambda ()
      (let ((pkg (dummy-package "arb"
                   (synopsis "Arbitrary precision"))))
        (check-synopsis-style pkg))))))

(test-assert "synopsis: start with abbreviation"
  (string-null?
   (call-with-warnings
    (lambda ()
      (let ((pkg (dummy-package "uucp"
                   ;; Same problem with "APL interpreter", etc.
                   (synopsis "UUCP implementation")
                   (description "Imagine this is Taylor UUCP."))))
        (check-synopsis-style pkg))))))

(test-assert "inputs: pkg-config is probably a native input"
  (->bool
   (string-contains
     (call-with-warnings
       (lambda ()
         (let ((pkg (dummy-package "x"
                      (inputs `(("pkg-config" ,pkg-config))))))
              (check-inputs-should-be-native pkg))))
         "pkg-config should probably be a native input")))

(test-assert "patches: file names"
  (->bool
   (string-contains
     (call-with-warnings
       (lambda ()
         (let ((pkg (dummy-package "x"
                      (source
                       (origin
                        (method url-fetch)
                        (uri "someurl")
                        (sha256 "somesha")
                        (patches (list "/path/to/y.patch")))))))
              (check-patches pkg))))
     "file names of patches should start with the package name")))

(test-assert "home-page: wrong home-page"
  (->bool
   (string-contains
    (call-with-warnings
     (lambda ()
       (let ((pkg (package
                    (inherit (dummy-package "x"))
                    (home-page #f))))
         (check-home-page pkg))))
    "invalid")))

(test-assert "home-page: invalid URI"
  (->bool
   (string-contains
    (call-with-warnings
     (lambda ()
       (let ((pkg (package
                    (inherit (dummy-package "x"))
                    (home-page "foobar"))))
         (check-home-page pkg))))
    "invalid home page URL")))

(test-assert "home-page: host not found"
  (->bool
   (string-contains
    (call-with-warnings
     (lambda ()
       (let ((pkg (package
                    (inherit (dummy-package "x"))
                    (home-page "http://does-not-exist"))))
         (check-home-page pkg))))
    "domain not found")))

(test-skip (if %http-server-socket 0 1))
(test-assert "home-page: Connection refused"
  (->bool
   (string-contains
    (call-with-warnings
     (lambda ()
       (let ((pkg (package
                    (inherit (dummy-package "x"))
                    (home-page %local-url))))
         (check-home-page pkg))))
    "Connection refused")))

(test-skip (if %http-server-socket 0 1))
(test-equal "home-page: 200"
  ""
  (call-with-warnings
   (lambda ()
     (with-http-server 200
       (let ((pkg (package
                    (inherit (dummy-package "x"))
                    (home-page %local-url))))
         (check-home-page pkg))))))

(test-skip (if %http-server-socket 0 1))
(test-assert "home-page: 404"
  (->bool
   (string-contains
    (call-with-warnings
     (lambda ()
       (with-http-server 404
         (let ((pkg (package
                      (inherit (dummy-package "x"))
                      (home-page %local-url))))
           (check-home-page pkg)))))
    "not reachable: 404")))

(test-end "lint")

\f
(exit (= (test-runner-fail-count (test-runner-current)) 0))

;; Local Variables:
;; eval: (put 'with-http-server 'scheme-indent-function 1)
;; End:
Commit	Line	Data
b4f5e0e8 CR	1	;;; GNU Guix --- Functional package management for GNU
b4f5e0e8 CR	2	;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
574e847b	3	;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
b4f5e0e8 CR	4	;;;
	5	;;; This file is part of GNU Guix.
	6	;;;
	7	;;; GNU Guix is free software; you can redistribute it and/or modify it
	8	;;; under the terms of the GNU General Public License as published by
	9	;;; the Free Software Foundation; either version 3 of the License, or (at
	10	;;; your option) any later version.
	11	;;;
	12	;;; GNU Guix is distributed in the hope that it will be useful, but
	13	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	14	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	;;; GNU General Public License for more details.
	16	;;;
	17	;;; You should have received a copy of the GNU General Public License
	18	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	19
	20
	21	(define-module (test-packages)
	22	#:use-module (guix build download)
	23	#:use-module (guix build-system gnu)
	24	#:use-module (guix packages)
	25	#:use-module (guix scripts lint)
	26	#:use-module (guix ui)
	27	#:use-module (gnu packages)
	28	#:use-module (gnu packages pkg-config)
907c98ac LC	29	#:use-module (web server)
	30	#:use-module (web server http)
	31	#:use-module (web response)
	32	#:use-module (ice-9 threads)
	33	#:use-module (srfi srfi-9 gnu)
b4f5e0e8 CR	34	#:use-module (srfi srfi-64))
	35
	36	;; Test the linter.
	37
907c98ac LC	38	(define %http-server-port
	39	;; TCP port to use for the stub HTTP server.
	40	9999)
	41
	42	(define %local-url
	43	;; URL to use for 'home-page' tests.
	44	(string-append "http://localhost:" (number->string %http-server-port)
	45	"/foo/bar"))
	46
	47	(define %http-server-socket
	48	;; Socket used by the Web server.
	49	(catch 'system-error
	50	(lambda ()
	51	(let ((sock (socket PF_INET SOCK_STREAM 0)))
	52	(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
	53	(bind sock
	54	(make-socket-address AF_INET INADDR_LOOPBACK
	55	%http-server-port))
	56	sock))
	57	(lambda args
	58	(let ((err (system-error-errno args)))
	59	(format (current-error-port)
	60	"warning: cannot run Web server for tests: ~a~%"
	61	(strerror err))
	62	#f))))
	63
	64	(define (http-write server client response body)
	65	"Write RESPONSE."
	66	(let* ((response (write-response response client))
	67	(port (response-port response)))
	68	(cond
	69	((not body)) ;pass
	70	(else
	71	(write-response-body response body)))
	72	(close-port port)
	73	(quit #t) ;exit the server thread
	74	(values)))
	75
	76	(define-server-impl stub-http-server
	77	;; Stripped-down version of Guile's built-in HTTP server.
	78	(@@ (web server http) http-open)
	79	(@@ (web server http) http-read)
	80	http-write
	81	(@@ (web server http) http-close))
	82
	83	(define (call-with-http-server code thunk)
	84	"Call THUNK with an HTTP server running and returning CODE on HTTP
	85	requests."
	86	(define (server-body)
	87	(define (handle request body)
	88	(values (build-response #:code code
	89	#:reason-phrase "Such is life")
	90	"Hello, world."))
	91
	92	(catch 'quit
	93	(lambda ()
	94	(run-server handle stub-http-server
	95	`(#:socket ,%http-server-socket)))
	96	(const #t)))
	97
	98	(let* ((server (make-thread server-body)))
	99	;; Normally SERVER exits automatically once it has received a request.
	100	(thunk)))
	101
102	(define-syntax-rule (with-http-server code body ...)
103	(call-with-http-server code (lambda () body ...)))
104
b4f5e0e8 CR	105	\f
	106	(test-begin "lint")
	107
	108	(define-syntax-rule (dummy-package name* extra-fields ...)
	109	(package extra-fields ... (name name*) (version "0") (source #f)
	110	(build-system gnu-build-system)
	111	(synopsis #f) (description #f)
	112	(home-page #f) (license #f) ))
	113
	114	(define (call-with-warnings thunk)
b002e9d0 LC	115	(let ((port (open-output-string)))
	116	(parameterize ((guix-warning-port port))
	117	(thunk))
	118	(get-output-string port)))
b4f5e0e8	119
334c43e3 EB	120	(test-assert "description: not empty"
	121	(->bool
	122	(string-contains (call-with-warnings
	123	(lambda ()
	124	(let ((pkg (dummy-package "x"
	125	(description ""))))
	126	(check-description-style pkg))))
	127	"description should not be empty")))
	128
8202a513 CR	129	(test-assert "description: does not start with an upper-case letter"
	130	(->bool
	131	(string-contains (call-with-warnings
	132	(lambda ()
	133	(let ((pkg (dummy-package "x"
	134	(description "bad description."))))
	135	(check-description-style pkg))))
	136	"description should start with an upper-case letter")))
	137
903581f9	138	(test-assert "description: may start with a digit"
b1e66683 LC	139	(string-null?
	140	(call-with-warnings
	141	(lambda ()
	142	(let ((pkg (dummy-package "x"
	143	(description "2-component library."))))
	144	(check-description-style pkg))))))
903581f9	145
3c42965b	146	(test-assert "description: may start with lower-case package name"
b1e66683 LC	147	(string-null?
	148	(call-with-warnings
	149	(lambda ()
	150	(let ((pkg (dummy-package "x"
	151	(description "x is a dummy package."))))
	152	(check-description-style pkg))))))
3c42965b	153
574e847b EB	154	(test-assert "description: two spaces after end of sentence"
	155	(->bool
	156	(string-contains (call-with-warnings
	157	(lambda ()
	158	(let ((pkg (dummy-package "x"
	159	(description "Bad. Quite bad."))))
	160	(check-description-style pkg))))
	161	"sentences in description should be followed by two spaces")))
	162
	163	(test-assert "description: end-of-sentence detection with abbreviations"
b1e66683 LC	164	(string-null?
	165	(call-with-warnings
	166	(lambda ()
	167	(let ((pkg (dummy-package "x"
	168	(description
	169	"E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
	170	(check-description-style pkg))))))
574e847b EB	171
	172	(test-assert "synopsis: not empty"
	173	(->bool
	174	(string-contains (call-with-warnings
	175	(lambda ()
	176	(let ((pkg (dummy-package "x"
	177	(synopsis ""))))
	178	(check-synopsis-style pkg))))
	179	"synopsis should not be empty")))
	180
8202a513 CR	181	(test-assert "synopsis: does not start with an upper-case letter"
	182	(->bool
	183	(string-contains (call-with-warnings
	184	(lambda ()
	185	(let ((pkg (dummy-package "x"
	186	(synopsis "bad synopsis."))))
	187	(check-synopsis-style pkg))))
	188	"synopsis should start with an upper-case letter")))
	189
903581f9	190	(test-assert "synopsis: may start with a digit"
b1e66683 LC	191	(string-null?
	192	(call-with-warnings
	193	(lambda ()
	194	(let ((pkg (dummy-package "x"
	195	(synopsis "5-dimensional frobnicator"))))
	196	(check-synopsis-style pkg))))))
903581f9	197
b4f5e0e8 CR	198	(test-assert "synopsis: ends with a period"
	199	(->bool
	200	(string-contains (call-with-warnings
	201	(lambda ()
	202	(let ((pkg (dummy-package "x"
	203	(synopsis "Bad synopsis."))))
	204	(check-synopsis-style pkg))))
	205	"no period allowed at the end of the synopsis")))
	206
	207	(test-assert "synopsis: ends with 'etc.'"
b1e66683 LC	208	(string-null? (call-with-warnings
	209	(lambda ()
	210	(let ((pkg (dummy-package "x"
	211	(synopsis "Foo, bar, etc."))))
	212	(check-synopsis-style pkg))))))
b4f5e0e8 CR	213
	214	(test-assert "synopsis: starts with 'A'"
	215	(->bool
	216	(string-contains (call-with-warnings
	217	(lambda ()
	218	(let ((pkg (dummy-package "x"
	219	(synopsis "A bad synopŝis"))))
	220	(check-synopsis-style pkg))))
	221	"no article allowed at the beginning of the synopsis")))
	222
	223	(test-assert "synopsis: starts with 'An'"
	224	(->bool
	225	(string-contains (call-with-warnings
	226	(lambda ()
	227	(let ((pkg (dummy-package "x"
	228	(synopsis "An awful synopsis"))))
	229	(check-synopsis-style pkg))))
	230	"no article allowed at the beginning of the synopsis")))
	231
a00ffdaa CR	232	(test-assert "synopsis: starts with 'a'"
	233	(->bool
	234	(string-contains (call-with-warnings
	235	(lambda ()
	236	(let ((pkg (dummy-package "x"
	237	(synopsis "a bad synopsis"))))
	238	(check-synopsis-style pkg))))
	239	"no article allowed at the beginning of the synopsis")))
	240
	241	(test-assert "synopsis: starts with 'an'"
	242	(->bool
	243	(string-contains (call-with-warnings
	244	(lambda ()
	245	(let ((pkg (dummy-package "x"
	246	(synopsis "an awful synopsis"))))
	247	(check-synopsis-style pkg))))
	248	"no article allowed at the beginning of the synopsis")))
	249
5622953d CR	250	(test-assert "synopsis: too long"
	251	(->bool
	252	(string-contains (call-with-warnings
	253	(lambda ()
	254	(let ((pkg (dummy-package "x"
	255	(synopsis (make-string 80 #\x)))))
	256	(check-synopsis-style pkg))))
	257	"synopsis should be less than 80 characters long")))
	258
3c762a13 CR	259	(test-assert "synopsis: start with package name"
	260	(->bool
	261	(string-contains (call-with-warnings
	262	(lambda ()
	263	(let ((pkg (dummy-package "x"
	264	(name "foo")
	265	(synopsis "foo, a nice package"))))
	266	(check-synopsis-style pkg))))
	267	"synopsis should not start with the package name")))
	268
17854ef9 LC	269	(test-assert "synopsis: start with package name prefix"
	270	(string-null?
	271	(call-with-warnings
	272	(lambda ()
	273	(let ((pkg (dummy-package "arb"
	274	(synopsis "Arbitrary precision"))))
	275	(check-synopsis-style pkg))))))
	276
15a6d433 LC	277	(test-assert "synopsis: start with abbreviation"
	278	(string-null?
	279	(call-with-warnings
	280	(lambda ()
	281	(let ((pkg (dummy-package "uucp"
	282	;; Same problem with "APL interpreter", etc.
	283	(synopsis "UUCP implementation")
	284	(description "Imagine this is Taylor UUCP."))))
	285	(check-synopsis-style pkg))))))
	286
b4f5e0e8 CR	287	(test-assert "inputs: pkg-config is probably a native input"
	288	(->bool
	289	(string-contains
	290	(call-with-warnings
	291	(lambda ()
	292	(let ((pkg (dummy-package "x"
	293	(inputs `(("pkg-config" ,pkg-config))))))
	294	(check-inputs-should-be-native pkg))))
	295	"pkg-config should probably be a native input")))
	296
	297	(test-assert "patches: file names"
	298	(->bool
	299	(string-contains
	300	(call-with-warnings
	301	(lambda ()
	302	(let ((pkg (dummy-package "x"
	303	(source
	304	(origin
	305	(method url-fetch)
	306	(uri "someurl")
	307	(sha256 "somesha")
	308	(patches (list "/path/to/y.patch")))))))
	309	(check-patches pkg))))
907c98ac LC	310	"file names of patches should start with the package name")))
	311
	312	(test-assert "home-page: wrong home-page"
	313	(->bool
	314	(string-contains
	315	(call-with-warnings
	316	(lambda ()
	317	(let ((pkg (package
	318	(inherit (dummy-package "x"))
	319	(home-page #f))))
	320	(check-home-page pkg))))
	321	"invalid")))
	322
	323	(test-assert "home-page: invalid URI"
	324	(->bool
	325	(string-contains
	326	(call-with-warnings
	327	(lambda ()
	328	(let ((pkg (package
	329	(inherit (dummy-package "x"))
	330	(home-page "foobar"))))
	331	(check-home-page pkg))))
	332	"invalid home page URL")))
	333
	334	(test-assert "home-page: host not found"
	335	(->bool
	336	(string-contains
	337	(call-with-warnings
	338	(lambda ()
	339	(let ((pkg (package
	340	(inherit (dummy-package "x"))
	341	(home-page "http://does-not-exist"))))
	342	(check-home-page pkg))))
	343	"domain not found")))
	344
	345	(test-skip (if %http-server-socket 0 1))
	346	(test-assert "home-page: Connection refused"
	347	(->bool
	348	(string-contains
	349	(call-with-warnings
	350	(lambda ()
	351	(let ((pkg (package
	352	(inherit (dummy-package "x"))
	353	(home-page %local-url))))
	354	(check-home-page pkg))))
	355	"Connection refused")))
	356
	357	(test-skip (if %http-server-socket 0 1))
	358	(test-equal "home-page: 200"
	359	""
	360	(call-with-warnings
	361	(lambda ()
	362	(with-http-server 200
	363	(let ((pkg (package
	364	(inherit (dummy-package "x"))
	365	(home-page %local-url))))
	366	(check-home-page pkg))))))
	367
	368	(test-skip (if %http-server-socket 0 1))
	369	(test-assert "home-page: 404"
	370	(->bool
	371	(string-contains
	372	(call-with-warnings
	373	(lambda ()
374	(with-http-server 404
375	(let ((pkg (package
376	(inherit (dummy-package "x"))
377	(home-page %local-url))))
378	(check-home-page pkg)))))
379	"not reachable: 404")))
b4f5e0e8 CR	380
	381	(test-end "lint")
	382
	383	\f
	384	(exit (= (test-runner-fail-count (test-runner-current)) 0))
907c98ac LC	385
	386	;; Local Variables:
	387	;; eval: (put 'with-http-server 'scheme-indent-function 1)
	388	;; End: