<
aboutsummaryrefslogtreecommitdiff
generated by cgit
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 subform . _) (and (eq? proc 'foo) (string-match "invalid field" message) (equal? subform '(baz 1 2 3 4 5)) (equal? form '(foo (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* & wrong field specifier, identifier" (let ((exp '(begin (define-record-type* <foo> foo make-foo foo? (bar foo-bar (default 42)) (baz foo-baz)) (foo baz))) ;syntax error (loc (current-source-location))) ;keep this alignment! (catch 'syntax-error (lambda () (eval exp (test-module)) #f) (lambda (key proc message location form subform . _) (and (eq? proc 'foo) (string-match "invalid field" message) (equal? subform 'baz) (equal? form '(foo baz)) ;; Here the location is that of the parent form. (lset= equal? (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 2)) ,@(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 "define-record-type* & duplicate initializers" (let ((exp '(begin (define-record-type* <foo> foo make-foo foo? (bar foo-bar (default 42))) (foo (bar 1) (bar 2)))) (loc (current-source-location))) ;keep this alignment! (catch 'syntax-error (lambda () (eval exp (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "duplicate.*initializer" message) (eq? proc 'foo) ;; Make sure the location is that of the field specifier. (lset= equal? (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 1)) ,@(alist-delete 'line loc))) (pk 'actual-loc location))))))) (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)
generated by cgit