[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 control)
  #: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)))))))

(unless (which (git-command)) (test-skip 1))
(test-equal "latest-channel-instances #:validate-pull"
  'descendant

  ;; Make sure the #:validate-pull procedure receives the right values.
  (let/ec return
    (with-temporary-git-repository directory
        '((add "a.txt" "A")
          (commit "first commit")
          (add "b.scm" "#t")
          (commit "second commit"))
      (with-repository directory repository
        (let* ((commit1 (find-commit repository "first"))
               (commit2 (find-commit repository "second"))
               (spec    (channel (url (string-append "file://" directory))
                                 (name 'foo)))
               (new     (channel (inherit spec)
                                 (commit (oid->string (commit-id commit2)))))
               (old     (channel (inherit spec)
                                 (commit (oid->string (commit-id commit1))))))
          (define (validate-pull channel current instance relation)
            (return (and (eq? channel old)
                         (string=? (oid->string (commit-id commit2))
                                   current)
                         (string=? (oid->string (commit-id commit1))
                                   (channel-instance-commit instance))
                         relation)))

          (with-store store
            ;; Attempt a downgrade from NEW to OLD.
            (latest-channel-instances store (list old)
                                      #:current-channels (list new)
                                      #:validate-pull validate-pull)))))))

(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	39	#:use-module (srfi srfi-64)
872898f7	40	#:use-module (ice-9 control)
af12790b RW	41	#:use-module (ice-9 match))
	42
	43	(test-begin "channels")
	44
	45	(define* (make-instance #:key
	46	(name 'fake)
	47	(commit "cafebabe")
	48	(spec #f))
	49	(define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
ce5d9ec8 LC	50	(when spec
	51	(call-with-output-file (string-append instance-dir "/.guix-channel")
	52	(lambda (port) (write spec port))))
ed75bdf3 LC	53	(checkout->channel-instance instance-dir
	54	#:commit commit
	55	#:name name))
af12790b RW	56
af12790b RW	57	(define instance--boring (make-instance))
45b90332 LC	58	(define instance--unsupported-version
	59	(make-instance #:spec
	60	'(channel (version 42) (dependencies whatever))))
af12790b RW	61	(define instance--no-deps
af12790b RW	62	(make-instance #:spec
ce5d9ec8 LC	63	'(channel (version 0))))
	64	(define instance--sub-directory
	65	(make-instance #:spec
	66	'(channel (version 0) (directory "modules"))))
af12790b RW	67	(define instance--simple
	68	(make-instance #:spec
	69	'(channel
	70	(version 0)
	71	(dependencies
	72	(channel
	73	(name test-channel)
	74	(url "https://example.com/test-channel"))))))
	75	(define instance--with-dupes
	76	(make-instance #:spec
	77	'(channel
	78	(version 0)
	79	(dependencies
	80	(channel
	81	(name test-channel)
	82	(url "https://example.com/test-channel"))
	83	(channel
	84	(name test-channel)
	85	(url "https://example.com/test-channel")
	86	(commit "abc1234"))
	87	(channel
	88	(name test-channel)
	89	(url "https://example.com/test-channel-elsewhere"))))))
	90
45b90332 LC	91	(define channel-instance-metadata
45b90332 LC	92	(@@ (guix channels) channel-instance-metadata))
ce5d9ec8 LC	93	(define channel-metadata-directory
	94	(@@ (guix channels) channel-metadata-directory))
	95	(define channel-metadata-dependencies
	96	(@@ (guix channels) channel-metadata-dependencies))
af12790b RW	97
af12790b RW	98	\f
ce5d9ec8 LC	99	(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
	100	'("/" ())
	101	(let ((metadata (channel-instance-metadata instance--boring)))
	102	(list (channel-metadata-directory metadata)
	103	(channel-metadata-dependencies metadata))))
	104
	105	(test-equal "channel-instance-metadata and default dependencies"
	106	'()
	107	(channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
	108
	109	(test-equal "channel-instance-metadata and directory"
	110	"/modules"
	111	(channel-metadata-directory
	112	(channel-instance-metadata instance--sub-directory)))
45b90332 LC	113
	114	(test-equal "channel-instance-metadata rejects unsupported version"
	115	1 ;line number in the generated '.guix-channel'
	116	(guard (c ((and (message-condition? c) (error-location? c))
	117	(location-line (error-location c))))
	118	(channel-instance-metadata instance--unsupported-version)))
af12790b	119
45b90332	120	(test-assert "channel-instance-metadata returns <channel-metadata>"
af12790b	121	(every (@@ (guix channels) channel-metadata?)
45b90332	122	(map channel-instance-metadata
af12790b RW	123	(list instance--no-deps
	124	instance--simple
	125	instance--with-dupes))))
	126
45b90332	127	(test-assert "channel-instance-metadata dependencies are channels"
af12790b	128	(let ((deps ((@@ (guix channels) channel-metadata-dependencies)
45b90332	129	(channel-instance-metadata instance--simple))))
af12790b RW	130	(match deps
	131	(((? channel? dep)) #t)
	132	(_ #f))))
	133
	134	(test-assert "latest-channel-instances includes channel dependencies"
	135	(let* ((channel (channel
	136	(name 'test)
	137	(url "test")))
	138	(test-dir (channel-instance-checkout instance--simple)))
053b10c3	139	(mock ((guix git) update-cached-checkout
8d1d5657	140	(lambda* (url #:key ref starting-commit)
af12790b	141	(match url
8d1d5657	142	("test" (values test-dir "caf3cabba9e" #f))
053b10c3	143	(_ (values (channel-instance-checkout instance--no-deps)
8d1d5657	144	"abcde1234" #f)))))
053b10c3 LC	145	(with-store store
	146	(let ((instances (latest-channel-instances store (list channel))))
	147	(and (eq? 2 (length instances))
	148	(lset= eq?
	149	'(test test-channel)
	150	(map (compose channel-name channel-instance-channel)
	151	instances))))))))
af12790b RW	152
	153	(test-assert "latest-channel-instances excludes duplicate channel dependencies"
	154	(let* ((channel (channel
	155	(name 'test)
	156	(url "test")))
	157	(test-dir (channel-instance-checkout instance--with-dupes)))
053b10c3	158	(mock ((guix git) update-cached-checkout
8d1d5657	159	(lambda* (url #:key ref starting-commit)
af12790b	160	(match url
8d1d5657	161	("test" (values test-dir "caf3cabba9e" #f))
053b10c3	162	(_ (values (channel-instance-checkout instance--no-deps)
8d1d5657	163	"abcde1234" #f)))))
053b10c3 LC	164	(with-store store
	165	(let ((instances (latest-channel-instances store (list channel))))
	166	(and (= 2 (length instances))
	167	(lset= eq?
	168	'(test test-channel)
	169	(map (compose channel-name channel-instance-channel)
	170	instances))
	171	;; only the most specific channel dependency should remain,
	172	;; i.e. the one with a specified commit.
	173	(find (lambda (instance)
	174	(and (eq? (channel-name
	175	(channel-instance-channel instance))
	176	'test-channel)
	177	(string=? (channel-commit
	178	(channel-instance-channel instance))
	179	"abc1234")))
	180	instances)))))))
af12790b	181
872898f7 LC	182	(unless (which (git-command)) (test-skip 1))
	183	(test-equal "latest-channel-instances #:validate-pull"
	184	'descendant
	185
	186	;; Make sure the #:validate-pull procedure receives the right values.
	187	(let/ec return
	188	(with-temporary-git-repository directory
	189	'((add "a.txt" "A")
	190	(commit "first commit")
	191	(add "b.scm" "#t")
	192	(commit "second commit"))
	193	(with-repository directory repository
	194	(let* ((commit1 (find-commit repository "first"))
	195	(commit2 (find-commit repository "second"))
	196	(spec (channel (url (string-append "file://" directory))
	197	(name 'foo)))
	198	(new (channel (inherit spec)
	199	(commit (oid->string (commit-id commit2)))))
	200	(old (channel (inherit spec)
	201	(commit (oid->string (commit-id commit1))))))
	202	(define (validate-pull channel current instance relation)
	203	(return (and (eq? channel old)
	204	(string=? (oid->string (commit-id commit2))
	205	current)
	206	(string=? (oid->string (commit-id commit1))
	207	(channel-instance-commit instance))
	208	relation)))
	209
	210	(with-store store
	211	;; Attempt a downgrade from NEW to OLD.
	212	(latest-channel-instances store (list old)
	213	#:current-channels (list new)
	214	#:validate-pull validate-pull)))))))
	215
ed75bdf3 LC	216	(test-assert "channel-instances->manifest"
	217	;; Compute the manifest for a graph of instances and make sure we get a
	218	;; derivation graph that mirrors the instance graph. This test also ensures
	219	;; we don't try to access Git repositores at all at this stage.
	220	(let* ((spec (lambda deps
	221	`(channel (version 0)
	222	(dependencies
	223	,@(map (lambda (dep)
	224	`(channel
	225	(name ,dep)
	226	(url "http://example.org")))
	227	deps)))))
	228	(guix (make-instance #:name 'guix))
	229	(instance0 (make-instance #:name 'a))
	230	(instance1 (make-instance #:name 'b #:spec (spec 'a)))
	231	(instance2 (make-instance #:name 'c #:spec (spec 'b)))
	232	(instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
	233	(%graft? #f) ;don't try to build stuff
	234
	235	;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
	236	(let ((source (channel-instance-checkout guix)))
	237	(mkdir (string-append source "/build-aux"))
	238	(call-with-output-file (string-append source
	239	"/build-aux/build-self.scm")
	240	(lambda (port)
	241	(write '(begin
	242	(use-modules (guix) (gnu packages bootstrap))
	243
	244	(lambda _
	245	(package->derivation %bootstrap-guile)))
	246	port))))
	247
	248	(with-store store
	249	(let ()
	250	(define manifest
	251	(run-with-store store
	252	(channel-instances->manifest (list guix
	253	instance0 instance1
	254	instance2 instance3))))
	255
	256	(define entries
	257	(manifest-entries manifest))
	258
	259	(define (depends? drv in out)
1fafc383 LC	260	;; Return true if DRV depends (directly or indirectly) on all of IN
	261	;; and none of OUT.
	262	(let ((set (list->set
	263	(requisites store
	264	(list (derivation-file-name drv)))))
ed75bdf3 LC	265	(in (map derivation-file-name in))
ed75bdf3 LC	266	(out (map derivation-file-name out)))
1fafc383 LC	267	(and (every (cut set-contains? set <>) in)
1fafc383 LC	268	(not (any (cut set-contains? set <>) out)))))
ed75bdf3 LC	269
	270	(define (lookup name)
	271	(run-with-store store
	272	(lower-object
	273	(manifest-entry-item
	274	(manifest-lookup manifest
	275	(manifest-pattern (name name)))))))
	276
	277	(let ((drv-guix (lookup "guix"))
	278	(drv0 (lookup "a"))
	279	(drv1 (lookup "b"))
	280	(drv2 (lookup "c"))
	281	(drv3 (lookup "d")))
	282	(and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
	283	(depends? drv0
	284	(list) (list drv1 drv2 drv3))
	285	(depends? drv1
	286	(list drv0) (list drv2 drv3))
	287	(depends? drv2
1fafc383	288	(list drv1) (list drv3))
ed75bdf3	289	(depends? drv3
1fafc383	290	(list drv2 drv0) (list))))))))
ed75bdf3	291
8ba7fd3c LC	292	(unless (which (git-command)) (test-skip 1))
	293	(test-equal "channel-news, no news"
	294	'()
	295	(with-temporary-git-repository directory
	296	'((add "a.txt" "A")
	297	(commit "the commit"))
	298	(with-repository directory repository
	299	(let ((channel (channel (url (string-append "file://" directory))
	300	(name 'foo)))
	301	(latest (reference-name->oid repository "HEAD")))
	302	(channel-news-for-commit channel (oid->string latest))))))
	303
	304	(unless (which (git-command)) (test-skip 1))
	305	(test-assert "channel-news, one entry"
	306	(with-temporary-git-repository directory
	307	`((add ".guix-channel"
	308	,(object->string
	309	'(channel (version 0)
	310	(news-file "news.scm"))))
	311	(commit "first commit")
	312	(add "src/a.txt" "A")
	313	(commit "second commit")
9719e8d3	314	(tag "tag-for-first-news-entry")
8ba7fd3c LC	315	(add "news.scm"
	316	,(lambda (repository)
	317	(let ((previous
	318	(reference-name->oid repository "HEAD")))
	319	(object->string
	320	`(channel-news
	321	(version 0)
	322	(entry (commit ,(oid->string previous))
	323	(title (en "New file!")
	324	(eo "Nova dosiero!"))
	325	(body (en "Yeah, a.txt."))))))))
	326	(commit "third commit")
	327	(add "src/b.txt" "B")
	328	(commit "fourth commit")
	329	(add "news.scm"
	330	,(lambda (repository)
	331	(let ((second
	332	(commit-id
	333	(find-commit repository "second commit")))
	334	(previous
	335	(reference-name->oid repository "HEAD")))
	336	(object->string
	337	`(channel-news
	338	(version 0)
	339	(entry (commit ,(oid->string previous))
	340	(title (en "Another file!"))
	341	(body (en "Yeah, b.txt.")))
9719e8d3	342	(entry (tag "tag-for-first-news-entry")
8ba7fd3c LC	343	(title (en "Old news.")
	344	(eo "Malnovaĵoj."))
	345	(body (en "For a.txt"))))))))
	346	(commit "fifth commit"))
	347	(with-repository directory repository
	348	(define (find-commit* message)
	349	(oid->string (commit-id (find-commit repository message))))
	350
	351	(let ((channel (channel (url (string-append "file://" directory))
	352	(name 'foo)))
	353	(commit1 (find-commit* "first commit"))
	354	(commit2 (find-commit* "second commit"))
	355	(commit3 (find-commit* "third commit"))
	356	(commit4 (find-commit* "fourth commit"))
	357	(commit5 (find-commit* "fifth commit")))
	358	;; First try fetching all the news up to a given commit.
	359	(and (null? (channel-news-for-commit channel commit2))
	360	(lset= string=?
	361	(map channel-news-entry-commit
	362	(channel-news-for-commit channel commit5))
	363	(list commit2 commit4))
	364	(lset= equal?
	365	(map channel-news-entry-title
	366	(channel-news-for-commit channel commit5))
	367	'((("en" . "Another file!"))
	368	(("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
	369	(lset= string=?
	370	(map channel-news-entry-commit
	371	(channel-news-for-commit channel commit3))
	372	(list commit2))
	373
	374	;; Now fetch news entries that apply to a commit range.
	375	(lset= string=?
	376	(map channel-news-entry-commit
	377	(channel-news-for-commit channel commit3 commit1))
	378	(list commit2))
	379	(lset= string=?
	380	(map channel-news-entry-commit
	381	(channel-news-for-commit channel commit5 commit3))
	382	(list commit4))
	383	(lset= string=?
	384	(map channel-news-entry-commit
	385	(channel-news-for-commit channel commit5 commit1))
9719e8d3 LC	386	(list commit4 commit2))
	387	(lset= equal?
	388	(map channel-news-entry-tag
	389	(channel-news-for-commit channel commit5 commit1))
	390	'(#f "tag-for-first-news-entry")))))))
8ba7fd3c	391
af12790b	392	(test-end "channels")