X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/30ce8012cd6265b12f756283633be94a547bf990..f072e9adf58bf751528fc7122bdc71ba8c81e0e7:/tests/utils.scm

diff --git a/tests/utils.scm b/tests/utils.scm
index 8ad399f75c..a05faabc15 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,12 +21,14 @@
   #:use-module ((guix config) #:select (%gzip))
   #:use-module (guix utils)
   #:use-module ((guix store) #:select (%store-prefix store-path-package-name))
+  #:use-module ((guix search-paths) #:select (string-tokenize*))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist))
 
 (define temp-file
   (string-append "t-utils-" (number->string (getpid))))
@@ -118,6 +121,65 @@
                '(0 1 2 3)))
     list))
 
+(test-equal "split, element is in list"
+  '((foo) (baz))
+  (call-with-values
+      (lambda ()
+        (split '(foo bar baz) 'bar))
+    list))
+
+(test-equal "split, element is not in list"
+  '((foo bar baz) ())
+  (call-with-values
+      (lambda ()
+        (split '(foo bar baz) 'quux))
+    list))
+
+(test-equal "strip-keyword-arguments"
+  '(a #:b b #:c c)
+  (strip-keyword-arguments '(#:foo #:bar #:baz)
+                           '(a #:foo 42 #:b b #:baz 3
+                               #:c c #:bar 4)))
+
+(test-equal "ensure-keyword-arguments"
+  '((#:foo 2)
+    (#:foo 2 #:bar 3)
+    (#:foo 42 #:bar 3))
+  (list (ensure-keyword-arguments '(#:foo 2) '(#:foo 2))
+        (ensure-keyword-arguments '(#:foo 2) '(#:bar 3))
+        (ensure-keyword-arguments '(#:foo 2) '(#:bar 3 #:foo 42))))
+
+(let* ((tree (alist->vhash
+              '((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6))
+              hashq))
+       (add-one (lambda (_ r) (1+ r)))
+       (tree-lookup (lambda (n) (cdr (vhash-assq n tree)))))
+  (test-equal "fold-tree, single root"
+    5 (fold-tree add-one 0 tree-lookup '(0)))
+  (test-equal "fold-tree, two roots"
+    7 (fold-tree add-one 0 tree-lookup '(0 1)))
+  (test-equal "fold-tree, sum"
+    16 (fold-tree + 0 tree-lookup '(0)))
+  (test-equal "fold-tree, internal"
+    18 (fold-tree + 0 tree-lookup '(3 4)))
+  (test-equal "fold-tree, cons"
+    '(1 3 4 5 6)
+    (sort (fold-tree cons '() tree-lookup '(1)) <))
+  (test-equal "fold-tree, overlapping paths"
+    '(1 3 4 5 6)
+    (sort (fold-tree cons '() tree-lookup '(1 4)) <))
+  (test-equal "fold-tree, cons, two roots"
+    '(0 2 3 4 5 6)
+    (sort (fold-tree cons '() tree-lookup '(0 4)) <))
+  (test-equal "fold-tree-leaves, single root"
+    2 (fold-tree-leaves add-one 0 tree-lookup '(1)))
+  (test-equal "fold-tree-leaves, single root, sum"
+    11 (fold-tree-leaves + 0 tree-lookup '(1)))
+  (test-equal "fold-tree-leaves, two roots"
+    3 (fold-tree-leaves add-one 0 tree-lookup '(0 1)))
+  (test-equal "fold-tree-leaves, two roots, sum"
+    13 (fold-tree-leaves + 0 tree-lookup '(0 1))))
+
 (test-assert "filtered-port, file"
   (let* ((file  (search-path %load-path "guix.scm"))
          (input (open-file file "r0b")))
@@ -264,6 +326,12 @@
    (string-append (%store-prefix)
                   "/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24")))
 
+(test-equal "canonical-newline-port"
+  "This is a journey\nInto the sound\nA journey ...\n"
+  (let ((port (open-string-input-port
+               "This is a journey\r\nInto the sound\r\nA journey ...\n")))
+    (get-string-all (canonical-newline-port port))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))