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.
This commit is contained in:
Ludovic Courtès
parent
ec0a2fc87b
commit
cd262c403f
|
|
@ -82,12 +82,6 @@
|
|||
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 @@ its inputs that have the given TYPE (a symbol such as 'native)."
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -54,124 +54,4 @@
|
|||
(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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue