Merge branch 'master' into core-updates

3 files changed, 78 insertions, 3 deletions

diff --git a/tests/inferior.scm b/tests/inferior.scm
index f227e0b749..9992077cb2 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -26,6 +26,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages sqlite)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
@@ -260,6 +261,25 @@
          (list (inferior-package-derivation %store guile "x86_64-linux")
                (inferior-package-derivation %store guile "armhf-linux")))))
 
+(unless (package-replacement sqlite)
+  (test-skip 1))
+
+(test-equal "inferior-package-replacement"
+  (package-derivation %store
+                      (package-replacement sqlite)
+                      "x86_64-linux")
+  (let* ((inferior (open-inferior %top-builddir
+                                  #:command "scripts/guix"))
+         (packages (inferior-packages inferior)))
+    (match (lookup-inferior-packages inferior
+                                     (package-name sqlite)
+                                     (package-version sqlite))
+      ((inferior-sqlite rest ...)
+       (inferior-package-derivation %store
+                                    (inferior-package-replacement
+                                     inferior-sqlite)
+                                    "x86_64-linux")))))
+
 (test-equal "inferior-package->manifest-entry"
   (manifest-entry->list (package->manifest-entry
                          (first (find-best-packages-by-name "guile" #f))))
diff --git a/tests/publish.scm b/tests/publish.scm
index 3e67c435ac..c3d086995a 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -700,6 +700,36 @@ References: ~%"
             (= (response-content-length response) (stat:size (stat log)))
             (first (response-content-type response))))))
 
+(test-equal "negative TTL"
+  `(404 42)
+
+  (call-with-temporary-directory
+   (lambda (cache)
+     (let ((thread (with-separate-output-ports
+                    (call-with-new-thread
+                     (lambda ()
+                       (guix-publish "--port=6786" "-C0"
+                                     "--negative-ttl=42s"))))))
+       (wait-until-ready 6786)
+
+       (let* ((base     "http://localhost:6786/")
+              (url      (string-append base (make-string 32 #\z)
+                                       ".narinfo"))
+              (response (http-get url)))
+         (list (response-code response)
+               (match (assq-ref (response-headers response) 'cache-control)
+                 ((('max-age . ttl)) ttl)
+                 (_ #f))))))))
+
+(test-equal "no negative TTL"
+  `(404 #f)
+  (let* ((uri      (publish-uri
+                    (string-append "/" (make-string 32 #\z)
+                                   ".narinfo")))
+         (response (http-get uri)))
+    (list (response-code response)
+          (assq-ref (response-headers response) 'cache-control))))
+
 (test-equal "/log/NAME not found"
   404
   (let ((uri (publish-uri "/log/does-not-exist")))
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 21ad188485..85badd2da6 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -16,7 +16,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (tests services linux)
+(define-module (tests services configuration)
   #:use-module (gnu services configuration)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-34)
@@ -61,7 +61,7 @@
     (port-configuration-ndv-port (port-configuration-ndv))))
 
 (define (custom-number-serializer name value)
-  (format #t "~a = ~a;" name value))
+  (format #f "~a = ~a;" name value))
 
 (define-configuration serializable-configuration
   (port (number 80) "The port number." custom-number-serializer))
@@ -81,3 +81,28 @@
   (not (false-if-exception
         (let ((config (serializable-configuration)))
           (serialize-configuration config serializable-configuration-fields)))))
+
+
+;;;
+;;; define-maybe macro.
+;;;
+(define-maybe number)
+
+(define-configuration config-with-maybe-number
+  (port (maybe-number 80) "The port number."))
+
+(define (serialize-number field value)
+  (format #f "~a=~a" field value))
+
+(test-equal "maybe value serialization"
+  "port=80"
+  (serialize-maybe-number "port" 80))
+
+(define-maybe/no-serialization string)
+
+(define-configuration config-with-maybe-string/no-serialization
+  (name (maybe-string) "The name of the item.")
+  (no-serialization))
+
+(test-assert "maybe value without serialization no procedure bound"
+  (not (defined? 'serialize-maybe-string)))