From 23e9a68088364d2ad44608cf118bfd81faac1559 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 17 Jul 2014 16:06:36 +0200 Subject: records: Add tests for error cases. * tests/records.scm (test-module): New procedure. ("define-record-type* & missing initializers", "define-record-type* & extra initializers"): New tests. --- tests/records.scm | 42 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 41 insertions(+), 1 deletion(-) diff --git a/tests/records.scm b/tests/records.scm index 15709ac326..23c0786e9e 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,8 +19,16 @@ (define-module (test-records) #: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)) + + (test-begin "records") (test-assert "define-record-type*" @@ -131,6 +139,38 @@ (parameterize ((mark (cons 'a 'b))) (eq? (foo-baz y) (mark)))))))) +(test-assert "define-record-type* & missing initializers" + (catch 'syntax-error + (lambda () + (eval '(begin + (define-record-type* 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 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-equal "recutils->alist" '((("Name" . "foo") ("Version" . "0.1") -- cgit 1.4.1