upstream: Remove <upstream-input-change> and related code.
* 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.
master
Ludovic Courtès
parent
ec0a2fc87b
commit
cd262c403f
|
|
@ -82,12 +82,6 @@
|
||||||
upstream-updater-predicate
|
upstream-updater-predicate
|
||||||
upstream-updater-import
|
upstream-updater-import
|
||||||
|
|
||||||
upstream-input-change?
|
|
||||||
upstream-input-change-name
|
|
||||||
upstream-input-change-type
|
|
||||||
upstream-input-change-action
|
|
||||||
changed-inputs
|
|
||||||
|
|
||||||
%updaters
|
%updaters
|
||||||
lookup-updater
|
lookup-updater
|
||||||
|
|
||||||
|
|
@ -151,64 +145,6 @@ its inputs that have the given TYPE (a symbol such as 'native)."
|
||||||
(define upstream-source-native-inputs (input-type-filter 'native))
|
(define upstream-source-native-inputs (input-type-filter 'native))
|
||||||
(define upstream-source-propagated-inputs (input-type-filter 'propagated))
|
(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?)
|
(define* (url-predicate matching-url?)
|
||||||
"Return a predicate that returns true when passed a package whose source is
|
"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
|
an <origin> with the URL-FETCH method, and one of its URLs passes
|
||||||
|
|
|
||||||
|
|
@ -54,124 +54,4 @@
|
||||||
(signature-urls
|
(signature-urls
|
||||||
'("ftp://example.org/foo-1.tar.xz.sig"))))))
|
'("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)
|
(test-end)
|
||||||
|
|
|
||||||
Reference in New Issue