From 23e9a68088364d2ad44608cf118bfd81faac1559 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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(-)

(limited to 'tests/records.scm')

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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; 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> 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-equal "recutils->alist"
   '((("Name" . "foo")
      ("Version" . "0.1")
-- 
cgit v1.2.3