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'.
This commit is contained in:
parent
39bee8a293
commit
fcc58db68b
|
@ -114,6 +114,7 @@ MODULES = \
|
||||||
guix/scripts/environment.scm \
|
guix/scripts/environment.scm \
|
||||||
guix/scripts/publish.scm \
|
guix/scripts/publish.scm \
|
||||||
guix/scripts/edit.scm \
|
guix/scripts/edit.scm \
|
||||||
|
guix/scripts/size.scm \
|
||||||
guix.scm \
|
guix.scm \
|
||||||
$(GNU_SYSTEM_MODULES)
|
$(GNU_SYSTEM_MODULES)
|
||||||
|
|
||||||
|
@ -192,7 +193,8 @@ SCM_TESTS = \
|
||||||
tests/syscalls.scm \
|
tests/syscalls.scm \
|
||||||
tests/gremlin.scm \
|
tests/gremlin.scm \
|
||||||
tests/lint.scm \
|
tests/lint.scm \
|
||||||
tests/publish.scm
|
tests/publish.scm \
|
||||||
|
tests/size.scm
|
||||||
|
|
||||||
if HAVE_GUILE_JSON
|
if HAVE_GUILE_JSON
|
||||||
|
|
||||||
|
|
1
doc.am
1
doc.am
|
@ -100,6 +100,7 @@ SUBCOMMANDS := \
|
||||||
publish \
|
publish \
|
||||||
pull \
|
pull \
|
||||||
refresh \
|
refresh \
|
||||||
|
size \
|
||||||
system
|
system
|
||||||
|
|
||||||
$(eval $(foreach subcommand,$(SUBCOMMANDS), \
|
$(eval $(foreach subcommand,$(SUBCOMMANDS), \
|
||||||
|
|
|
@ -203,14 +203,32 @@ standards, GNU Coding Standards}); you can check the commit history for
|
||||||
examples.
|
examples.
|
||||||
|
|
||||||
Before submitting a patch that adds or modifies a package definition,
|
Before submitting a patch that adds or modifies a package definition,
|
||||||
please run @code{guix lint @var{package}}, where @var{package} is the
|
please run through this check list:
|
||||||
|
|
||||||
|
@enumerate
|
||||||
|
@item
|
||||||
|
Run @code{guix lint @var{package}}, where @var{package} is the
|
||||||
name of the new or modified package, and fix any errors it reports
|
name of the new or modified package, and fix any errors it reports
|
||||||
(@pxref{Invoking guix lint}). In addition, please make sure the package
|
(@pxref{Invoking guix lint}).
|
||||||
builds on your platform, using @code{guix build @var{package}}. You may
|
|
||||||
also want to check that dependent package (if applicable) are not
|
@item
|
||||||
affected by the change; @code{guix refresh --list-dependent
|
Make sure the package builds on your platform, using @code{guix build
|
||||||
|
@var{package}}.
|
||||||
|
|
||||||
|
@item
|
||||||
|
Take a look at the profile reported by @command{guix size}
|
||||||
|
(@pxref{Invoking guix size}). This will allow you to notice references
|
||||||
|
to other packages unwillingly retained. It may also help determine
|
||||||
|
whether to split the package (@pxref{Packages with Multiple Outputs}),
|
||||||
|
and which optional dependencies should be used.
|
||||||
|
|
||||||
|
@item
|
||||||
|
For important changes, check that dependent package (if applicable) are
|
||||||
|
not affected by the change; @code{guix refresh --list-dependent
|
||||||
@var{package}} will help you do that (@pxref{Invoking guix refresh}).
|
@var{package}} will help you do that (@pxref{Invoking guix refresh}).
|
||||||
|
|
||||||
|
@end enumerate
|
||||||
|
|
||||||
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a
|
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a
|
||||||
subject. You may use your email client or the @command{git send-mail}
|
subject. You may use your email client or the @command{git send-mail}
|
||||||
command.
|
command.
|
||||||
|
|
|
@ -124,12 +124,13 @@ Defining Packages
|
||||||
Utilities
|
Utilities
|
||||||
|
|
||||||
* Invoking guix build:: Building packages from the command line.
|
* Invoking guix build:: Building packages from the command line.
|
||||||
* Invoking guix edit::
|
* Invoking guix edit:: Editing package definitions.
|
||||||
* Invoking guix download:: Downloading a file and printing its hash.
|
* Invoking guix download:: Downloading a file and printing its hash.
|
||||||
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
||||||
* Invoking guix import:: Importing package definitions.
|
* Invoking guix import:: Importing package definitions.
|
||||||
* Invoking guix refresh:: Updating package definitions.
|
* Invoking guix refresh:: Updating package definitions.
|
||||||
* Invoking guix lint:: Finding errors in package definitions.
|
* Invoking guix lint:: Finding errors in package definitions.
|
||||||
|
* Invoking guix size:: Profiling disk usage.
|
||||||
* Invoking guix environment:: Setting up development environments.
|
* Invoking guix environment:: Setting up development environments.
|
||||||
* Invoking guix publish:: Sharing substitutes.
|
* Invoking guix publish:: Sharing substitutes.
|
||||||
|
|
||||||
|
@ -1495,7 +1496,8 @@ graphical user interfaces (GUIs). The former depend solely on the C
|
||||||
library, whereas the latter depend on Tcl/Tk and the underlying X
|
library, whereas the latter depend on Tcl/Tk and the underlying X
|
||||||
libraries. In this case, we leave the command-line tools in the default
|
libraries. In this case, we leave the command-line tools in the default
|
||||||
output, whereas the GUIs are in a separate output. This allows users
|
output, whereas the GUIs are in a separate output. This allows users
|
||||||
who do not need the GUIs to save space.
|
who do not need the GUIs to save space. The @command{guix size} command
|
||||||
|
can help find out about such situations (@pxref{Invoking guix size}).
|
||||||
|
|
||||||
There are several such multiple-output packages in the GNU distribution.
|
There are several such multiple-output packages in the GNU distribution.
|
||||||
Other conventional output names include @code{lib} for libraries and
|
Other conventional output names include @code{lib} for libraries and
|
||||||
|
@ -1575,11 +1577,15 @@ as arguments.
|
||||||
|
|
||||||
@item --requisites
|
@item --requisites
|
||||||
@itemx -R
|
@itemx -R
|
||||||
|
@cindex closure
|
||||||
List the requisites of the store files passed as arguments. Requisites
|
List the requisites of the store files passed as arguments. Requisites
|
||||||
include the store files themselves, their references, and the references
|
include the store files themselves, their references, and the references
|
||||||
of these, recursively. In other words, the returned list is the
|
of these, recursively. In other words, the returned list is the
|
||||||
@dfn{transitive closure} of the store files.
|
@dfn{transitive closure} of the store files.
|
||||||
|
|
||||||
|
@xref{Invoking guix size}, for a tool to profile the size of an
|
||||||
|
element's closure.
|
||||||
|
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
Lastly, the following options allow you to check the integrity of the
|
Lastly, the following options allow you to check the integrity of the
|
||||||
|
@ -3271,6 +3277,7 @@ programming interface of Guix in a convenient way.
|
||||||
* Invoking guix import:: Importing package definitions.
|
* Invoking guix import:: Importing package definitions.
|
||||||
* Invoking guix refresh:: Updating package definitions.
|
* Invoking guix refresh:: Updating package definitions.
|
||||||
* Invoking guix lint:: Finding errors in package definitions.
|
* Invoking guix lint:: Finding errors in package definitions.
|
||||||
|
* Invoking guix size:: Profiling disk usage.
|
||||||
* Invoking guix environment:: Setting up development environments.
|
* Invoking guix environment:: Setting up development environments.
|
||||||
* Invoking guix publish:: Sharing substitutes.
|
* Invoking guix publish:: Sharing substitutes.
|
||||||
@end menu
|
@end menu
|
||||||
|
@ -3974,6 +3981,73 @@ and exit.
|
||||||
|
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
|
@node Invoking guix size
|
||||||
|
@section Invoking @command{guix size}
|
||||||
|
|
||||||
|
The @command{guix size} command helps package developers profile the
|
||||||
|
disk usage of packages. It is easy to overlook the impact of an
|
||||||
|
additional dependency added to a package, or the impact of using a
|
||||||
|
single output for a package that could easily be split (@pxref{Packages
|
||||||
|
with Multiple Outputs}). These are the typical issues that
|
||||||
|
@command{guix size} can highlight.
|
||||||
|
|
||||||
|
The command can be passed a package specification such as @code{gcc-4.8}
|
||||||
|
or @code{guile:debug}, or a file name in the store. Consider this
|
||||||
|
example:
|
||||||
|
|
||||||
|
@example
|
||||||
|
$ guix size coreutils
|
||||||
|
store item total self
|
||||||
|
/gnu/store/@dots{}-coreutils-8.23 70.0 13.9 19.8%
|
||||||
|
/gnu/store/@dots{}-gmp-6.0.0a 55.3 2.5 3.6%
|
||||||
|
/gnu/store/@dots{}-acl-2.2.52 53.7 0.5 0.7%
|
||||||
|
/gnu/store/@dots{}-attr-2.4.46 53.2 0.3 0.5%
|
||||||
|
/gnu/store/@dots{}-gcc-4.8.4-lib 52.9 15.7 22.4%
|
||||||
|
/gnu/store/@dots{}-glibc-2.21 37.2 37.2 53.1%
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@cindex closure
|
||||||
|
The store items listed here constitute the @dfn{transitive closure} of
|
||||||
|
Coreutils---i.e., Coreutils and all its dependencies, recursively---as
|
||||||
|
would be returned by:
|
||||||
|
|
||||||
|
@example
|
||||||
|
$ guix gc -R /gnu/store/@dots{}-coreutils-8.23
|
||||||
|
@end example
|
||||||
|
|
||||||
|
Here the output shows 3 columns next to store items. The first column,
|
||||||
|
labeled ``total'', shows the size in mebibytes (MiB) of the closure of
|
||||||
|
the store item---that is, its own size plus the size of all its
|
||||||
|
dependencies. The next column, labeled ``self'', shows the size of the
|
||||||
|
item itself. The last column shows the ratio of the item's size to the
|
||||||
|
space occupied by all the items listed here.
|
||||||
|
|
||||||
|
In this example, we see that the closure of Coreutils weighs in at
|
||||||
|
70@tie{}MiB, half of which is taken by libc. (That libc represents a
|
||||||
|
large fraction of the closure is not a problem @i{per se} because it is
|
||||||
|
always available on the system anyway.)
|
||||||
|
|
||||||
|
When the package passed to @command{guix size} is available in the
|
||||||
|
store, @command{guix size} queries the daemon to determine its
|
||||||
|
dependencies, and measures its size in the store, similar to @command{du
|
||||||
|
-ms --apparent-size} (@pxref{du invocation,,, coreutils, GNU
|
||||||
|
Coreutils}).
|
||||||
|
|
||||||
|
When the given package is @emph{not} in the store, @command{guix size}
|
||||||
|
reports information based on information about the available substitutes
|
||||||
|
(@pxref{Substitutes}). This allows it to profile disk usage of store
|
||||||
|
items that are not even on disk, only available remotely.
|
||||||
|
|
||||||
|
A single option is available:
|
||||||
|
|
||||||
|
@table @option
|
||||||
|
|
||||||
|
@item --system=@var{system}
|
||||||
|
@itemx -s @var{system}
|
||||||
|
Consider packages for @var{system}---e.g., @code{x86_64-linux}.
|
||||||
|
|
||||||
|
@end table
|
||||||
|
|
||||||
@node Invoking guix environment
|
@node Invoking guix environment
|
||||||
@section Invoking @command{guix environment}
|
@section Invoking @command{guix environment}
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,247 @@
|
||||||
|
;;; 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 (guix scripts size)
|
||||||
|
#:use-module (guix ui)
|
||||||
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix monads)
|
||||||
|
#:use-module (guix utils)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (gnu packages)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-9)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-37)
|
||||||
|
#:use-module (ice-9 ftw)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
|
#:export (profile?
|
||||||
|
profile-file
|
||||||
|
profile-self-size
|
||||||
|
profile-closure-size
|
||||||
|
store-profile
|
||||||
|
|
||||||
|
guix-size))
|
||||||
|
|
||||||
|
;; Size profile of a store item.
|
||||||
|
(define-record-type <profile>
|
||||||
|
(profile file self-size closure-size)
|
||||||
|
profile?
|
||||||
|
(file profile-file) ;store item
|
||||||
|
(self-size profile-self-size) ;size in bytes
|
||||||
|
(closure-size profile-closure-size)) ;size of dependencies in bytes
|
||||||
|
|
||||||
|
(define (file-size file)
|
||||||
|
"Return the size of bytes of FILE, entering it if FILE is a directory."
|
||||||
|
(file-system-fold (const #t)
|
||||||
|
(lambda (file stat result) ;leaf
|
||||||
|
(+ (stat:size stat) result))
|
||||||
|
(lambda (directory stat result) ;down
|
||||||
|
(+ (stat:size stat) result))
|
||||||
|
(lambda (directory stat result) ;up
|
||||||
|
result)
|
||||||
|
(lambda (file stat result) ;skip
|
||||||
|
result)
|
||||||
|
(lambda (file stat errno result)
|
||||||
|
(format (current-error-port)
|
||||||
|
"file-size: ~a: ~a~%" file
|
||||||
|
(strerror errno))
|
||||||
|
result)
|
||||||
|
0
|
||||||
|
file
|
||||||
|
lstat))
|
||||||
|
|
||||||
|
(define substitutable-path-info*
|
||||||
|
(store-lift substitutable-path-info))
|
||||||
|
|
||||||
|
(define (store-item-exists? item)
|
||||||
|
"Return #t if ITEM is in the store, and protect it from GC. Otherwise
|
||||||
|
return #f."
|
||||||
|
(lambda (store)
|
||||||
|
(add-temp-root store item)
|
||||||
|
(values (valid-path? store item) store)))
|
||||||
|
|
||||||
|
(define (file-size* item)
|
||||||
|
"Like 'file-size', but resort to information from substitutes if ITEM is not
|
||||||
|
in the store."
|
||||||
|
(mlet %store-monad ((exists? (store-item-exists? item)))
|
||||||
|
(if exists?
|
||||||
|
(return (file-size item))
|
||||||
|
(mlet %store-monad ((info (substitutable-path-info* (list item))))
|
||||||
|
(match info
|
||||||
|
((info)
|
||||||
|
;; The nar size is an approximation, but a good one.
|
||||||
|
(return (substitutable-nar-size info)))
|
||||||
|
(()
|
||||||
|
(leave (_ "no available substitute information for '~a'~%")
|
||||||
|
item)))))))
|
||||||
|
|
||||||
|
(define* (display-profile profile #:optional (port (current-output-port)))
|
||||||
|
"Display PROFILE, a list of PROFILE objects, to PORT."
|
||||||
|
(define MiB (expt 2 20))
|
||||||
|
|
||||||
|
(format port "~64a ~8a ~a\n"
|
||||||
|
(_ "store item") (_ "total") (_ "self"))
|
||||||
|
(let ((whole (reduce + 0 (map profile-self-size profile))))
|
||||||
|
(for-each (match-lambda
|
||||||
|
(($ <profile> name self total)
|
||||||
|
(format port "~64a ~6,1f ~6,1f ~5,1f%\n"
|
||||||
|
name (/ total MiB) (/ self MiB)
|
||||||
|
(* 100. (/ self whole 1.)))))
|
||||||
|
(sort profile
|
||||||
|
(match-lambda*
|
||||||
|
((($ <profile> _ _ total1) ($ <profile> _ _ total2))
|
||||||
|
(> total1 total2)))))))
|
||||||
|
|
||||||
|
(define display-profile*
|
||||||
|
(lift display-profile %store-monad))
|
||||||
|
|
||||||
|
(define (substitutable-requisites store item)
|
||||||
|
"Return the list of requisites of ITEM based on information available in
|
||||||
|
substitutes."
|
||||||
|
(let loop ((items (list item))
|
||||||
|
(result '()))
|
||||||
|
(match items
|
||||||
|
(()
|
||||||
|
(delete-duplicates result))
|
||||||
|
(items
|
||||||
|
(let ((info (substitutable-path-info store
|
||||||
|
(delete-duplicates items))))
|
||||||
|
(loop (remove (lambda (item) ;XXX: complexity
|
||||||
|
(member item result))
|
||||||
|
(append-map substitutable-references info))
|
||||||
|
(append (append-map substitutable-references info)
|
||||||
|
result)))))))
|
||||||
|
|
||||||
|
(define (requisites* item)
|
||||||
|
"Return as a monadic value the requisites of ITEMS, based either on the
|
||||||
|
information available in the local store or using information about
|
||||||
|
substitutes."
|
||||||
|
(lambda (store)
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
(values (substitutable-requisites store item)
|
||||||
|
store)))
|
||||||
|
(values (requisites store item) store))))
|
||||||
|
|
||||||
|
(define (store-profile item)
|
||||||
|
"Return as a monadic value a list of <profile> objects representing the
|
||||||
|
profile of ITEM and its requisites."
|
||||||
|
(mlet* %store-monad ((refs (>>= (requisites* item)
|
||||||
|
(lambda (refs)
|
||||||
|
(return (delete-duplicates
|
||||||
|
(cons item refs))))))
|
||||||
|
(sizes (mapm %store-monad
|
||||||
|
(lambda (item)
|
||||||
|
(>>= (file-size* item)
|
||||||
|
(lambda (size)
|
||||||
|
(return (cons item size)))))
|
||||||
|
refs)))
|
||||||
|
(define (dependency-size item)
|
||||||
|
(mlet %store-monad ((deps (requisites* item)))
|
||||||
|
(foldm %store-monad
|
||||||
|
(lambda (item total)
|
||||||
|
(return (+ (assoc-ref sizes item) total)))
|
||||||
|
0
|
||||||
|
(delete-duplicates (cons item deps)))))
|
||||||
|
|
||||||
|
(mapm %store-monad
|
||||||
|
(match-lambda
|
||||||
|
((item . size)
|
||||||
|
(mlet %store-monad ((dependencies (dependency-size item)))
|
||||||
|
(return (profile item size dependencies)))))
|
||||||
|
sizes)))
|
||||||
|
|
||||||
|
(define* (ensure-store-item spec-or-item
|
||||||
|
#:key dry-run?)
|
||||||
|
"Return a store file name. If SPEC-OR-ITEM is a store file name, return it
|
||||||
|
as is. Otherwise, assume SPEC-OR-ITEM is a package output specification such
|
||||||
|
as \"guile:debug\" or \"gcc-4.8\" and return its store file name."
|
||||||
|
(with-monad %store-monad
|
||||||
|
(if (store-path? spec-or-item)
|
||||||
|
(return spec-or-item)
|
||||||
|
(let-values (((package output)
|
||||||
|
(specification->package+output spec-or-item)))
|
||||||
|
(mlet %store-monad ((drv (package->derivation package)))
|
||||||
|
;; Note: we don't try building DRV like 'guix archive' does
|
||||||
|
;; because we don't have to since we can instead rely on
|
||||||
|
;; substitute meta-data.
|
||||||
|
(return (derivation->output-path drv output)))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Options.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define (show-help)
|
||||||
|
(display (_ "Usage: guix size [OPTION]... PACKAGE
|
||||||
|
Report the size of PACKAGE and its dependencies.\n"))
|
||||||
|
(display (_ "
|
||||||
|
-s, --system=SYSTEM consider packages for SYSTEM--e.g., \"i686-linux\""))
|
||||||
|
(newline)
|
||||||
|
(display (_ "
|
||||||
|
-h, --help display this help and exit"))
|
||||||
|
(display (_ "
|
||||||
|
-V, --version display version information and exit"))
|
||||||
|
(newline)
|
||||||
|
(show-bug-report-information))
|
||||||
|
|
||||||
|
(define %options
|
||||||
|
;; Specifications of the command-line options.
|
||||||
|
(list (option '(#\s "system") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'system arg
|
||||||
|
(alist-delete 'system result eq?))))
|
||||||
|
(option '(#\h "help") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-help)
|
||||||
|
(exit 0)))
|
||||||
|
(option '(#\V "version") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-version-and-exit "guix size")))))
|
||||||
|
|
||||||
|
(define %default-options
|
||||||
|
`((system . ,(%current-system))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Entry point.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define (guix-size . args)
|
||||||
|
(with-error-handling
|
||||||
|
(let* ((opts (parse-command-line args %options (list %default-options)))
|
||||||
|
(files (filter-map (match-lambda
|
||||||
|
(('argument . file) file)
|
||||||
|
(_ #f))
|
||||||
|
opts))
|
||||||
|
(system (assoc-ref opts 'system))
|
||||||
|
(dry-run? (assoc-ref opts 'dry-run?)))
|
||||||
|
(match files
|
||||||
|
(()
|
||||||
|
(leave (_ "missing store item argument\n")))
|
||||||
|
((file)
|
||||||
|
(with-store store
|
||||||
|
(run-with-store store
|
||||||
|
(mlet* %store-monad ((item (ensure-store-item file))
|
||||||
|
(profile (store-profile item)))
|
||||||
|
(display-profile* profile))
|
||||||
|
#:system system)))
|
||||||
|
((files ...)
|
||||||
|
(leave (_ "too many arguments\n")))))))
|
|
@ -17,6 +17,7 @@ guix/scripts/system.scm
|
||||||
guix/scripts/lint.scm
|
guix/scripts/lint.scm
|
||||||
guix/scripts/publish.scm
|
guix/scripts/publish.scm
|
||||||
guix/scripts/edit.scm
|
guix/scripts/edit.scm
|
||||||
|
guix/scripts/size.scm
|
||||||
guix/gnu-maintenance.scm
|
guix/gnu-maintenance.scm
|
||||||
guix/ui.scm
|
guix/ui.scm
|
||||||
guix/http-client.scm
|
guix/http-client.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:
|
Loading…
Reference in New Issue