summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-05-22 17:21:57 +0200
committerMarius Bakke <marius@gnu.org>2021-05-22 17:21:57 +0200
commit4ea6852c5ff1606cf6848f3ddbb669120b228c13 (patch)
tree6f21e3cad7a3cad4eb847f404b6ba6450dfc2bef /tests
parentfcf45f8d756b92c5a99308d671af8992b489c4b4 (diff)
parentd4ffa9630277fa8699c783c08381d688626d4bc3 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/inferior.scm20
-rw-r--r--tests/publish.scm32
-rw-r--r--tests/services/configuration.scm29
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)))