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

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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-channels)
  #:use-module (guix channels)
  #:use-module (guix profiles)
  #:use-module ((guix build syscalls) #:select (mkdtemp!))
  #:use-module (guix tests)
  #:use-module (guix store)
  #:use-module ((guix grafts) #:select (%graft?))
  #:use-module (guix derivations)
  #:use-module (guix sets)
  #:use-module (guix gexp)
  #:use-module ((guix utils)
                #:select (error-location? error-location location-line))
  #:use-module ((guix build utils) #:select (which))
  #:use-module (git)
  #:use-module (guix git)
  #:use-module (guix tests git)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(test-begin "channels")

(define* (make-instance #:key
                        (name 'fake)
                        (commit "cafebabe")
                        (spec #f))
  (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
  (when spec
    (call-with-output-file (string-append instance-dir "/.guix-channel")
      (lambda (port) (write spec port))))
  (checkout->channel-instance instance-dir
                              #:commit commit
                              #:name name))

(define instance--boring (make-instance))
(define instance--unsupported-version
  (make-instance #:spec
                 '(channel (version 42) (dependencies whatever))))
(define instance--no-deps
  (make-instance #:spec
                 '(channel (version 0))))
(define instance--sub-directory
  (make-instance #:spec
                 '(channel (version 0) (directory "modules"))))
(define instance--simple
  (make-instance #:spec
                 '(channel
                   (version 0)
                   (dependencies
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel"))))))
(define instance--with-dupes
  (make-instance #:spec
                 '(channel
                   (version 0)
                   (dependencies
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel"))
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel")
                     (commit "abc1234"))
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel-elsewhere"))))))

(define channel-instance-metadata
  (@@ (guix channels) channel-instance-metadata))
(define channel-metadata-directory
  (@@ (guix channels) channel-metadata-directory))
(define channel-metadata-dependencies
  (@@ (guix channels) channel-metadata-dependencies))

\f
(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
  '("/" ())
  (let ((metadata (channel-instance-metadata instance--boring)))
    (list (channel-metadata-directory metadata)
          (channel-metadata-dependencies metadata))))

(test-equal "channel-instance-metadata and default dependencies"
  '()
  (channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))

(test-equal "channel-instance-metadata and directory"
  "/modules"
  (channel-metadata-directory
   (channel-instance-metadata instance--sub-directory)))

(test-equal "channel-instance-metadata rejects unsupported version"
  1                              ;line number in the generated '.guix-channel'
  (guard (c ((and (message-condition? c) (error-location? c))
             (location-line (error-location c))))
    (channel-instance-metadata instance--unsupported-version)))

(test-assert "channel-instance-metadata returns <channel-metadata>"
  (every (@@ (guix channels) channel-metadata?)
         (map channel-instance-metadata
              (list instance--no-deps
                    instance--simple
                    instance--with-dupes))))

(test-assert "channel-instance-metadata dependencies are channels"
  (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
               (channel-instance-metadata instance--simple))))
    (match deps
      (((? channel? dep)) #t)
      (_ #f))))

(test-assert "latest-channel-instances includes channel dependencies"
  (let* ((channel (channel
                   (name 'test)
                   (url "test")))
         (test-dir (channel-instance-checkout instance--simple)))
    (mock ((guix git) update-cached-checkout
           (lambda* (url #:key ref starting-commit)
             (match url
               ("test" (values test-dir "caf3cabba9e" #f))
               (_      (values (channel-instance-checkout instance--no-deps)
                               "abcde1234" #f)))))
          (with-store store
            (let ((instances (latest-channel-instances store (list channel))))
              (and (eq? 2 (length instances))
                   (lset= eq?
                          '(test test-channel)
                          (map (compose channel-name channel-instance-channel)
                               instances))))))))

(test-assert "latest-channel-instances excludes duplicate channel dependencies"
  (let* ((channel (channel
                   (name 'test)
                   (url "test")))
         (test-dir (channel-instance-checkout instance--with-dupes)))
    (mock ((guix git) update-cached-checkout
           (lambda* (url #:key ref starting-commit)
             (match url
               ("test" (values test-dir "caf3cabba9e" #f))
               (_      (values (channel-instance-checkout instance--no-deps)
                               "abcde1234" #f)))))
          (with-store store
            (let ((instances (latest-channel-instances store (list channel))))
              (and (= 2 (length instances))
                   (lset= eq?
                          '(test test-channel)
                          (map (compose channel-name channel-instance-channel)
                               instances))
                   ;; only the most specific channel dependency should remain,
                   ;; i.e. the one with a specified commit.
                   (find (lambda (instance)
                           (and (eq? (channel-name
                                      (channel-instance-channel instance))
                                     'test-channel)
                                (string=? (channel-commit
                                           (channel-instance-channel instance))
                                          "abc1234")))
                         instances)))))))

(test-assert "channel-instances->manifest"
  ;; Compute the manifest for a graph of instances and make sure we get a
  ;; derivation graph that mirrors the instance graph.  This test also ensures
  ;; we don't try to access Git repositores at all at this stage.
  (let* ((spec      (lambda deps
                      `(channel (version 0)
                                (dependencies
                                 ,@(map (lambda (dep)
                                          `(channel
                                            (name ,dep)
                                            (url "http://example.org")))
                                        deps)))))
         (guix      (make-instance #:name 'guix))
         (instance0 (make-instance #:name 'a))
         (instance1 (make-instance #:name 'b #:spec (spec 'a)))
         (instance2 (make-instance #:name 'c #:spec (spec 'b)))
         (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
    (%graft? #f)                                    ;don't try to build stuff

    ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
    (let ((source (channel-instance-checkout guix)))
      (mkdir (string-append source "/build-aux"))
      (call-with-output-file (string-append source
                                            "/build-aux/build-self.scm")
        (lambda (port)
          (write '(begin
                    (use-modules (guix) (gnu packages bootstrap))

                    (lambda _
                      (package->derivation %bootstrap-guile)))
                 port))))

    (with-store store
      (let ()
        (define manifest
          (run-with-store store
            (channel-instances->manifest (list guix
                                               instance0 instance1
                                               instance2 instance3))))

        (define entries
          (manifest-entries manifest))

        (define (depends? drv in out)
          ;; Return true if DRV depends (directly or indirectly) on all of IN
          ;; and none of OUT.
          (let ((set (list->set
                      (requisites store
                                  (list (derivation-file-name drv)))))
                (in  (map derivation-file-name in))
                (out (map derivation-file-name out)))
            (and (every (cut set-contains? set <>) in)
                 (not (any (cut set-contains? set <>) out)))))

        (define (lookup name)
          (run-with-store store
            (lower-object
             (manifest-entry-item
              (manifest-lookup manifest
                               (manifest-pattern (name name)))))))

        (let ((drv-guix (lookup "guix"))
              (drv0     (lookup "a"))
              (drv1     (lookup "b"))
              (drv2     (lookup "c"))
              (drv3     (lookup "d")))
          (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
               (depends? drv0
                         (list) (list drv1 drv2 drv3))
               (depends? drv1
                         (list drv0) (list drv2 drv3))
               (depends? drv2
                         (list drv1) (list drv3))
               (depends? drv3
                         (list drv2 drv0) (list))))))))

(unless (which (git-command)) (test-skip 1))
(test-equal "channel-news, no news"
  '()
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "the commit"))
    (with-repository directory repository
      (let ((channel (channel (url (string-append "file://" directory))
                              (name 'foo)))
            (latest  (reference-name->oid repository "HEAD")))
        (channel-news-for-commit channel (oid->string latest))))))

(unless (which (git-command)) (test-skip 1))
(test-assert "channel-news, one entry"
  (with-temporary-git-repository directory
      `((add ".guix-channel"
             ,(object->string
               '(channel (version 0)
                         (news-file "news.scm"))))
        (commit "first commit")
        (add "src/a.txt" "A")
        (commit "second commit")
        (tag "tag-for-first-news-entry")
        (add "news.scm"
             ,(lambda (repository)
                (let ((previous
                       (reference-name->oid repository "HEAD")))
                  (object->string
                   `(channel-news
                     (version 0)
                     (entry (commit ,(oid->string previous))
                            (title (en "New file!")
                                   (eo "Nova dosiero!"))
                            (body (en "Yeah, a.txt."))))))))
        (commit "third commit")
        (add "src/b.txt" "B")
        (commit "fourth commit")
        (add "news.scm"
             ,(lambda (repository)
                (let ((second
                       (commit-id
                        (find-commit repository "second commit")))
                      (previous
                       (reference-name->oid repository "HEAD")))
                  (object->string
                   `(channel-news
                     (version 0)
                     (entry (commit ,(oid->string previous))
                            (title (en "Another file!"))
                            (body (en "Yeah, b.txt.")))
                     (entry (tag "tag-for-first-news-entry")
                            (title (en "Old news.")
                                   (eo "Malnovaĵoj."))
                            (body (en "For a.txt"))))))))
        (commit "fifth commit"))
    (with-repository directory repository
      (define (find-commit* message)
        (oid->string (commit-id (find-commit repository message))))

      (let ((channel (channel (url (string-append "file://" directory))
                              (name 'foo)))
            (commit1 (find-commit* "first commit"))
            (commit2 (find-commit* "second commit"))
            (commit3 (find-commit* "third commit"))
            (commit4 (find-commit* "fourth commit"))
            (commit5 (find-commit* "fifth commit")))
        ;; First try fetching all the news up to a given commit.
        (and (null? (channel-news-for-commit channel commit2))
             (lset= string=?
                    (map channel-news-entry-commit
                         (channel-news-for-commit channel commit5))
                    (list commit2 commit4))
             (lset= equal?
                    (map channel-news-entry-title
                         (channel-news-for-commit channel commit5))
                    '((("en" . "Another file!"))
                      (("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
             (lset= string=?
                    (map channel-news-entry-commit
                         (channel-news-for-commit channel commit3))
                    (list commit2))

             ;; Now fetch news entries that apply to a commit range.
             (lset= string=?
                    (map channel-news-entry-commit
                         (channel-news-for-commit channel commit3 commit1))
                    (list commit2))
             (lset= string=?
                    (map channel-news-entry-commit
                         (channel-news-for-commit channel commit5 commit3))
                    (list commit4))
             (lset= string=?
                    (map channel-news-entry-commit
                         (channel-news-for-commit channel commit5 commit1))
                    (list commit4 commit2))
             (lset= equal?
                    (map channel-news-entry-tag
                         (channel-news-for-commit channel commit5 commit1))
                    '(#f "tag-for-first-news-entry")))))))

(test-end "channels")
Commit	Line	Data
af12790b RW	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (test-channels)
	20	#:use-module (guix channels)
ed75bdf3	21	#:use-module (guix profiles)
af12790b RW	22	#:use-module ((guix build syscalls) #:select (mkdtemp!))
af12790b RW	23	#:use-module (guix tests)
ed75bdf3 LC	24	#:use-module (guix store)
	25	#:use-module ((guix grafts) #:select (%graft?))
	26	#:use-module (guix derivations)
1fafc383	27	#:use-module (guix sets)
ed75bdf3	28	#:use-module (guix gexp)
45b90332 LC	29	#:use-module ((guix utils)
45b90332 LC	30	#:select (error-location? error-location location-line))
8ba7fd3c LC	31	#:use-module ((guix build utils) #:select (which))
	32	#:use-module (git)
	33	#:use-module (guix git)
	34	#:use-module (guix tests git)
af12790b	35	#:use-module (srfi srfi-1)
ed75bdf3	36	#:use-module (srfi srfi-26)
45b90332 LC	37	#:use-module (srfi srfi-34)
45b90332 LC	38	#:use-module (srfi srfi-35)
af12790b RW	39	#:use-module (srfi srfi-64)
	40	#:use-module (ice-9 match))
	41
	42	(test-begin "channels")
	43
	44	(define* (make-instance #:key
	45	(name 'fake)
	46	(commit "cafebabe")
	47	(spec #f))
	48	(define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
ce5d9ec8 LC	49	(when spec
	50	(call-with-output-file (string-append instance-dir "/.guix-channel")
	51	(lambda (port) (write spec port))))
ed75bdf3 LC	52	(checkout->channel-instance instance-dir
	53	#:commit commit
	54	#:name name))
af12790b RW	55
af12790b RW	56	(define instance--boring (make-instance))
45b90332 LC	57	(define instance--unsupported-version
	58	(make-instance #:spec
	59	'(channel (version 42) (dependencies whatever))))
af12790b RW	60	(define instance--no-deps
af12790b RW	61	(make-instance #:spec
ce5d9ec8 LC	62	'(channel (version 0))))
	63	(define instance--sub-directory
	64	(make-instance #:spec
	65	'(channel (version 0) (directory "modules"))))
af12790b RW	66	(define instance--simple
	67	(make-instance #:spec
	68	'(channel
	69	(version 0)
	70	(dependencies
	71	(channel
	72	(name test-channel)
	73	(url "https://example.com/test-channel"))))))
	74	(define instance--with-dupes
	75	(make-instance #:spec
	76	'(channel
	77	(version 0)
	78	(dependencies
	79	(channel
	80	(name test-channel)
	81	(url "https://example.com/test-channel"))
	82	(channel
	83	(name test-channel)
	84	(url "https://example.com/test-channel")
	85	(commit "abc1234"))
	86	(channel
	87	(name test-channel)
	88	(url "https://example.com/test-channel-elsewhere"))))))
	89
45b90332 LC	90	(define channel-instance-metadata
45b90332 LC	91	(@@ (guix channels) channel-instance-metadata))
ce5d9ec8 LC	92	(define channel-metadata-directory
	93	(@@ (guix channels) channel-metadata-directory))
	94	(define channel-metadata-dependencies
	95	(@@ (guix channels) channel-metadata-dependencies))
af12790b RW	96
af12790b RW	97	\f
ce5d9ec8 LC	98	(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
	99	'("/" ())
	100	(let ((metadata (channel-instance-metadata instance--boring)))
	101	(list (channel-metadata-directory metadata)
	102	(channel-metadata-dependencies metadata))))
	103
	104	(test-equal "channel-instance-metadata and default dependencies"
	105	'()
	106	(channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
	107
	108	(test-equal "channel-instance-metadata and directory"
	109	"/modules"
	110	(channel-metadata-directory
	111	(channel-instance-metadata instance--sub-directory)))
45b90332 LC	112
	113	(test-equal "channel-instance-metadata rejects unsupported version"
	114	1 ;line number in the generated '.guix-channel'
	115	(guard (c ((and (message-condition? c) (error-location? c))
	116	(location-line (error-location c))))
	117	(channel-instance-metadata instance--unsupported-version)))
af12790b	118
45b90332	119	(test-assert "channel-instance-metadata returns <channel-metadata>"
af12790b	120	(every (@@ (guix channels) channel-metadata?)
45b90332	121	(map channel-instance-metadata
af12790b RW	122	(list instance--no-deps
	123	instance--simple
	124	instance--with-dupes))))
	125
45b90332	126	(test-assert "channel-instance-metadata dependencies are channels"
af12790b	127	(let ((deps ((@@ (guix channels) channel-metadata-dependencies)
45b90332	128	(channel-instance-metadata instance--simple))))
af12790b RW	129	(match deps
	130	(((? channel? dep)) #t)
	131	(_ #f))))
	132
	133	(test-assert "latest-channel-instances includes channel dependencies"
	134	(let* ((channel (channel
	135	(name 'test)
	136	(url "test")))
	137	(test-dir (channel-instance-checkout instance--simple)))
053b10c3	138	(mock ((guix git) update-cached-checkout
8d1d5657	139	(lambda* (url #:key ref starting-commit)
af12790b	140	(match url
8d1d5657	141	("test" (values test-dir "caf3cabba9e" #f))
053b10c3	142	(_ (values (channel-instance-checkout instance--no-deps)
8d1d5657	143	"abcde1234" #f)))))
053b10c3 LC	144	(with-store store
	145	(let ((instances (latest-channel-instances store (list channel))))
	146	(and (eq? 2 (length instances))
	147	(lset= eq?
	148	'(test test-channel)
	149	(map (compose channel-name channel-instance-channel)
	150	instances))))))))
af12790b RW	151
	152	(test-assert "latest-channel-instances excludes duplicate channel dependencies"
	153	(let* ((channel (channel
	154	(name 'test)
	155	(url "test")))
	156	(test-dir (channel-instance-checkout instance--with-dupes)))
053b10c3	157	(mock ((guix git) update-cached-checkout
8d1d5657	158	(lambda* (url #:key ref starting-commit)
af12790b	159	(match url
8d1d5657	160	("test" (values test-dir "caf3cabba9e" #f))
053b10c3	161	(_ (values (channel-instance-checkout instance--no-deps)
8d1d5657	162	"abcde1234" #f)))))
053b10c3 LC	163	(with-store store
	164	(let ((instances (latest-channel-instances store (list channel))))
	165	(and (= 2 (length instances))
	166	(lset= eq?
	167	'(test test-channel)
	168	(map (compose channel-name channel-instance-channel)
	169	instances))
	170	;; only the most specific channel dependency should remain,
	171	;; i.e. the one with a specified commit.
	172	(find (lambda (instance)
	173	(and (eq? (channel-name
	174	(channel-instance-channel instance))
	175	'test-channel)
	176	(string=? (channel-commit
	177	(channel-instance-channel instance))
	178	"abc1234")))
	179	instances)))))))
af12790b	180
ed75bdf3 LC	181	(test-assert "channel-instances->manifest"
	182	;; Compute the manifest for a graph of instances and make sure we get a
	183	;; derivation graph that mirrors the instance graph. This test also ensures
	184	;; we don't try to access Git repositores at all at this stage.
	185	(let* ((spec (lambda deps
	186	`(channel (version 0)
	187	(dependencies
	188	,@(map (lambda (dep)
	189	`(channel
	190	(name ,dep)
	191	(url "http://example.org")))
	192	deps)))))
	193	(guix (make-instance #:name 'guix))
	194	(instance0 (make-instance #:name 'a))
	195	(instance1 (make-instance #:name 'b #:spec (spec 'a)))
	196	(instance2 (make-instance #:name 'c #:spec (spec 'b)))
	197	(instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
	198	(%graft? #f) ;don't try to build stuff
	199
	200	;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
	201	(let ((source (channel-instance-checkout guix)))
	202	(mkdir (string-append source "/build-aux"))
	203	(call-with-output-file (string-append source
	204	"/build-aux/build-self.scm")
	205	(lambda (port)
	206	(write '(begin
	207	(use-modules (guix) (gnu packages bootstrap))
	208
	209	(lambda _
	210	(package->derivation %bootstrap-guile)))
	211	port))))
	212
	213	(with-store store
	214	(let ()
	215	(define manifest
	216	(run-with-store store
	217	(channel-instances->manifest (list guix
	218	instance0 instance1
	219	instance2 instance3))))
	220
	221	(define entries
	222	(manifest-entries manifest))
	223
	224	(define (depends? drv in out)
1fafc383 LC	225	;; Return true if DRV depends (directly or indirectly) on all of IN
	226	;; and none of OUT.
	227	(let ((set (list->set
	228	(requisites store
	229	(list (derivation-file-name drv)))))
ed75bdf3 LC	230	(in (map derivation-file-name in))
ed75bdf3 LC	231	(out (map derivation-file-name out)))
1fafc383 LC	232	(and (every (cut set-contains? set <>) in)
1fafc383 LC	233	(not (any (cut set-contains? set <>) out)))))
ed75bdf3 LC	234
	235	(define (lookup name)
	236	(run-with-store store
	237	(lower-object
	238	(manifest-entry-item
	239	(manifest-lookup manifest
	240	(manifest-pattern (name name)))))))
	241
	242	(let ((drv-guix (lookup "guix"))
	243	(drv0 (lookup "a"))
	244	(drv1 (lookup "b"))
	245	(drv2 (lookup "c"))
	246	(drv3 (lookup "d")))
	247	(and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
	248	(depends? drv0
	249	(list) (list drv1 drv2 drv3))
	250	(depends? drv1
	251	(list drv0) (list drv2 drv3))
	252	(depends? drv2
1fafc383	253	(list drv1) (list drv3))
ed75bdf3	254	(depends? drv3
1fafc383	255	(list drv2 drv0) (list))))))))
ed75bdf3	256
8ba7fd3c LC	257	(unless (which (git-command)) (test-skip 1))
	258	(test-equal "channel-news, no news"
	259	'()
	260	(with-temporary-git-repository directory
	261	'((add "a.txt" "A")
	262	(commit "the commit"))
	263	(with-repository directory repository
	264	(let ((channel (channel (url (string-append "file://" directory))
	265	(name 'foo)))
	266	(latest (reference-name->oid repository "HEAD")))
	267	(channel-news-for-commit channel (oid->string latest))))))
	268
	269	(unless (which (git-command)) (test-skip 1))
	270	(test-assert "channel-news, one entry"
	271	(with-temporary-git-repository directory
	272	`((add ".guix-channel"
	273	,(object->string
	274	'(channel (version 0)
	275	(news-file "news.scm"))))
	276	(commit "first commit")
	277	(add "src/a.txt" "A")
	278	(commit "second commit")
9719e8d3	279	(tag "tag-for-first-news-entry")
8ba7fd3c LC	280	(add "news.scm"
	281	,(lambda (repository)
	282	(let ((previous
	283	(reference-name->oid repository "HEAD")))
	284	(object->string
	285	`(channel-news
	286	(version 0)
	287	(entry (commit ,(oid->string previous))
	288	(title (en "New file!")
	289	(eo "Nova dosiero!"))
	290	(body (en "Yeah, a.txt."))))))))
	291	(commit "third commit")
	292	(add "src/b.txt" "B")
	293	(commit "fourth commit")
	294	(add "news.scm"
	295	,(lambda (repository)
	296	(let ((second
	297	(commit-id
	298	(find-commit repository "second commit")))
	299	(previous
	300	(reference-name->oid repository "HEAD")))
	301	(object->string
	302	`(channel-news
	303	(version 0)
	304	(entry (commit ,(oid->string previous))
	305	(title (en "Another file!"))
	306	(body (en "Yeah, b.txt.")))
9719e8d3	307	(entry (tag "tag-for-first-news-entry")
8ba7fd3c LC	308	(title (en "Old news.")
	309	(eo "Malnovaĵoj."))
	310	(body (en "For a.txt"))))))))
	311	(commit "fifth commit"))
	312	(with-repository directory repository
	313	(define (find-commit* message)
	314	(oid->string (commit-id (find-commit repository message))))
	315
	316	(let ((channel (channel (url (string-append "file://" directory))
	317	(name 'foo)))
	318	(commit1 (find-commit* "first commit"))
	319	(commit2 (find-commit* "second commit"))
	320	(commit3 (find-commit* "third commit"))
	321	(commit4 (find-commit* "fourth commit"))
	322	(commit5 (find-commit* "fifth commit")))
	323	;; First try fetching all the news up to a given commit.
	324	(and (null? (channel-news-for-commit channel commit2))
	325	(lset= string=?
	326	(map channel-news-entry-commit
	327	(channel-news-for-commit channel commit5))
	328	(list commit2 commit4))
	329	(lset= equal?
	330	(map channel-news-entry-title
	331	(channel-news-for-commit channel commit5))
	332	'((("en" . "Another file!"))
	333	(("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
	334	(lset= string=?
	335	(map channel-news-entry-commit
	336	(channel-news-for-commit channel commit3))
	337	(list commit2))
	338
	339	;; Now fetch news entries that apply to a commit range.
	340	(lset= string=?
	341	(map channel-news-entry-commit
	342	(channel-news-for-commit channel commit3 commit1))
	343	(list commit2))
	344	(lset= string=?
	345	(map channel-news-entry-commit
	346	(channel-news-for-commit channel commit5 commit3))
	347	(list commit4))
	348	(lset= string=?
	349	(map channel-news-entry-commit
	350	(channel-news-for-commit channel commit5 commit1))
9719e8d3 LC	351	(list commit4 commit2))
	352	(lset= equal?
	353	(map channel-news-entry-tag
	354	(channel-news-for-commit channel commit5 commit1))
	355	'(#f "tag-for-first-news-entry")))))))
8ba7fd3c	356
af12790b	357	(test-end "channels")