guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#63571] [PATCH 09/14] upstream: Remove <upstream-input-change> and r


From: Ludovic Courtès
Subject: [bug#63571] [PATCH 09/14] upstream: Remove <upstream-input-change> and related code.
Date: Thu, 18 May 2023 17:16:17 +0200

* guix/upstream.scm (<upstream-input-change>): Remove.
(changed-inputs): Remove.
* tests/upstream.scm (test-package, test-new-package)
("changed-inputs returns no changes")
("changed-inputs returns changes to plain input list")
("changed-inputs returns changes to all plain input lists"): Remove.
---
 guix/upstream.scm  |  64 ------------------------
 tests/upstream.scm | 120 ---------------------------------------------
 2 files changed, 184 deletions(-)

diff --git a/guix/upstream.scm b/guix/upstream.scm
index 1a90a342ff..54e6c3b89c 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -82,12 +82,6 @@ (define-module (guix upstream)
             upstream-updater-predicate
             upstream-updater-import
 
-            upstream-input-change?
-            upstream-input-change-name
-            upstream-input-change-type
-            upstream-input-change-action
-            changed-inputs
-
             %updaters
             lookup-updater
 
@@ -151,64 +145,6 @@ (define upstream-source-regular-inputs (input-type-filter 
'regular))
 (define upstream-source-native-inputs (input-type-filter 'native))
 (define upstream-source-propagated-inputs (input-type-filter 'propagated))
 
-;; Representation of an upstream input change.
-(define-record-type* <upstream-input-change>
-  upstream-input-change make-upstream-input-change
-  upstream-input-change?
-  (name    upstream-input-change-name)    ;string
-  (type    upstream-input-change-type)    ;symbol: regular | native | 
propagated
-  (action  upstream-input-change-action)) ;symbol: add | remove
-
-(define (changed-inputs package source)
-  "Return a list of input changes for PACKAGE compared to the 'inputs' field
-of SOURCE, an <upstream-source> record."
-  (define input->name
-    (match-lambda
-      ((label (? package? pkg) . out) (package-name pkg))
-      (_ #f)))
-
-  (if (upstream-source-inputs source)
-      (let* ((new-regular (map upstream-input-downstream-name
-                               (upstream-source-regular-inputs source)))
-             (new-native (map upstream-input-downstream-name
-                              (upstream-source-native-inputs source)))
-             (new-propagated (map upstream-input-downstream-name
-                                  (upstream-source-propagated-inputs source)))
-             (current-regular
-              (filter-map input->name (package-inputs package)))
-             (current-native
-              (filter-map input->name (package-native-inputs package)))
-             (current-propagated
-              (filter-map input->name (package-propagated-inputs package))))
-        (append-map
-         (match-lambda
-           ((action type names)
-            (map (lambda (name)
-                   (upstream-input-change
-                    (name name)
-                    (type type)
-                    (action action)))
-                 names)))
-         `((add regular
-                ,(lset-difference equal?
-                                  new-regular current-regular))
-           (remove regular
-                   ,(lset-difference equal?
-                                     current-regular new-regular))
-           (add native
-                ,(lset-difference equal?
-                                  new-native current-native))
-           (remove native
-                   ,(lset-difference equal?
-                                     current-native new-native))
-           (add propagated
-                ,(lset-difference equal?
-                                  new-propagated current-propagated))
-           (remove propagated
-                   ,(lset-difference equal?
-                                     current-propagated new-propagated)))))
-      '()))
-
 (define* (url-predicate matching-url?)
   "Return a predicate that returns true when passed a package whose source is
 an <origin> with the URL-FETCH method, and one of its URLs passes
diff --git a/tests/upstream.scm b/tests/upstream.scm
index 0792ebd5d0..b82579228a 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -54,124 +54,4 @@ (define-module (test-upstream)
                            (signature-urls
                             '("ftp://example.org/foo-1.tar.xz.sig";))))))
 
-(define test-package
-  (package
-    (name "test")
-    (version "2.10")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append "mirror://gnu/hello/hello-" version
-                                  ".tar.gz"))
-              (sha256
-               (base32
-                "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
-    (build-system gnu-build-system)
-    (inputs
-     `(("hello" ,hello)))
-    (native-inputs
-     `(("sed" ,sed)
-       ("tar" ,tar)))
-    (propagated-inputs
-     `(("grep" ,grep)))
-    (home-page "http://localhost";)
-    (synopsis "test")
-    (description "test")
-    (license license:gpl3+)))
-
-(test-equal "changed-inputs returns no changes"
-  '()
-  (changed-inputs test-package
-                  (upstream-source
-                   (package "test")
-                   (version "1")
-                   (urls '())
-                   (inputs
-                    (let ((->input
-                           (lambda (type)
-                             (match-lambda
-                               ((label _)
-                                (upstream-input
-                                 (name label)
-                                 (downstream-name label)
-                                 (type type)))))))
-                      (append (map (->input 'regular)
-                                   (package-inputs test-package))
-                              (map (->input 'native)
-                                   (package-native-inputs test-package))
-                              (map (->input 'propagated)
-                                   (package-propagated-inputs
-                                    test-package))))))))
-
-(define test-new-package
-  (package
-    (inherit test-package)
-    (inputs
-     (list hello))
-    (native-inputs
-     (list sed tar))
-    (propagated-inputs
-     (list grep))))
-
-(test-assert "changed-inputs returns changes to plain input list"
-  (let ((changes (changed-inputs
-                  (package
-                    (inherit test-new-package)
-                    (inputs (list hello sed))
-                    (native-inputs '())
-                    (propagated-inputs '()))
-                  (upstream-source
-                   (package "test")
-                   (version "1")
-                   (urls '())
-                   (inputs (list (upstream-input
-                                  (name "hello")
-                                  (downstream-name name))))))))
-    (match changes
-      ;; Exactly one change
-      (((? upstream-input-change? item))
-       (and (equal? (upstream-input-change-type item)
-                    'regular)
-            (equal? (upstream-input-change-action item)
-                    'remove)
-            (string=? (upstream-input-change-name item)
-                      "sed")))
-      (else (pk else #false)))))
-
-(test-assert "changed-inputs returns changes to all plain input lists"
-  (let ((changes (changed-inputs
-                  (package
-                    (inherit test-new-package)
-                    (inputs '())
-                    (native-inputs '())
-                    (propagated-inputs '()))
-                  (upstream-source
-                   (package "test")
-                   (version "1")
-                   (urls '())
-                   (inputs (list (upstream-input
-                                  (name "hello")
-                                  (downstream-name name)
-                                  (type 'regular))
-                                 (upstream-input
-                                  (name "sed")
-                                  (downstream-name name)
-                                  (type 'native))
-                                 (upstream-input
-                                  (name "tar")
-                                  (downstream-name name)
-                                  (type 'native))
-                                 (upstream-input
-                                  (name "grep")
-                                  (downstream-name name)
-                                  (type 'propagated))))))))
-    (match changes
-      (((? upstream-input-change? items) ...)
-       (and (equal? (map upstream-input-change-type items)
-                    '(regular native native propagated))
-            (equal? (map upstream-input-change-action items)
-                    '(add add add add))
-            (equal? (map upstream-input-change-name items)
-                    '("hello" "sed" "tar" "grep"))))
-      (else (pk else #false)))))
-
 (test-end)
-- 
2.40.1






reply via email to

[Prev in Thread] Current Thread [Next in Thread]