diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2013-05-12 15:46:16 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2013-05-12 15:46:16 +0200 |
| commit | c0cd1b3ea7753fe2826f7a336019000df9dea96f (patch) | |
| tree | a7e376f68216dcd26eab06aea5ff529b483fea00 /tests/utils.scm | |
| parent | 9b1ef2f3232e7af111ba05353008ebd2f8955f02 (diff) | |
Move record utilities to (guix records).
* guix/utils.scm (define-record-type*): Move to...
* guix/records.scm: ... here. New file.
* guix/build-system.scm, guix/packages.scm: Use it.
* guix/gnu-maintenance.scm: Likewise.
(official-gnu-packages)[alist->record]: Remove.
* guix/scripts/substitute-binary.scm: Likewise.
(alist->record, object->fields): Remove.
* tests/utils.scm ("define-record-type*", "define-record-type* with
letrec* behavior", "define-record-type* & inherit",
"define-record-type* & inherit & letrec* behavior",
"define-record-type* & thunked", "define-record-type* & thunked &
default", "define-record-type* & thunked & inherited"): Move to...
* tests/records.scm: ... here. New file.
Diffstat (limited to 'tests/utils.scm')
| -rw-r--r-- | tests/utils.scm | 108 |
1 files changed, 0 insertions, 108 deletions
diff --git a/tests/utils.scm b/tests/utils.scm index f14412e61ea..c2fb2741930 100644 --- a/tests/utils.scm +++ b/tests/utils.scm | |||
| @@ -126,114 +126,6 @@ | |||
| 126 | (append pids1 pids2))) | 126 | (append pids1 pids2))) |
| 127 | (equal? (get-bytevector-all decompressed) data))))) | 127 | (equal? (get-bytevector-all decompressed) data))))) |
| 128 | 128 | ||
| 129 | (test-assert "define-record-type*" | ||
| 130 | (begin | ||
| 131 | (define-record-type* <foo> foo make-foo | ||
| 132 | foo? | ||
| 133 | (bar foo-bar) | ||
| 134 | (baz foo-baz (default (+ 40 2)))) | ||
| 135 | (and (match (foo (bar 1) (baz 2)) | ||
| 136 | (($ <foo> 1 2) #t)) | ||
| 137 | (match (foo (baz 2) (bar 1)) | ||
| 138 | (($ <foo> 1 2) #t)) | ||
| 139 | (match (foo (bar 1)) | ||
| 140 | (($ <foo> 1 42) #t))))) | ||
| 141 | |||
| 142 | (test-assert "define-record-type* with letrec* behavior" | ||
| 143 | ;; Make sure field initializers can refer to each other as if they were in | ||
| 144 | ;; a `letrec*'. | ||
| 145 | (begin | ||
| 146 | (define-record-type* <bar> bar make-bar | ||
| 147 | foo? | ||
| 148 | (x bar-x) | ||
| 149 | (y bar-y (default (+ 40 2))) | ||
| 150 | (z bar-z)) | ||
| 151 | (and (match (bar (x 1) (y (+ x 1)) (z (* y 2))) | ||
| 152 | (($ <bar> 1 2 4) #t)) | ||
| 153 | (match (bar (x 7) (z (* x 3))) | ||
| 154 | (($ <bar> 7 42 21))) | ||
| 155 | (match (bar (z 21) (x (/ z 3))) | ||
| 156 | (($ <bar> 7 42 21)))))) | ||
| 157 | |||
| 158 | (test-assert "define-record-type* & inherit" | ||
| 159 | (begin | ||
| 160 | (define-record-type* <foo> foo make-foo | ||
| 161 | foo? | ||
| 162 | (bar foo-bar) | ||
| 163 | (baz foo-baz (default (+ 40 2)))) | ||
| 164 | (let* ((a (foo (bar 1))) | ||
| 165 | (b (foo (inherit a) (baz 2))) | ||
| 166 | (c (foo (inherit b) (bar -2))) | ||
| 167 | (d (foo (inherit c))) | ||
| 168 | (e (foo (inherit (foo (bar 42))) (baz 77)))) | ||
| 169 | (and (match a (($ <foo> 1 42) #t)) | ||
| 170 | (match b (($ <foo> 1 2) #t)) | ||
| 171 | (match c (($ <foo> -2 2) #t)) | ||
| 172 | (equal? c d) | ||
| 173 | (match e (($ <foo> 42 77) #t)))))) | ||
| 174 | |||
| 175 | (test-assert "define-record-type* & inherit & letrec* behavior" | ||
| 176 | (begin | ||
| 177 | (define-record-type* <foo> foo make-foo | ||
| 178 | foo? | ||
| 179 | (bar foo-bar) | ||
| 180 | (baz foo-baz (default (+ 40 2)))) | ||
| 181 | (let* ((a (foo (bar 77))) | ||
| 182 | (b (foo (inherit a) (bar 1) (baz (+ bar 1)))) | ||
| 183 | (c (foo (inherit b) (baz 2) (bar (- baz 1))))) | ||
| 184 | (and (match a (($ <foo> 77 42) #t)) | ||
| 185 | (match b (($ <foo> 1 2) #t)) | ||
| 186 | (equal? b c))))) | ||
| 187 | |||
| 188 | (test-assert "define-record-type* & thunked" | ||
| 189 | (begin | ||
| 190 | (define-record-type* <foo> foo make-foo | ||
| 191 | foo? | ||
| 192 | (bar foo-bar) | ||
| 193 | (baz foo-baz (thunked))) | ||
| 194 | |||
| 195 | (let* ((calls 0) | ||
| 196 | (x (foo (bar 2) | ||
| 197 | (baz (begin (set! calls (1+ calls)) 3))))) | ||
| 198 | (and (zero? calls) | ||
| 199 | (equal? (foo-bar x) 2) | ||
| 200 | (equal? (foo-baz x) 3) (= 1 calls) | ||
| 201 | (equal? (foo-baz x) 3) (= 2 calls))))) | ||
| 202 | |||
| 203 | (test-assert "define-record-type* & thunked & default" | ||
| 204 | (begin | ||
| 205 | (define-record-type* <foo> foo make-foo | ||
| 206 | foo? | ||
| 207 | (bar foo-bar) | ||
| 208 | (baz foo-baz (thunked) (default 42))) | ||
| 209 | |||
| 210 | (let ((mark (make-parameter #f))) | ||
| 211 | (let ((x (foo (bar 2) (baz (mark)))) | ||
| 212 | (y (foo (bar 2)))) | ||
| 213 | (and (equal? (foo-bar x) 2) | ||
| 214 | (parameterize ((mark (cons 'a 'b))) | ||
| 215 | (eq? (foo-baz x) (mark))) | ||
| 216 | (equal? (foo-bar y) 2) | ||
| 217 | (equal? (foo-baz y) 42)))))) | ||
| 218 | |||
| 219 | (test-assert "define-record-type* & thunked & inherited" | ||
| 220 | (begin | ||
| 221 | (define-record-type* <foo> foo make-foo | ||
| 222 | foo? | ||
| 223 | (bar foo-bar (thunked)) | ||
| 224 | (baz foo-baz (thunked) (default 42))) | ||
| 225 | |||
| 226 | (let ((mark (make-parameter #f))) | ||
| 227 | (let* ((x (foo (bar 2) (baz (mark)))) | ||
| 228 | (y (foo (inherit x) (bar (mark))))) | ||
| 229 | (and (equal? (foo-bar x) 2) | ||
| 230 | (parameterize ((mark (cons 'a 'b))) | ||
| 231 | (eq? (foo-baz x) (mark))) | ||
| 232 | (parameterize ((mark (cons 'a 'b))) | ||
| 233 | (eq? (foo-bar y) (mark))) | ||
| 234 | (parameterize ((mark (cons 'a 'b))) | ||
| 235 | (eq? (foo-baz y) (mark)))))))) | ||
| 236 | |||
| 237 | ;; This is actually in (guix store). | 129 | ;; This is actually in (guix store). |
| 238 | (test-equal "store-path-package-name" | 130 | (test-equal "store-path-package-name" |
| 239 | "bash-4.2-p24" | 131 | "bash-4.2-p24" |
