--- Begin Message ---
|
Subject: |
`modify-services` no longer affects multiple instances of the same service |
|
Date: |
Fri, 16 Jun 2023 15:52:30 +0300 |
|
User-agent: |
Cyrus-JMAP/3.9.0-alpha0-496-g8c46984af0-fm-20230615.001-g8c46984a |
Hi Guix!
Recently there was a change to the behavior of `modify-services` that adds
logic to check for any unused clauses so that an exception can be raised to
alert the user of this case.
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=181951207339508789b28ba7cb914f983319920f
It seems that the new logic has a bug that prevents a used clause from being
executed on more than one instance of a compatible service in a single
execution of `modify-services`. Here's a new test case for
`gnu/tests/services.scm` that exhibits the issue:
```
(test-equal "modify-services: delete multiple services of the same type"
'(1 3)
(let* ((t1 (service-type (name 't1)
(extensions '())
(description "")))
(t2 (service-type (name 't2)
(extensions '())
(description "")))
(t3 (service-type (name 't3)
(extensions '())
(description "")))
(services (list (service t1 1) (service t2 2)
(service t2 2) (service t3 3))))
(map service-value
(modify-services services
(delete t2)))))
```
Here's the output of the test:
```
test-name: modify-services: delete multiple services of the same type
location: /home/daviwil/Projects/Code/guix/tests/services.scm:325
source:
+ (test-equal
+ "modify-services: delete multiple services of the same type"
+ '(1 3)
+ (let* ((t1 (service-type
+ (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type
+ (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type
+ (name 't3)
+ (extensions '())
+ (description "")))
+ (services
+ (list (service t1 1)
+ (service t2 2)
+ (service t2 2)
+ (service t3 3))))
+ (map service-value
+ (modify-services services (delete t2)))))
expected-value: (1 3)
actual-value: (1 2 3)
result: FAIL
```
The problem occurs because of this `fold2` logic in `apply-clauses` of
gnu/services.scm`:
```
(fold2 (lambda (clause service remainder)
(if service
(match clause
((kind proc properties)
(if (eq? kind (service-kind service))
(values (proc service) remainder)
(values service
(cons clause remainder)))))
(values #f (cons clause remainder))))
head
'()
clauses)))
```
In the #t case of checking the service kind, `(values (proc service remainder)`
is returned, meaning the successful clause is not being added back to the list
of clauses as `fold2` continues. Any subsequent items of the service list will
no longer be tested against the removed clause.
I believe this function's logic needs to be updated to keep a list of
successful clauses to be diffed against the full clause list at the end of
`apply-clauses` so that the unapplied clause list can be determined without
having to remove successful clauses in-flight.
If anyone has any pointers on the best way to approach this, I'll be happy to
submit a patch!
David
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: bug#65184: (modify-services … (delete …)) should delete all matching service types |
|
Date: |
Thu, 31 Aug 2023 23:49:52 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/28.2 (gnu/linux) |
Hi Brian!
Brian Cully <bjc@spork.org> writes:
> This patch reverts the behavior introduced in
> 181951207339508789b28ba7cb914f983319920f which caused ‘modify-services’
> clauses to only match a single instance of a service.
>
> We will now match all service instances when doing a deletion or update, while
> still raising an exception when trying to match against a service that does
> not exist in the services list, or which was deleted explicitly by a ‘delete’
> clause (or an update clause that returns ‘#f’ for the service).
>
> Fixes: #64106
>
> * gnu/services.scm (%modify-services): New procedure.
> (modify-services): Use it.
> (apply-clauses): Add DELETED-SERVICES argument, change to modify one service
> at a time.
> * tests/services.scm
> ("modify-services: delete then modify"),
> ("modify-services: modify then delete"),
> ("modify-services: delete multiple services of the same type"),
> ("modify-services: modify multiple services of the same type"): New tests.
[...]
I've applied the following cosmetic changes:
--8<---------------cut here---------------start------------->8---
1 file changed, 20 insertions(+), 18 deletions(-)
gnu/services.scm | 38 ++++++++++++++++++++------------------
modified gnu/services.scm
@@ -325,11 +325,13 @@ (define-syntax clause-alist
'())))
(define (apply-clauses clauses service deleted-services)
+ "Apply CLAUSES, an alist as returned by 'clause-alist', to SERVICE. An
+exception is raised if a clause attempts to modify a service
+present in DELETED-SERVICES."
(define (raise-if-deleted kind properties)
- (match (find (lambda (deleted)
- (match deleted
- ((deleted-kind _)
- (eq? kind deleted-kind))))
+ (match (find (match-lambda
+ ((deleted-kind _)
+ (eq? kind deleted-kind)))
deleted-services)
((_ deleted-properties)
(raise (make-compound-condition
@@ -344,27 +346,27 @@ (define (apply-clauses clauses service deleted-services)
(match clauses
(((kind proc properties) . rest)
- (begin
- (raise-if-deleted kind properties)
- (if (eq? (and service (service-kind service))
- kind)
- (let ((new-service (proc service)))
- (apply-clauses rest new-service
- (if new-service
- deleted-services
- (cons (list kind properties)
- deleted-services))))
- (apply-clauses rest service deleted-services))))
+ (raise-if-deleted kind properties)
+ (if (eq? (and service (service-kind service)) kind)
+ (let ((new-service (proc service)))
+ (apply-clauses rest new-service
+ (if new-service
+ deleted-services
+ (cons (list kind properties)
+ deleted-services))))
+ (apply-clauses rest service deleted-services)))
(()
service)))
(define (%modify-services services clauses)
+ "Apply CLAUSES, an alist as returned by 'clause-alist', to SERVICES. An
+exception is raised if a clause attempts to modify a missing service."
(define (raise-if-not-found clause)
(match clause
((kind _ properties)
- (when (not (find (lambda (service)
- (eq? kind (service-kind service)))
- services))
+ (unless (find (lambda (service)
+ (eq? kind (service-kind service)))
+ services)
(raise (make-compound-condition
(condition
(&error-location
--8<---------------cut here---------------end--------------->8---
and installed it. Thanks for contributing to Guix!
--
Thanks,
Maxim
--- End Message ---