summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2018-05-24 02:34:08 -0400
committerMark H Weaver <mhw@netris.org>2018-05-24 02:34:08 -0400
commit9d10a63402e3c3dcda288b9370d04568dfa20ea6 (patch)
tree12705e0e3752f73d309a0387bb75674e83d33062 /tests
parent4935701a4a31212e0cf1b2375832fb7ecd3d8809 (diff)
parent11c237f54e4de5916e204aba574ab15f7818a3f5 (diff)
downloadguix-9d10a63402e3c3dcda288b9370d04568dfa20ea6.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/records.scm30
1 files changed, 29 insertions, 1 deletions
diff --git a/tests/records.scm b/tests/records.scm
index d6d27bb96a..80e08a9a5f 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -288,6 +288,34 @@
       (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)
+      (lambda (key rtd . _)
+        (eq? rtd (eval '<foo> module))))))
+
 (test-equal "recutils->alist"
   '((("Name" . "foo")
      ("Version" . "0.1")