me
/
guix
Archived
1
0
Fork 0
Code

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 2023-05-17 16:58:59 +02:00
parent ec0a2fc87b
commit cd262c403f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 0 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/upstream.scm
View File

@ -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

120
tests/upstream.scm
View File

@ -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)