records: Insert record type ABI checks in constructors.

* guix/records.scm (print-record-abi-mismatch-error): New procedure.
<top level>: Add 'set-exception-printer!' call.
(current-abi-identifier, abi-check): New procedures.
(make-syntactic-constructor): Add #:abi-cookie parameter.  Insert calls
to 'abi-check'.
(define-record-type*)[compute-abi-cookie]: New procedure.
Use it and emit a definition of the 'current-abi-identifier' for TYPE.
* tests/records.scm ("ABI checks"): New test.

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")