summaryrefslogtreecommitdiff
path: root/tests/size.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-18 00:22:13 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-18 00:36:09 +0200
commitfcc58db68b2af59dea0cae41bc1e2df47911d588 (patch)
tree1ef2ec63a3b7043de50716e651a49f2ae18dbccc /tests/size.scm
parent39bee8a2937ea28e74b5c807962fb8bc87fe6887 (diff)
downloadpatches-fcc58db68b2af59dea0cae41bc1e2df47911d588.tar
patches-fcc58db68b2af59dea0cae41bc1e2df47911d588.tar.gz
Add 'guix size'.
* guix/scripts/size.scm: New file. * Makefile.am (MODULES): Add it. (SCM_TESTS): Add tests/size.scm. * doc.am (SUBCOMMANDS): Add 'size'. * po/guix/POTFILES.in: Add guix/scripts/size.scm. * tests/size.scm: New file. * doc/guix.texi (Packages with Multiple Outputs): Add xref to "Invoking guix size". (Invoking guix size): New node. (Invoking guix gc): Add index for "closure" and xref to the above. * doc/contributing.texi (Submitting Patches): Use @enumerate for the check list. Add item about 'guix size'.
Diffstat (limited to 'tests/size.scm')
-rw-r--r--tests/size.scm87
1 files changed, 87 insertions, 0 deletions
diff --git a/tests/size.scm b/tests/size.scm
new file mode 100644
index 0000000000..95b99a88ef
--- /dev/null
+++ b/tests/size.scm
@@ -0,0 +1,87 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 (test-size)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
+ #:use-module (guix gexp)
+ #:use-module (guix tests)
+ #:use-module (guix scripts size)
+ #:use-module (gnu packages bootstrap)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64))
+
+(define %store
+ (open-connection-for-tests))
+
+(define-syntax-rule (test-assertm name exp)
+ (test-assert name
+ (run-with-store %store exp
+ #:guile-for-build (%guile-for-build))))
+
+
+(test-begin "size")
+
+(test-assertm "store-profile"
+ (mlet* %store-monad ((file1 (gexp->derivation "file1"
+ #~(symlink #$%bootstrap-guile
+ #$output)))
+ (file2 (text-file* "file2"
+ "the file => " file1)))
+ (define (matching-profile item)
+ (lambda (profile)
+ (string=? item (profile-file profile))))
+
+ (mbegin %store-monad
+ (built-derivations (list file2))
+ (mlet %store-monad ((profiles (store-profile
+ (derivation->output-path file2)))
+ (guile (package->derivation %bootstrap-guile)))
+ (define (lookup-profile drv)
+ (find (matching-profile (derivation->output-path drv))
+ profiles))
+
+ (letrec-syntax ((match* (syntax-rules (=>)
+ ((_ ((drv => profile) rest ...) body)
+ (match (lookup-profile drv)
+ ((? profile? profile)
+ (match* (rest ...) body))))
+ ((_ () body)
+ body))))
+ ;; Make sure we get all three profiles with sensible values.
+ (return (and (= (length profiles) 3)
+ (match* ((file1 => profile1)
+ (file2 => profile2)
+ (guile => profile3))
+ (and (> (profile-closure-size profile2) 0)
+ (= (profile-closure-size profile2)
+ (+ (profile-self-size profile1)
+ (profile-self-size profile2)
+ (profile-self-size profile3))))))))))))
+
+(test-end "size")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'match* 'scheme-indent-function 1)
+;;; End: