[bug#31470] [PATCH 0/1] Insert record type ABI checks in constructors

[bug#31470] [PATCH 0/1] Insert record type ABI checks in constructors

[Ludovic Courtès]

Hello Guix,

Record type constructors and accessors are inlined, which is nice for
performance, but causes ABI breakage whenever we change a record type
definition and forget to recompile the files that use it.  In that case,
we get an obscure error, sometimes mentioning ‘allocate-struct’ (coming
from the record constructor), sometimes suggesting that the wrong field
of the record is picked up.

This patch introduces ABI checks everywhere a record type constructor is
used.  When an ABI mismatch is detected, a specific exception is raised:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix system vm gnu/system/examples/bare-bones.tmpl  -n
Backtrace:
          12 (apply-smob/1 #<catch-closure ec8c80>)
In ice-9/boot-9.scm:
    705:2 11 (call-with-prompt _ _ #<procedure default-prompt-handler (k proc)>)
In ice-9/eval.scm:
    619:8 10 (_ #(#(#<directory (guile-user) f76140>)))
In guix/ui.scm:
  1535:12  9 (run-guix-command _ . _)
In ice-9/boot-9.scm:
    829:9  8 (catch _ _ #<procedure 7f9c5e1468b8 at guix/ui.scm:586:2 (key c)> _)
    829:9  7 (catch _ _ #<procedure 7f9c5e1468d0 at guix/ui.scm:694:6 (key proc form…> …)
In guix/scripts/system.scm:
   1218:8  6 (_)
   1088:6  5 (process-action _ _ _)
In guix/store.scm:
  1443:24  4 (run-with-store _ _ #:guile-for-build _ #:system _ #:target _)
In guix/scripts/system.scm:
  1101:13  3 (_ _)
   799:18  2 (perform-action vm #<<operating-system> kernel: #<package linux-libre@4…> …)
In gnu/system/vm.scm:
   821:31  1 (system-qemu-image/shared-store-script #<<operating-system> kernel: #<p…> …)
    715:2  0 (virtualized-operating-system _ _ _)

gnu/system/vm.scm:715:2: In procedure virtualized-operating-system:
ERROR: #<record-type <operating-system>>: record ABI mismatch; recompilation needed
--8<---------------cut here---------------end--------------->8---

In this case that’s because I modified <operating-system> without
recompiling gnu/system/vm.scm.  Once I’ve rebuilt it, everything is
alright.

The shortcoming of the approach is that accessors do not perform these
ABI checks, so we can still silently miss ABI mismatch issues, but I
think it would be too costly to do that.  The overhead of those checks
in constructors is probably OK since we’re allocating anyway.

This is what constructors now expand to:

--8<---------------cut here---------------start------------->8---
scheme@(guix records)> (define-record-type* <thing> thing make-thing
    thing?
    (name  thing-name (default 32))
    (port  thing-port
           (default (current-output-port)) (thunked)))
scheme@(guix records)> ,optimize (thing)
$40 = (begin
  (if (eq? #{% <thing> abi-cookie}# 1515259617)
    (if #f #f)
    (throw 'record-abi-mismatch-error <thing>))
  (let ((s (allocate-struct <thing> 2)))
    (struct-set! s 0 32)
    (struct-set!
      s
      1
      (lambda () (current-output-port)))
    s))
--8<---------------cut here---------------end--------------->8---

Thoughts?

Ludo’.

Ludovic Courtès (1):
  records: Insert record type ABI checks in constructors.

 guix/records.scm  | 54 ++++++++++++++++++++++++++++++++++++++++++++---
 tests/records.scm | 30 +++++++++++++++++++++++++-
 2 files changed, 80 insertions(+), 4 deletions(-)

-- 
2.17.0

[bug#31470] [PATCH 1/1] records: Insert record type ABI checks in constructors.

[Ludovic Courtès]

* 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.
---
 guix/records.scm  | 54 ++++++++++++++++++++++++++++++++++++++++++++---
 tests/records.scm | 30 +++++++++++++++++++++++++-
 2 files changed, 80 insertions(+), 4 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index c02395f2a..c71cfcfe3 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,13 +52,45 @@
       ((weird _ ...)                              ;weird!
        (syntax-violation name "invalid field specifier" #'weird)))))
 
+(define (print-record-abi-mismatch-error port key args
+                                         default-printer)
+  (match args
+    ((rtd . _)
+     ;; The source file where this exception is thrown must be recompiled.
+     (format port "ERROR: ~a: record ABI mismatch; recompilation needed"
+             rtd))))
+
+(set-exception-printer! 'record-abi-mismatch-error
+                        print-record-abi-mismatch-error)
+
+(define (current-abi-identifier type)
+  "Return an identifier unhygienically derived from TYPE for use as its
+\"current ABI\" variable."
+  (let ((type-name (syntax->datum type)))
+    (datum->syntax
+     type
+     (string->symbol
+      (string-append "% " (symbol->string type-name)
+                     " abi-cookie")))))
+
+(define (abi-check type cookie)
+  "Return syntax that checks that the current \"application binary
+interface\" (ABI) for TYPE is equal to COOKIE."
+  (with-syntax ((current-abi (current-abi-identifier type)))
+    #`(unless (eq? current-abi #,cookie)
+        (throw 'record-abi-mismatch-error #,type))))
+
 (define-syntax make-syntactic-constructor
   (syntax-rules ()
     "Make the syntactic constructor NAME for TYPE, that calls CTOR, and
 expects all of EXPECTED fields to be initialized.  DEFAULTS is the list of
 FIELD/DEFAULT-VALUE tuples, THUNKED is the list of identifiers of thunked
-fields, and DELAYED is the list of identifiers of delayed fields."
+fields, and DELAYED is the list of identifiers of delayed fields.
+
+ABI-COOKIE is the cookie (an integer) against which to check the run-time ABI
+of TYPE matches the expansion-time ABI."
     ((_ type name ctor (expected ...)
+        #:abi-cookie abi-cookie
         #:thunked thunked
         #:delayed delayed
         #:innate innate
@@ -130,6 +162,7 @@ fields, and DELAYED is the list of identifiers of delayed fields."
          (syntax-case s (inherit expected ...)
            ((_ (inherit orig-record) (field value) (... ...))
             #`(let* #,(field-bindings #'((field value) (... ...)))
+                #,(abi-check #'type abi-cookie)
                 #,(record-inheritance #'orig-record
                                       #'((field value) (... ...)))))
            ((_ (field value) (... ...))
@@ -144,6 +177,7 @@ fields, and DELAYED is the list of identifiers of delayed fields."
                 (cond ((lset= eq? fields '(expected ...))
                        #`(let* #,(field-bindings
                                   #'((field value) (... ...)))
+                           #,(abi-check #'type abi-cookie)
                            (ctor #,@(map field-value '(expected ...)))))
                       ((pair? (lset-difference eq? fields
                                                '(expected ...)))
@@ -270,6 +304,16 @@ inherited."
                ;; The real value of that field is a promise, so force it.
                (force (real-get x)))))))
 
+    (define (compute-abi-cookie field-specs)
+      ;; Compute an "ABI cookie" for the given FIELD-SPECS.  We use
+      ;; 'string-hash' because that's a better hash function that 'hash' on a
+      ;; list of symbols.
+      (syntax-case field-specs ()
+        (((field get properties ...) ...)
+         (string-hash (object->string
+                       (syntax->datum #'((field properties ...) ...)))
+                      most-positive-fixnum))))
+
     (syntax-case s ()
       ((_ type syntactic-ctor ctor pred
           (field get properties ...) ...)
@@ -278,7 +322,8 @@ inherited."
               (delayed    (filter-map delayed-field? field-spec))
               (innate     (filter-map innate-field? field-spec))
               (defaults   (filter-map field-default-value
-                                      #'((field properties ...) ...))))
+                                      #'((field properties ...) ...)))
+              (cookie     (compute-abi-cookie field-spec)))
          (with-syntax (((field-spec* ...)
                         (map field-spec->srfi-9 field-spec))
                        ((thunked-field-accessor ...)
@@ -298,10 +343,13 @@ inherited."
                  (ctor field ...)
                  pred
                  field-spec* ...)
+               (define #,(current-abi-identifier #'type)
+                 #,cookie)
                thunked-field-accessor ...
                delayed-field-accessor ...
                (make-syntactic-constructor type syntactic-ctor ctor
                                            (field ...)
+                                           #:abi-cookie #,cookie
                                            #:thunked #,thunked
                                            #:delayed #,delayed
                                            #:innate #,innate
diff --git a/tests/records.scm b/tests/records.scm
index d6d27bb96..80e08a9a5 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")
-- 
2.17.0

bug#31470: [PATCH 1/1] records: Insert record type ABI checks in constructors.

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

> * 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.

Pushed as 7874bbbb9f09cc14ea3e179fd0fa10da5f90cfc7.

Ludo’.