[jackhill/guix/guix.git] / tests / records.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 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-records)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (guix records))

(define (test-module)
  ;; A module in which to evaluate things that are known to fail.
  (let ((module (make-fresh-user-module)))
    (module-use! module (resolve-interface '(guix records)))
    module))

\f
(test-begin "records")

(test-assert "define-record-type*"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar)
      (baz foo-baz (default (+ 40 2))))
    (and (match (foo (bar 1) (baz 2))
           (($ <foo> 1 2) #t))
         (match (foo (baz 2) (bar 1))
           (($ <foo> 1 2) #t))
         (match (foo (bar 1))
           (($ <foo> 1 42) #t)))))

(test-assert "define-record-type* with let* behavior"
  ;; Make sure field initializers can refer to each other as if they were in
  ;; a 'let*'.
  (begin
    (define-record-type* <bar> bar make-bar
      foo?
      (x bar-x)
      (y bar-y (default (+ 40 2)))
      (z bar-z))
    (and (match (bar (x 1) (y (+ x 1)) (z (* y 2)))
           (($ <bar> 1 2 4) #t))
         (match (bar (x 7) (z (* x 3)))
           (($ <bar> 7 42 21) #t))
         (match (bar (z 21) (x (/ z 3)))
           (($ <bar> 7 42 21) #t)))))

(test-assert "define-record-type* & inherit"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar)
      (baz foo-baz (default (+ 40 2))))
    (let* ((a (foo (bar 1)))
           (b (foo (inherit a) (baz 2)))
           (c (foo (inherit b) (bar -2)))
           (d (foo (inherit c)))
           (e (foo (inherit (foo (bar 42))) (baz 77))))
     (and (match a (($ <foo> 1 42) #t))
          (match b (($ <foo> 1 2) #t))
          (match c (($ <foo> -2 2) #t))
          (equal? c d)
          (match e (($ <foo> 42 77) #t))))))

(test-assert "define-record-type* & inherit & let* behavior"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar)
      (baz foo-baz (default (+ 40 2))))
    (let* ((a (foo (bar 77)))
           (b (foo (inherit a) (bar 1) (baz (+ bar 1))))
           (c (foo (inherit b) (baz 2) (bar (- baz 1)))))
     (and (match a (($ <foo> 77 42) #t))
          (match b (($ <foo> 1 2) #t))
          (equal? b c)))))

(test-assert "define-record-type* & inherit & innate"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar (innate) (default 42)))
    (let* ((a (foo (bar 1)))
           (b (foo (inherit a)))
           (c (foo (inherit a) (bar 3)))
           (d (foo)))
      (and (match a (($ <foo> 1) #t))
           (match b (($ <foo> 42) #t))
           (match c (($ <foo> 3) #t))
           (match d (($ <foo> 42) #t))))))

(test-assert "define-record-type* & thunked"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar)
      (baz foo-baz (thunked)))

    (let* ((calls 0)
           (x     (foo (bar 2)
                       (baz (begin (set! calls (1+ calls)) 3)))))
      (and (zero? calls)
           (equal? (foo-bar x) 2)
           (equal? (foo-baz x) 3) (= 1 calls)
           (equal? (foo-baz x) 3) (= 2 calls)))))

(test-assert "define-record-type* & thunked & default"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar)
      (baz foo-baz (thunked) (default 42)))

    (let ((mark (make-parameter #f)))
      (let ((x (foo (bar 2) (baz (mark))))
            (y (foo (bar 2))))
        (and (equal? (foo-bar x) 2)
             (parameterize ((mark (cons 'a 'b)))
               (eq? (foo-baz x) (mark)))
             (equal? (foo-bar y) 2)
             (equal? (foo-baz y) 42))))))

(test-assert "define-record-type* & thunked & inherited"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar (thunked))
      (baz foo-baz (thunked) (default 42)))

    (let ((mark (make-parameter #f)))
      (let* ((x (foo (bar 2) (baz (mark))))
             (y (foo (inherit x) (bar (mark)))))
        (and (equal? (foo-bar x) 2)
             (parameterize ((mark (cons 'a 'b)))
               (eq? (foo-baz x) (mark)))
             (parameterize ((mark (cons 'a 'b)))
               (eq? (foo-bar y) (mark)))
             (parameterize ((mark (cons 'a 'b)))
               (eq? (foo-baz y) (mark))))))))

(test-assert "define-record-type* & thunked & innate"
  (let ((mark (make-parameter #f)))
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar (thunked) (innate) (default (mark)))
      (baz foo-baz (default #f)))

    (let* ((x (foo (bar 42)))
           (y (foo (inherit x) (baz 'unused))))
      (and (procedure? (struct-ref x 0))
           (equal? (foo-bar x) 42)
           (parameterize ((mark (cons 'a 'b)))
             (eq? (foo-bar y) (mark)))
           (parameterize ((mark (cons 'a 'b)))
             (eq? (foo-bar y) (mark)))))))

(test-assert "define-record-type* & delayed"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar (delayed)))

    (let* ((calls 0)
           (x     (foo (bar (begin (set! calls (1+ calls)) 3)))))
      (and (zero? calls)
           (equal? (foo-bar x) 3) (= 1 calls)
           (equal? (foo-bar x) 3) (= 1 calls)
           (equal? (foo-bar x) 3) (= 1 calls)))))

(test-assert "define-record-type* & delayed & default"
  (let ((mark #f))
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar (delayed) (default mark)))

    (let ((x (foo)))
      (set! mark 42)
      (and (equal? (foo-bar x) 42)
           (begin
             (set! mark 7)
             (equal? (foo-bar x) 42))))))

(test-assert "define-record-type* & delayed & inherited"
  (begin
    (define-record-type* <foo> foo make-foo
      foo?
      (bar foo-bar (delayed))
      (baz foo-baz (delayed)))

    (let* ((m 1)
           (n #f)
           (x (foo (bar m) (baz n)))
           (y (foo (inherit x) (baz 'b))))
      (set! n 'a)
      (and (equal? (foo-bar x) 1)
           (eq? (foo-baz x) 'a)
           (begin
             (set! m 777)
             (equal? (foo-bar y) 1))              ;promise was already forced
           (eq? (foo-baz y) 'b)))))

(test-assert "define-record-type* & wrong field specifier"
  (let ((exp '(begin
                (define-record-type* <foo> foo make-foo
                  foo?
                  (bar foo-bar (default 42))
                  (baz foo-baz))

                (foo (baz 1 2 3 4 5))))           ;syntax error
        (loc         (current-source-location)))  ;keep this alignment!
    (catch 'syntax-error
      (lambda ()
        (eval exp (test-module))
        #f)
      (lambda (key proc message location form . args)
        (and (eq? proc 'foo)
             (string-match "invalid field" message)
             (equal? form '(baz 1 2 3 4 5))

             ;; Make sure the location is that of the field specifier.
             ;; See <http://bugs.gnu.org/23969>.
             (lset= equal?
                    (pk 'expected-loc
                        `((line . ,(- (assq-ref loc 'line) 1))
                          ,@(alist-delete 'line loc)))
                    (pk 'actual-loc location)))))))

(test-assert "define-record-type* & missing initializers"
  (catch 'syntax-error
    (lambda ()
      (eval '(begin
               (define-record-type* <foo> foo make-foo
                 foo?
                 (bar foo-bar (default 42))
                 (baz foo-baz))

               (foo))
            (test-module))
      #f)
    (lambda (key proc message location form . args)
      (and (eq? proc 'foo)
           (string-match "missing .*initialize.*baz" message)
           (equal? form '(foo))))))

(test-assert "define-record-type* & extra initializers"
  (catch 'syntax-error
    (lambda ()
      (eval '(begin
               (define-record-type* <foo> foo make-foo
                 foo?
                 (bar foo-bar (default 42)))

               (foo (baz 'what?)))
            (test-module))
      #f)
    (lambda (key proc message location form . args)
      (and (string-match "extra.*initializer.*baz" message)
           (eq? proc 'foo)))))

(test-assert "define-record-type* & inherit & extra initializers"
  (catch 'syntax-error
    (lambda ()
      (eval '(begin
               (define-record-type* <foo> foo make-foo
                 foo?
                 (bar foo-bar (default 42)))

               (foo (inherit (foo)) (baz 'what?)))
            (test-module))
      #f)
    (lambda (key proc message location form . args)
      (and (string-match "extra.*initializer.*baz" message)
           (eq? proc 'foo)))))

(test-assert "ABI checks"
  (let ((module (test-module)))
    (eval '(begin
             (define-record-type* <foo> foo make-foo
               foo?
               (bar foo-bar (default 42)))

             (define (make-me-a-record) (foo)))
          module)
    (unless (eval '(foo? (make-me-a-record)) module)
      (error "what?" (eval '(make-me-a-record) module)))

    ;; Redefine <foo> with an additional field.
    (eval '(define-record-type* <foo> foo make-foo
             foo?
             (baz foo-baz)
             (bar foo-bar (default 42)))
          module)

    ;; Now 'make-me-a-record' is out of sync because it does an
    ;; 'allocate-struct' that corresponds to the previous definition of <foo>.
    (catch 'record-abi-mismatch-error
      (lambda ()
        (eval '(foo? (make-me-a-record)) module)
        #f)
      (match-lambda*
        ((key 'abi-check (? string? message) (rtd) . _)
         (eq? rtd (eval '<foo> module)))))))

(test-equal "recutils->alist"
  '((("Name" . "foo")
     ("Version" . "0.1")
     ("Synopsis" . "foo bar")
     ("Something_else" . "chbouib"))
    (("Name" . "bar")
     ("Version" . "1.5")))
  (let ((p (open-input-string "
# Comment following an empty line, and
# preceding a couple of empty lines, all of
# which should be silently consumed.


Name: foo
Version: 0.1
# Comment right in the middle,
# spanning two lines.
Synopsis: foo bar
Something_else: chbouib

# Comment right before.
Name: bar
Version: 1.5
# Comment at the end.")))
    (list (recutils->alist p)
          (recutils->alist p))))

(test-equal "recutils->alist with + lines"
  '(("Name" . "foo")
    ("Description" . "1st line,\n2nd line,\n 3rd line with extra space,\n4th line without space."))
  (recutils->alist (open-input-string "
Name: foo
Description: 1st line,
+ 2nd line,
+  3rd line with extra space,
+4th line without space.")))

(test-equal "alist->record" '((1 2) b c)
  (alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2))
                 list
                 '("a" "b" "c")
                 '("a")))

(test-end)
Commit	Line	Data
c0cd1b3e	1	;;; GNU Guix --- Functional package management for GNU
7874bbbb	2	;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
c0cd1b3e LC	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-records)
babc2c80	20	#:use-module (srfi srfi-1)
c0cd1b3e LC	21	#:use-module (srfi srfi-64)
c0cd1b3e LC	22	#:use-module (ice-9 match)
23e9a680	23	#:use-module (ice-9 regex)
c0cd1b3e LC	24	#:use-module (guix records))
c0cd1b3e LC	25
23e9a680 LC	26	(define (test-module)
	27	;; A module in which to evaluate things that are known to fail.
	28	(let ((module (make-fresh-user-module)))
	29	(module-use! module (resolve-interface '(guix records)))
	30	module))
	31
	32	\f
c0cd1b3e LC	33	(test-begin "records")
	34
	35	(test-assert "define-record-type*"
	36	(begin
	37	(define-record-type* <foo> foo make-foo
	38	foo?
	39	(bar foo-bar)
	40	(baz foo-baz (default (+ 40 2))))
	41	(and (match (foo (bar 1) (baz 2))
	42	(($ <foo> 1 2) #t))
	43	(match (foo (baz 2) (bar 1))
	44	(($ <foo> 1 2) #t))
	45	(match (foo (bar 1))
	46	(($ <foo> 1 42) #t)))))
	47
59fbeb8c	48	(test-assert "define-record-type* with let* behavior"
c0cd1b3e	49	;; Make sure field initializers can refer to each other as if they were in
59fbeb8c	50	;; a 'let*'.
c0cd1b3e LC	51	(begin
	52	(define-record-type* <bar> bar make-bar
	53	foo?
	54	(x bar-x)
	55	(y bar-y (default (+ 40 2)))
	56	(z bar-z))
	57	(and (match (bar (x 1) (y (+ x 1)) (z (* y 2)))
	58	(($ <bar> 1 2 4) #t))
	59	(match (bar (x 7) (z (* x 3)))
6c356414	60	(($ <bar> 7 42 21) #t))
c0cd1b3e	61	(match (bar (z 21) (x (/ z 3)))
a1906758	62	(($ <bar> 7 42 21) #t)))))
c0cd1b3e LC	63
	64	(test-assert "define-record-type* & inherit"
	65	(begin
	66	(define-record-type* <foo> foo make-foo
	67	foo?
	68	(bar foo-bar)
	69	(baz foo-baz (default (+ 40 2))))
	70	(let* ((a (foo (bar 1)))
	71	(b (foo (inherit a) (baz 2)))
	72	(c (foo (inherit b) (bar -2)))
	73	(d (foo (inherit c)))
	74	(e (foo (inherit (foo (bar 42))) (baz 77))))
	75	(and (match a (($ <foo> 1 42) #t))
	76	(match b (($ <foo> 1 2) #t))
	77	(match c (($ <foo> -2 2) #t))
	78	(equal? c d)
	79	(match e (($ <foo> 42 77) #t))))))
	80
59fbeb8c	81	(test-assert "define-record-type* & inherit & let* behavior"
c0cd1b3e LC	82	(begin
	83	(define-record-type* <foo> foo make-foo
	84	foo?
	85	(bar foo-bar)
	86	(baz foo-baz (default (+ 40 2))))
	87	(let* ((a (foo (bar 77)))
	88	(b (foo (inherit a) (bar 1) (baz (+ bar 1))))
	89	(c (foo (inherit b) (baz 2) (bar (- baz 1)))))
	90	(and (match a (($ <foo> 77 42) #t))
	91	(match b (($ <foo> 1 2) #t))
	92	(equal? b c)))))
	93
8a16d064 LC	94	(test-assert "define-record-type* & inherit & innate"
	95	(begin
	96	(define-record-type* <foo> foo make-foo
	97	foo?
	98	(bar foo-bar (innate) (default 42)))
	99	(let* ((a (foo (bar 1)))
	100	(b (foo (inherit a)))
	101	(c (foo (inherit a) (bar 3)))
	102	(d (foo)))
	103	(and (match a (($ <foo> 1) #t))
	104	(match b (($ <foo> 42) #t))
	105	(match c (($ <foo> 3) #t))
	106	(match d (($ <foo> 42) #t))))))
	107
c0cd1b3e LC	108	(test-assert "define-record-type* & thunked"
	109	(begin
	110	(define-record-type* <foo> foo make-foo
	111	foo?
	112	(bar foo-bar)
	113	(baz foo-baz (thunked)))
	114
	115	(let* ((calls 0)
	116	(x (foo (bar 2)
	117	(baz (begin (set! calls (1+ calls)) 3)))))
	118	(and (zero? calls)
	119	(equal? (foo-bar x) 2)
	120	(equal? (foo-baz x) 3) (= 1 calls)
	121	(equal? (foo-baz x) 3) (= 2 calls)))))
	122
	123	(test-assert "define-record-type* & thunked & default"
	124	(begin
	125	(define-record-type* <foo> foo make-foo
	126	foo?
	127	(bar foo-bar)
	128	(baz foo-baz (thunked) (default 42)))
	129
	130	(let ((mark (make-parameter #f)))
	131	(let ((x (foo (bar 2) (baz (mark))))
	132	(y (foo (bar 2))))
	133	(and (equal? (foo-bar x) 2)
	134	(parameterize ((mark (cons 'a 'b)))
	135	(eq? (foo-baz x) (mark)))
	136	(equal? (foo-bar y) 2)
	137	(equal? (foo-baz y) 42))))))
	138
	139	(test-assert "define-record-type* & thunked & inherited"
	140	(begin
	141	(define-record-type* <foo> foo make-foo
	142	foo?
	143	(bar foo-bar (thunked))
	144	(baz foo-baz (thunked) (default 42)))
	145
	146	(let ((mark (make-parameter #f)))
	147	(let* ((x (foo (bar 2) (baz (mark))))
	148	(y (foo (inherit x) (bar (mark)))))
	149	(and (equal? (foo-bar x) 2)
	150	(parameterize ((mark (cons 'a 'b)))
	151	(eq? (foo-baz x) (mark)))
	152	(parameterize ((mark (cons 'a 'b)))
	153	(eq? (foo-bar y) (mark)))
	154	(parameterize ((mark (cons 'a 'b)))
	155	(eq? (foo-baz y) (mark))))))))
	156
8a16d064 LC	157	(test-assert "define-record-type* & thunked & innate"
	158	(let ((mark (make-parameter #f)))
	159	(define-record-type* <foo> foo make-foo
	160	foo?
	161	(bar foo-bar (thunked) (innate) (default (mark)))
	162	(baz foo-baz (default #f)))
	163
	164	(let* ((x (foo (bar 42)))
	165	(y (foo (inherit x) (baz 'unused))))
	166	(and (procedure? (struct-ref x 0))
	167	(equal? (foo-bar x) 42)
	168	(parameterize ((mark (cons 'a 'b)))
	169	(eq? (foo-bar y) (mark)))
	170	(parameterize ((mark (cons 'a 'b)))
	171	(eq? (foo-bar y) (mark)))))))
	172
310b32a2 LC	173	(test-assert "define-record-type* & delayed"
	174	(begin
	175	(define-record-type* <foo> foo make-foo
	176	foo?
	177	(bar foo-bar (delayed)))
	178
	179	(let* ((calls 0)
	180	(x (foo (bar (begin (set! calls (1+ calls)) 3)))))
	181	(and (zero? calls)
	182	(equal? (foo-bar x) 3) (= 1 calls)
	183	(equal? (foo-bar x) 3) (= 1 calls)
	184	(equal? (foo-bar x) 3) (= 1 calls)))))
	185
	186	(test-assert "define-record-type* & delayed & default"
	187	(let ((mark #f))
	188	(define-record-type* <foo> foo make-foo
	189	foo?
	190	(bar foo-bar (delayed) (default mark)))
	191
	192	(let ((x (foo)))
	193	(set! mark 42)
	194	(and (equal? (foo-bar x) 42)
	195	(begin
	196	(set! mark 7)
	197	(equal? (foo-bar x) 42))))))
	198
	199	(test-assert "define-record-type* & delayed & inherited"
	200	(begin
	201	(define-record-type* <foo> foo make-foo
	202	foo?
	203	(bar foo-bar (delayed))
	204	(baz foo-baz (delayed)))
	205
	206	(let* ((m 1)
	207	(n #f)
	208	(x (foo (bar m) (baz n)))
	209	(y (foo (inherit x) (baz 'b))))
	210	(set! n 'a)
	211	(and (equal? (foo-bar x) 1)
	212	(eq? (foo-baz x) 'a)
	213	(begin
	214	(set! m 777)
	215	(equal? (foo-bar y) 1)) ;promise was already forced
	216	(eq? (foo-baz y) 'b)))))
	217
babc2c80 LC	218	(test-assert "define-record-type* & wrong field specifier"
	219	(let ((exp '(begin
	220	(define-record-type* <foo> foo make-foo
	221	foo?
	222	(bar foo-bar (default 42))
	223	(baz foo-baz))
	224
	225	(foo (baz 1 2 3 4 5)))) ;syntax error
	226	(loc (current-source-location))) ;keep this alignment!
	227	(catch 'syntax-error
	228	(lambda ()
	229	(eval exp (test-module))
	230	#f)
	231	(lambda (key proc message location form . args)
	232	(and (eq? proc 'foo)
	233	(string-match "invalid field" message)
	234	(equal? form '(baz 1 2 3 4 5))
	235
	236	;; Make sure the location is that of the field specifier.
	237	;; See <http://bugs.gnu.org/23969>.
	238	(lset= equal?
	239	(pk 'expected-loc
	240	`((line . ,(- (assq-ref loc 'line) 1))
	241	,@(alist-delete 'line loc)))
	242	(pk 'actual-loc location)))))))
	243
23e9a680 LC	244	(test-assert "define-record-type* & missing initializers"
	245	(catch 'syntax-error
	246	(lambda ()
	247	(eval '(begin
	248	(define-record-type* <foo> foo make-foo
	249	foo?
	250	(bar foo-bar (default 42))
	251	(baz foo-baz))
	252
	253	(foo))
	254	(test-module))
	255	#f)
	256	(lambda (key proc message location form . args)
	257	(and (eq? proc 'foo)
	258	(string-match "missing .initialize.baz" message)
	259	(equal? form '(foo))))))
	260
	261	(test-assert "define-record-type* & extra initializers"
	262	(catch 'syntax-error
	263	(lambda ()
	264	(eval '(begin
	265	(define-record-type* <foo> foo make-foo
	266	foo?
	267	(bar foo-bar (default 42)))
	268
	269	(foo (baz 'what?)))
	270	(test-module))
	271	#f)
	272	(lambda (key proc message location form . args)
	273	(and (string-match "extra.initializer.baz" message)
	274	(eq? proc 'foo)))))
	275
a1906758 LC	276	(test-assert "define-record-type* & inherit & extra initializers"
	277	(catch 'syntax-error
	278	(lambda ()
	279	(eval '(begin
	280	(define-record-type* <foo> foo make-foo
	281	foo?
	282	(bar foo-bar (default 42)))
	283
	284	(foo (inherit (foo)) (baz 'what?)))
	285	(test-module))
	286	#f)
	287	(lambda (key proc message location form . args)
	288	(and (string-match "extra.initializer.baz" message)
	289	(eq? proc 'foo)))))
	290
7874bbbb LC	291	(test-assert "ABI checks"
	292	(let ((module (test-module)))
	293	(eval '(begin
	294	(define-record-type* <foo> foo make-foo
	295	foo?
	296	(bar foo-bar (default 42)))
	297
	298	(define (make-me-a-record) (foo)))
	299	module)
	300	(unless (eval '(foo? (make-me-a-record)) module)
	301	(error "what?" (eval '(make-me-a-record) module)))
	302
	303	;; Redefine <foo> with an additional field.
	304	(eval '(define-record-type* <foo> foo make-foo
	305	foo?
	306	(baz foo-baz)
	307	(bar foo-bar (default 42)))
	308	module)
	309
	310	;; Now 'make-me-a-record' is out of sync because it does an
	311	;; 'allocate-struct' that corresponds to the previous definition of <foo>.
	312	(catch 'record-abi-mismatch-error
	313	(lambda ()
	314	(eval '(foo? (make-me-a-record)) module)
	315	#f)
8e1395be LC	316	(match-lambda*
	317	((key 'abi-check (? string? message) (rtd) . _)
	318	(eq? rtd (eval '<foo> module)))))))
7874bbbb	319
fdc1bf65 LC	320	(test-equal "recutils->alist"
	321	'((("Name" . "foo")
	322	("Version" . "0.1")
	323	("Synopsis" . "foo bar")
	324	("Something_else" . "chbouib"))
	325	(("Name" . "bar")
	326	("Version" . "1.5")))
b7b88288 LC	327	(let ((p (open-input-string "
	328	# Comment following an empty line, and
	329	# preceding a couple of empty lines, all of
	330	# which should be silently consumed.
	331
	332
	333	Name: foo
fdc1bf65	334	Version: 0.1
b7b88288 LC	335	# Comment right in the middle,
b7b88288 LC	336	# spanning two lines.
fdc1bf65 LC	337	Synopsis: foo bar
	338	Something_else: chbouib
	339
b7b88288	340	# Comment right before.
fdc1bf65	341	Name: bar
b7b88288 LC	342	Version: 1.5
b7b88288 LC	343	# Comment at the end.")))
fdc1bf65 LC	344	(list (recutils->alist p)
	345	(recutils->alist p))))
	346
836d10f1 LC	347	(test-equal "recutils->alist with + lines"
	348	'(("Name" . "foo")
	349	("Description" . "1st line,\n2nd line,\n 3rd line with extra space,\n4th line without space."))
	350	(recutils->alist (open-input-string "
	351	Name: foo
	352	Description: 1st line,
	353	+ 2nd line,
	354	+ 3rd line with extra space,
	355	+4th line without space.")))
	356
c8772a7a LC	357	(test-equal "alist->record" '((1 2) b c)
	358	(alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2))
	359	list
	360	'("a" "b" "c")
	361	'("a")))
	362
c0cd1b3e	363	(test-end)