[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) latest-repository-commit
           (lambda* (store url #:key ref)
             (match url
               ("test" (values test-dir 'whatever))
               (_ (values "/not-important" 'not-important)))))
          (let ((instances (latest-channel-instances #f (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) latest-repository-commit
           (lambda* (store url #:key ref)
             (match url
               ("test" (values test-dir 'whatever))
               (_ (values "/not-important" 'not-important)))))
          (let ((instances (latest-channel-instances #f (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)))
	138	(mock ((guix git) latest-repository-commit
	139	(lambda* (store url #:key ref)
	140	(match url
	141	("test" (values test-dir 'whatever))
	142	(_ (values "/not-important" 'not-important)))))
	143	(let ((instances (latest-channel-instances #f (list channel))))
	144	(and (eq? 2 (length instances))
	145	(lset= eq?
	146	'(test test-channel)
	147	(map (compose channel-name channel-instance-channel)
	148	instances)))))))
	149
	150	(test-assert "latest-channel-instances excludes duplicate channel dependencies"
	151	(let* ((channel (channel
	152	(name 'test)
	153	(url "test")))
	154	(test-dir (channel-instance-checkout instance--with-dupes)))
	155	(mock ((guix git) latest-repository-commit
	156	(lambda* (store url #:key ref)
	157	(match url
	158	("test" (values test-dir 'whatever))
	159	(_ (values "/not-important" 'not-important)))))
	160	(let ((instances (latest-channel-instances #f (list channel))))
ce5d9ec8	161	(and (= 2 (length instances))
af12790b RW	162	(lset= eq?
	163	'(test test-channel)
	164	(map (compose channel-name channel-instance-channel)
	165	instances))
	166	;; only the most specific channel dependency should remain,
	167	;; i.e. the one with a specified commit.
	168	(find (lambda (instance)
	169	(and (eq? (channel-name
	170	(channel-instance-channel instance))
	171	'test-channel)
ce5d9ec8 LC	172	(string=? (channel-commit
	173	(channel-instance-channel instance))
	174	"abc1234")))
af12790b RW	175	instances))))))
af12790b RW	176
ed75bdf3 LC	177	(test-assert "channel-instances->manifest"
	178	;; Compute the manifest for a graph of instances and make sure we get a
	179	;; derivation graph that mirrors the instance graph. This test also ensures
	180	;; we don't try to access Git repositores at all at this stage.
	181	(let* ((spec (lambda deps
	182	`(channel (version 0)
	183	(dependencies
	184	,@(map (lambda (dep)
	185	`(channel
	186	(name ,dep)
	187	(url "http://example.org")))
	188	deps)))))
	189	(guix (make-instance #:name 'guix))
	190	(instance0 (make-instance #:name 'a))
	191	(instance1 (make-instance #:name 'b #:spec (spec 'a)))
	192	(instance2 (make-instance #:name 'c #:spec (spec 'b)))
	193	(instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
	194	(%graft? #f) ;don't try to build stuff
	195
	196	;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
	197	(let ((source (channel-instance-checkout guix)))
	198	(mkdir (string-append source "/build-aux"))
	199	(call-with-output-file (string-append source
	200	"/build-aux/build-self.scm")
	201	(lambda (port)
	202	(write '(begin
	203	(use-modules (guix) (gnu packages bootstrap))
	204
	205	(lambda _
	206	(package->derivation %bootstrap-guile)))
	207	port))))
	208
	209	(with-store store
	210	(let ()
	211	(define manifest
	212	(run-with-store store
	213	(channel-instances->manifest (list guix
	214	instance0 instance1
	215	instance2 instance3))))
	216
	217	(define entries
	218	(manifest-entries manifest))
	219
	220	(define (depends? drv in out)
1fafc383 LC	221	;; Return true if DRV depends (directly or indirectly) on all of IN
	222	;; and none of OUT.
	223	(let ((set (list->set
	224	(requisites store
	225	(list (derivation-file-name drv)))))
ed75bdf3 LC	226	(in (map derivation-file-name in))
ed75bdf3 LC	227	(out (map derivation-file-name out)))
1fafc383 LC	228	(and (every (cut set-contains? set <>) in)
1fafc383 LC	229	(not (any (cut set-contains? set <>) out)))))
ed75bdf3 LC	230
	231	(define (lookup name)
	232	(run-with-store store
	233	(lower-object
	234	(manifest-entry-item
	235	(manifest-lookup manifest
	236	(manifest-pattern (name name)))))))
	237
	238	(let ((drv-guix (lookup "guix"))
	239	(drv0 (lookup "a"))
	240	(drv1 (lookup "b"))
	241	(drv2 (lookup "c"))
	242	(drv3 (lookup "d")))
	243	(and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
	244	(depends? drv0
	245	(list) (list drv1 drv2 drv3))
	246	(depends? drv1
	247	(list drv0) (list drv2 drv3))
	248	(depends? drv2
1fafc383	249	(list drv1) (list drv3))
ed75bdf3	250	(depends? drv3
1fafc383	251	(list drv2 drv0) (list))))))))
ed75bdf3	252
8ba7fd3c LC	253	(unless (which (git-command)) (test-skip 1))
	254	(test-equal "channel-news, no news"
	255	'()
	256	(with-temporary-git-repository directory
	257	'((add "a.txt" "A")
	258	(commit "the commit"))
	259	(with-repository directory repository
	260	(let ((channel (channel (url (string-append "file://" directory))
	261	(name 'foo)))
	262	(latest (reference-name->oid repository "HEAD")))
	263	(channel-news-for-commit channel (oid->string latest))))))
	264
	265	(unless (which (git-command)) (test-skip 1))
	266	(test-assert "channel-news, one entry"
	267	(with-temporary-git-repository directory
	268	`((add ".guix-channel"
	269	,(object->string
	270	'(channel (version 0)
	271	(news-file "news.scm"))))
	272	(commit "first commit")
	273	(add "src/a.txt" "A")
	274	(commit "second commit")
9719e8d3	275	(tag "tag-for-first-news-entry")
8ba7fd3c LC	276	(add "news.scm"
	277	,(lambda (repository)
	278	(let ((previous
	279	(reference-name->oid repository "HEAD")))
	280	(object->string
	281	`(channel-news
	282	(version 0)
	283	(entry (commit ,(oid->string previous))
	284	(title (en "New file!")
	285	(eo "Nova dosiero!"))
	286	(body (en "Yeah, a.txt."))))))))
	287	(commit "third commit")
	288	(add "src/b.txt" "B")
	289	(commit "fourth commit")
	290	(add "news.scm"
	291	,(lambda (repository)
	292	(let ((second
	293	(commit-id
	294	(find-commit repository "second commit")))
	295	(previous
	296	(reference-name->oid repository "HEAD")))
	297	(object->string
	298	`(channel-news
	299	(version 0)
	300	(entry (commit ,(oid->string previous))
	301	(title (en "Another file!"))
	302	(body (en "Yeah, b.txt.")))
9719e8d3	303	(entry (tag "tag-for-first-news-entry")
8ba7fd3c LC	304	(title (en "Old news.")
	305	(eo "Malnovaĵoj."))
	306	(body (en "For a.txt"))))))))
	307	(commit "fifth commit"))
	308	(with-repository directory repository
	309	(define (find-commit* message)
	310	(oid->string (commit-id (find-commit repository message))))
	311
	312	(let ((channel (channel (url (string-append "file://" directory))
	313	(name 'foo)))
	314	(commit1 (find-commit* "first commit"))
	315	(commit2 (find-commit* "second commit"))
	316	(commit3 (find-commit* "third commit"))
	317	(commit4 (find-commit* "fourth commit"))
	318	(commit5 (find-commit* "fifth commit")))
	319	;; First try fetching all the news up to a given commit.
	320	(and (null? (channel-news-for-commit channel commit2))
	321	(lset= string=?
	322	(map channel-news-entry-commit
	323	(channel-news-for-commit channel commit5))
	324	(list commit2 commit4))
	325	(lset= equal?
	326	(map channel-news-entry-title
	327	(channel-news-for-commit channel commit5))
	328	'((("en" . "Another file!"))
	329	(("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
	330	(lset= string=?
	331	(map channel-news-entry-commit
	332	(channel-news-for-commit channel commit3))
	333	(list commit2))
	334
	335	;; Now fetch news entries that apply to a commit range.
	336	(lset= string=?
	337	(map channel-news-entry-commit
	338	(channel-news-for-commit channel commit3 commit1))
	339	(list commit2))
	340	(lset= string=?
	341	(map channel-news-entry-commit
	342	(channel-news-for-commit channel commit5 commit3))
	343	(list commit4))
	344	(lset= string=?
	345	(map channel-news-entry-commit
	346	(channel-news-for-commit channel commit5 commit1))
9719e8d3 LC	347	(list commit4 commit2))
	348	(lset= equal?
	349	(map channel-news-entry-tag
	350	(channel-news-for-commit channel commit5 commit1))
	351	'(#f "tag-for-first-news-entry")))))))
8ba7fd3c	352
af12790b	353	(test-end "channels")