GNU bug report logs -
#63538
[PATCH] gnu: services: Error in MODIFY-SERVICES when services don't exist
Previous Next
Reported by: Brian Cully <bjc <at> spork.org>
Date: Tue, 16 May 2023 15:40:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Full log
View this message in rfc822 format
[Message part 1 (text/plain, inline)]
Your message dated Fri, 02 Jun 2023 16:22:44 +0200
with message-id <87wn0m3pvv.fsf_-_ <at> gnu.org>
and subject line Re: bug#63538: [PATCH] gnu: services: Error in MODIFY-SERVICES when services don't exist
has caused the debbugs.gnu.org bug report #63538,
regarding [PATCH] gnu: services: Error in MODIFY-SERVICES when services don't exist
to be marked as done.
(If you believe you have received this mail in error, please contact
help-debbugs <at> gnu.org.)
--
63538: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63538
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
* tests/services.scm ("modify-services: do nothing")
("modify-services: delete service")
("modify-services: change value"): New tests.
---
tests/services.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 50 insertions(+)
diff --git a/tests/services.scm b/tests/services.scm
index 8e35758209..435f39e59b 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -286,4 +286,54 @@ (define-module (test-services)
((one) one)
(x x))))
+(test-equal "modify-services: do nothing"
+ '(1 2 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 t3 3))))
+ (sort (map service-value
+ (modify-services services))
+ <)))
+
+(test-equal "modify-services: delete service"
+ '(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 t3 3))))
+ (sort (map service-value
+ (modify-services services
+ (delete t2)))
+ <)))
+
+(test-equal "modify-services: change value"
+ '(1 2 33)
+ (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 t3 3))))
+ (sort (map service-value
+ (modify-services services
+ (t3 value => 33)))
+ <)))
+
(test-end)
base-commit: b363fab46f5af42b3f653e2fee1834477bd5aacd
prerequisite-patch-id: 8a03c5e8bcd4c526b93c558d550725887f932e41
prerequisite-patch-id: 89400c29b4c30dfbe8492aff1751ca583397b4f0
prerequisite-patch-id: a1963f772e753239b80e6a7b0d9f55e0ab4d662b
prerequisite-patch-id: b047430c30ba9ea274aea33a467cdb49d769884e
--
2.40.1
[Message part 3 (message/rfc822, inline)]
[Message part 4 (text/plain, inline)]
Hi Brian,
Applied with the minor change below. Thanks for working on this!
Ludo’.
[Message part 5 (text/x-patch, inline)]
diff --git a/gnu/services.scm b/gnu/services.scm
index a58cffe536..a990d297c9 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber <at> dustycloud.org>
;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2023 Brian Cully <bjc <at> spork.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -307,10 +308,10 @@ (define (%delete-service kind services)
(raise (formatted-message
(G_ "modify-services: service '~a' not found in service list")
(service-type-name kind)))))
- ((svc . rest)
- (if (eq? (service-kind svc) kind)
- (loop svc return rest)
- (loop found (cons svc return) rest))))))
+ ((service . rest)
+ (if (eq? (service-kind service) kind)
+ (loop service return rest)
+ (loop found (cons service return) rest))))))
(define-syntax %apply-clauses
(syntax-rules (=> delete)
This bug report was last modified 2 years and 73 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.