projects/guix·blob python-team · refs

101 lines · 4.5 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (test-size)
20 #:use-module (guix store)
21 #:use-module (guix monads)
22 #:use-module (guix packages)
23 #:use-module (guix derivations)
24 #:use-module (guix gexp)
25 #:use-module (guix tests)
26 #:use-module (guix scripts size)
27 #:use-module (gnu packages)
28 #:use-module (gnu packages bootstrap)
29 #:use-module (ice-9 match)
30 #:use-module (srfi srfi-1)
31 #:use-module (srfi srfi-64))
32
33
34(test-begin "size")
35
36(test-assertm "store-profile"
37 (mlet* %store-monad ((file1 (gexp->derivation "file1"
38 #~(symlink #$%bootstrap-guile
39 #$output)))
40 (file2 (text-file* "file2"
41 "the file => " file1)))
42 (define (matching-profile item)
43 (lambda (profile)
44 (string=? item (profile-file profile))))
45
46 (mbegin %store-monad
47 (built-derivations (list file2))
48 (mlet %store-monad ((profiles (store-profile
49 (list (derivation->output-path file2))))
50 (bash (interned-file
51 (search-bootstrap-binary
52 "bash" (%current-system)) "bash"
53 #:recursive? #t))
54 (guile (package->derivation %bootstrap-guile)))
55 (define (lookup-profile item)
56 (find (matching-profile (if (derivation? item)
57 (derivation->output-path item)
58 item))
59 profiles))
60
61 (letrec-syntax ((match* (syntax-rules (=>)
62 ((_ ((drv => profile) rest ...) body)
63 (match (lookup-profile drv)
64 ((? profile? profile)
65 (match* (rest ...) body))))
66 ((_ () body)
67 body))))
68 ;; Make sure we get all three profiles with sensible values.
69 (return (and (= (length profiles) 4)
70 (match* ((file1 => profile1)
71 (file2 => profile2)
72 (guile => profile3)
73 (bash => profile4)) ;dependency of GUILE
74 (and (> (profile-closure-size profile2) 0)
75 (= (profile-closure-size profile2)
76 (+ (profile-self-size profile1)
77 (profile-self-size profile2)
78 (profile-self-size profile3)
79 (profile-self-size profile4))))))))))))
80
81(test-assertm "store-profile with multiple items"
82 (mlet* %store-monad ((file1 (gexp->derivation "file1"
83 #~(symlink #$%bootstrap-guile
84 #$output)))
85 (file2 (text-file* "file2"
86 "the file => " file1)))
87 (mbegin %store-monad
88 (built-derivations (list file2))
89 (mlet %store-monad ((profiles (store-profile
90 (list (derivation->output-path file2)
91 (derivation->output-path file1))))
92 (reference (store-profile
93 (list (derivation->output-path file2)))))
94 (return (and (= (length profiles) 4)
95 (lset= equal? profiles reference)))))))
96
97(test-end "size")
98
99;;; Local Variables:
100;;; eval: (put 'match* 'scheme-indent-function 1)
101;;; End: