packages: Raise an exception for invalid 'license' values.

[jackhill/guix/guix.git] / tests / utils.scm

diff --git a/tests/utils.scm b/tests/utils.scm
index 009e212..648e91f 100644 (file)
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,7 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -78,6 +80,12 @@
        (not (version-prefix? "4.1" "4.16.2"))
        (not (version-prefix? "4.1" "4"))))
 
+(test-equal "version-unique-prefix"
+  '("2" "2.2" "")
+  (list (version-unique-prefix "2.0" '("3.0" "2.0"))
+        (version-unique-prefix "2.2" '("3.0.5" "2.0.9" "2.2.7"))
+        (version-unique-prefix "27.1" '("27.1"))))
+
 (test-equal "string-tokenize*"
   '(("foo")
     ("foo" "bar" "baz")
@@ -182,19 +190,34 @@ skip these tests."
                        method)
     (let ((data (call-with-input-file (search-path %load-path "guix.scm")
                   get-bytevector-all)))
-      (let*-values (((compressed pids1)
-                     (compressed-port method (open-bytevector-input-port data)))
-                    ((decompressed pids2)
-                     (decompressed-port method compressed)))
-        (and (every (compose zero? cdr waitpid)
-                    (pk 'pids method (append pids1 pids2)))
-             (let ((result (get-bytevector-all decompressed)))
-               (pk 'len method
-                   (if (bytevector? result)
-                       (bytevector-length result)
-                       result)
-                   (bytevector-length data))
-               (equal? result data))))))
+      (call-with-temporary-output-file
+       (lambda (output port)
+         (close-port port)
+         (let*-values (((compressed pids)
+                        ;; Note: 'compressed-output-port' only supports file
+                        ;; ports.
+                        (compressed-output-port method
+                                                (open-file output "w0"))))
+           (put-bytevector compressed data)
+           (close-port compressed)
+           (and (every (compose zero? cdr waitpid)
+                       (pk 'pids method pids))
+                (let*-values (((decompressed pids)
+                               (decompressed-port method
+                                                  (open-bytevector-input-port
+                                                   (call-with-input-file output
+                                                     get-bytevector-all))))
+                              ((result)
+                               (get-bytevector-all decompressed)))
+                  (close-port decompressed)
+                  (pk 'len method
+                      (if (bytevector? result)
+                          (bytevector-length result)
+                          result)
+                      (bytevector-length data))
+                  (and (every (compose zero? cdr waitpid)
+                              (pk 'pids method pids))
+                       (equal? result data)))))))))
 
   (false-if-exception (delete-file temp-file))
   (unless (run?) (test-skip 1))
@@ -213,8 +236,10 @@ skip these tests."
                       get-bytevector-all)))))
 
 (for-each test-compression/decompression
-          '(gzip xz lzip)
-          (list (const #t) (const #t) (const #t)))
+          `(gzip xz lzip zstd)
+          (list (const #t) (const #t) (const #t)
+                (lambda ()
+                  (resolve-module '(zstd) #t #f #:ensure #f))))
 
 ;; This is actually in (guix store).
 (test-equal "store-path-package-name"
@@ -248,6 +273,62 @@ skip these tests."
                      string-reverse)
     (call-with-input-file temp-file get-string-all)))
 
+(test-equal "string-distance"
+  '(0 1 1 5 5)
+  (list
+   (string-distance "hello" "hello")
+   (string-distance "hello" "helo")
+   (string-distance "helo" "hello")
+   (string-distance "" "hello")
+   (string-distance "hello" "")))
+
+(test-equal "string-closest"
+  '("hello" "hello" "helo" #f)
+  (list
+   (string-closest "hello" '("hello"))
+   (string-closest "hello" '("helo" "hello" "halo"))
+   (string-closest "hello" '("kikoo" "helo" "hihihi" "halo"))
+   (string-closest "hello" '("aaaaa" "12345" "hellohello" "h"))))
+
+(test-equal "target-linux?"
+  '(#t #f #f #t)
+  (map target-linux?
+       '("i686-linux-gnu" "i686-w64-mingw32"
+         ;; Checking that "gnu" is present is not sufficient,
+         ;; as GNU/Hurd exists.
+         "i686-pc-gnu"
+         ;; Some targets have a suffix.
+         "arm-linux-gnueabihf")))
+
+(test-equal "target-mingw?"
+  '(#f #f #t)
+  (map target-mingw?
+       '("i686-linux-gnu" "i686-pc-gnu"
+         "i686-w64-mingw32")))
+
+(test-equal "target-x86-32?"
+  '(#f #f #f #t #t #t #t #f)
+  ;; These are (according to Wikipedia) two RISC architectures
+  ;; by Intel and presumably not compatible with the x86-32 series.
+  (map target-x86-32?
+       '("i860-gnu" "i960-gnu"
+         ;; This is a 16-bit architecture
+         "i286-gnu"
+         ;; These are part of the x86-32 series.
+         "i386-gnu" "i486-gnu" "i586-gnu" "i686-gnu"
+         ;; Maybe this one will exist some day, but not yet.
+         "i786-gnu")))
+
+(test-equal "target-x86-64?"
+  '(#t #f #f #f)
+  (map target-x86-64?
+       `("x86_64-linux-gnu" "i386-linux-gnu"
+         ;; Just because it includes "64" doesn't make it 64-bit.
+         "aarch64-linux-gnu"
+         ;; Note that (expt 2 109) in decimal notation starts with 64.
+         ;; However, it isn't 32-bit.
+         ,(format #f "x86_~a-linux-gnu" (expt 2 109)))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))