diff options
| author | Mark H Weaver <mhw@netris.org> | 2014-07-27 20:15:50 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2014-07-27 20:15:50 -0400 |
| commit | 33690ffde5af2c516bc6b2dd060ab9cf7ab88eb2 (patch) | |
| tree | d91daca5084dec6ede304d2c9ff1c376a740e416 /tests/utils.scm | |
| parent | 5c47b06b4370e7d6590b0c75404d694a52897293 (diff) | |
| parent | b9663471a87916f36b50af2a0f885f6f08dc3ed2 (diff) | |
| download | patches-33690ffde5af2c516bc6b2dd060ab9cf7ab88eb2.tar patches-33690ffde5af2c516bc6b2dd060ab9cf7ab88eb2.tar.gz | |
Merge branch 'master' into core-updates
Diffstat (limited to 'tests/utils.scm')
| -rw-r--r-- | tests/utils.scm | 35 |
1 files changed, 34 insertions, 1 deletions
diff --git a/tests/utils.scm b/tests/utils.scm index 8ad399f75c..611867ca09 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 © 2014 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,7 +26,8 @@ #: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 +120,37 @@ '(0 1 2 3))) list)) +(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"))) |