[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>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.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 tests)
  #:use-module (guix 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 %null-sha256
  ;; SHA256 of the empty string.
  (base32
   "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))

(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)))

;; Mutex and condition variable to synchronize with the HTTP server.
(define %http-server-lock (make-mutex))
(define %http-server-ready (make-condition-variable))

(define (http-open . args)
  "Start listening for HTTP requests and signal %HTTP-SERVER-READY."
  (with-mutex %http-server-lock
    (let ((result (apply (@@ (web server http) http-open) args)))
      (signal-condition-variable %http-server-ready)
      result)))

(define-server-impl stub-http-server
  ;; Stripped-down version of Guile's built-in HTTP server.
  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)))

  (with-mutex %http-server-lock
    (let ((server (make-thread server-body)))
      (wait-condition-variable %http-server-ready %http-server-lock)
      ;; 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 (call-with-warnings thunk)
  (let ((port (open-output-string)))
    (parameterize ((guix-warning-port port))
      (thunk))
    (get-output-string port)))

(define-syntax-rule (with-warnings body ...)
  (call-with-warnings (lambda () body ...)))

(test-assert "description: not empty"
  (->bool
   (string-contains (with-warnings
                      (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 (with-warnings
                      (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?
   (with-warnings
     (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?
   (with-warnings
     (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 (with-warnings
                      (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?
   (with-warnings
     (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 (with-warnings
                      (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 (with-warnings
                      (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?
   (with-warnings
     (let ((pkg (dummy-package "x"
                  (synopsis "5-dimensional frobnicator"))))
       (check-synopsis-style pkg)))))

(test-assert "synopsis: ends with a period"
  (->bool
   (string-contains (with-warnings
                      (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? (with-warnings
                  (let ((pkg (dummy-package "x"
                               (synopsis "Foo, bar, etc."))))
                    (check-synopsis-style pkg)))))

(test-assert "synopsis: starts with 'A'"
  (->bool
   (string-contains (with-warnings
                      (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 (with-warnings
                      (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 (with-warnings
                      (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 (with-warnings
                      (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 (with-warnings
                      (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 (with-warnings
                      (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?
   (with-warnings
     (let ((pkg (dummy-package "arb"
                  (synopsis "Arbitrary precision"))))
       (check-synopsis-style pkg)))))

(test-assert "synopsis: start with abbreviation"
  (string-null?
   (with-warnings
     (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
     (with-warnings
       (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
     (with-warnings
       (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
    (with-warnings
      (let ((pkg (package
                   (inherit (dummy-package "x"))
                   (home-page #f))))
        (check-home-page pkg)))
    "invalid")))

(test-assert "home-page: invalid URI"
  (->bool
   (string-contains
    (with-warnings
      (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
    (with-warnings
      (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
    (with-warnings
      (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"
  ""
  (with-warnings
   (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
    (with-warnings
      (with-http-server 404
        (let ((pkg (package
                     (inherit (dummy-package "x"))
                     (home-page %local-url))))
          (check-home-page pkg))))
    "not reachable: 404")))

(test-skip (if %http-server-socket 0 1))
(test-equal "source: 200"
  ""
  (with-warnings
   (with-http-server 200
     (let ((pkg (package
                  (inherit (dummy-package "x"))
                  (source (origin
                            (method url-fetch)
                            (uri %local-url)
                            (sha256 %null-sha256))))))
       (check-source pkg)))))

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