guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 07/08: Replace "pr" struct fields with "pw" fields


From: Andy Wingo
Subject: [Guile-commits] 07/08: Replace "pr" struct fields with "pw" fields
Date: Sat, 23 Sep 2017 09:57:02 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit 5870188eb4b6c4246569a1aaaf358bc8a9e6a65d
Author: Andy Wingo <address@hidden>
Date:   Sat Sep 23 15:16:04 2017 +0200

    Replace "pr" struct fields with "pw" fields
    
    * libguile/struct.h (SCM_VTABLE_BASE_LAYOUT): Layout is a "pr" field.
    * module/ice-9/boot-9.scm (record-type-vtable): Record vtable fields are
      writable.
      (<parameter>): "pw" fields.
    * module/oop/goops.scm (<class>, %compute-layout): <read-only> fields
      are "pw" underneath.
    * module/rnrs/records/procedural.scm (record-type-vtable)
      (record-constructor-vtable, make-record-type-descriptor): Use "pw"
      fields in vtables.
    * module/srfi/srfi-35.scm (%condition-type-vtable)
      (struct-layout-for-condition): "pw" fields in vtables.
    * test-suite/tests/goops.test:
    * test-suite/tests/structs.test: Use "pw" fields only.
    * benchmark-suite/benchmarks/structs.bm: Update for make-struct/no-tail,
      to use pw fields, and also to remove useless tests that the compiler
      would optimize away.
    * doc/ref/api-data.texi (Vtables): Add a note about the now-vestigial
      permissions character and update documentation.
      (Structure Basics, Meta-Vtables): Update examples.
    * libguile/hash.c (scm_i_struct_hash): Remove code that would handle
      opaque/self fields.
    * libguile/print.h (SCM_PRINT_STATE_LAYOUT): Use "pw" fields.
    * libguile/struct.c (scm_struct_init): Simplify check for hidden
      fields.
    * libguile/values.c (scm_init_values): Field is "pw".
---
 benchmark-suite/benchmarks/structs.bm | 35 ++++++++----------------------
 doc/ref/api-data.texi                 | 40 ++++++++++++++++++-----------------
 libguile/hash.c                       | 32 ++++++++++++----------------
 libguile/print.h                      |  2 +-
 libguile/struct.c                     | 25 +++++++++++-----------
 libguile/struct.h                     |  2 +-
 libguile/values.c                     |  4 ++--
 module/ice-9/boot-9.scm               |  4 ++--
 module/oop/goops.scm                  |  3 +--
 module/rnrs/records/procedural.scm    |  8 +++----
 module/srfi/srfi-35.scm               |  6 +++---
 test-suite/tests/goops.test           |  6 +++---
 test-suite/tests/structs.test         | 28 ++++++++++--------------
 13 files changed, 83 insertions(+), 112 deletions(-)

diff --git a/benchmark-suite/benchmarks/structs.bm 
b/benchmark-suite/benchmarks/structs.bm
index 65c8e97..465afbd 100644
--- a/benchmark-suite/benchmarks/structs.bm
+++ b/benchmark-suite/benchmarks/structs.bm
@@ -1,7 +1,7 @@
 ;;; -*- mode: scheme; coding: iso-8859-1; -*-
 ;;; Structs.
 ;;;
-;;; Copyright 2009 Free Software Foundation, Inc.
+;;; Copyright 2009, 2017 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -25,44 +25,27 @@
 (define iterations 2000000)
 
 (define vtable2
-  (make-vtable "prpr"))
+  (make-vtable "pwpw"))
 
 (define vtable7
-  (make-vtable (string-concatenate (make-list 7 "pr"))))
+  (make-vtable (string-concatenate (make-list 7 "pw"))))
 
 
 (with-benchmark-prefix "constructors"
 
-  (benchmark "make-struct2 (opcode)" iterations
-    (make-struct vtable2 0 1 2))
+  (benchmark "make-struct2" iterations
+    (make-struct/no-tail vtable2 1 2))
 
-  (benchmark "make-struct2 (procedure)" iterations
-    (let ((s make-struct))
-      (s vtable2 0 1 2)))
-
-  (benchmark "make-struct7 (opcode)" iterations
-    (make-struct vtable7 0 1 2 3 4 5 6 7))
-
-  (benchmark "make-struct7 (procedure)" iterations
-    (let ((s make-struct))
-      (s vtable7 0 1 2 3 4 5 6 7))))
+  (benchmark "make-struct7" iterations
+    (make-struct/no-tail vtable7 1 2 3 4 5 6 7)))
 
 
 (with-benchmark-prefix "pairs" ;; for comparison
-
-  (benchmark "cons (opcode)" iterations
+  (benchmark "cons" iterations
     (cons 1 2))
 
-  (benchmark "cons (procedure)" iterations
-    (let ((c cons))
-      (c 1 2)))
-
-  (benchmark "list (opcode)" iterations
+  (benchmark "list" iterations
     (list 1 2 3 4 5 6 7))
 
-  (benchmark "list (procedure)" iterations
-    (let ((l list))
-      (l 1 2 3 4 5 6 7)))
-
   (benchmark "make-list" iterations
     (make-list 7)))
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index e0f8be3..923d0f2 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -8787,22 +8787,24 @@ stands for ``uninterpreted'' (it's not treated as a 
Scheme value), or
 size), or all of these things.
 @end itemize
 
-The second letter for each field is a permission code,
-
address@hidden @bullet{}
address@hidden
address@hidden -- writable, the field can be read and written.
address@hidden
address@hidden -- read-only, the field can be read but not written.
address@hidden
address@hidden itemize
-
-Here are some examples.
+It used to be that the second letter for each field was a permission
+code, such as @code{w} for writable or @code{r} for read-only.  However
+over time structs have become more of a raw low-level facility; access
+control is better implemented as a layer on top.  After all,
address@hidden is a cross-cutting operator that can bypass
+abstractions made by higher-level record facilities; it's not generally
+safe (in the sense of abstraction-preserving) to expose
address@hidden to ``untrusted'' code, even if the fields happen to
+be writable.  Additionally, permission checks added overhead to every
+structure access in a way that couldn't be optimized out, hampering the
+ability of structs to act as a low-level building block.  For all of
+these reasons, all fields in Guile structs are now writable; attempting
+to make a read-only field will now issue a deprecation warning, and the
+field will be writable regardless.
 
 @example
-(make-vtable "pw")      ;; one writable field
-(make-vtable "prpw")    ;; one read-only and one writable
-(make-vtable "pwuwuw")  ;; one scheme and two uninterpreted
+(make-vtable "pw")      ;; one scheme field
+(make-vtable "pwuwuw")  ;; one scheme and two uninterpreted fields
 @end example
 
 The optional @var{print} argument is a function called by
@@ -8816,7 +8818,7 @@ The following print function for example shows the two 
fields of its
 structure.
 
 @example
-(make-vtable "prpw"
+(make-vtable "pwpw"
              (lambda (struct port)
                (format port "#<~a and ~a>"
                        (struct-ref struct 0)
@@ -8850,7 +8852,7 @@ new name for this functionality.
 For example,
 
 @example
-(define v (make-vtable "prpwpw"))
+(define v (make-vtable "pwpwpw"))
 (define s (make-struct/no-tail v 123 "abc" 456))
 (struct-ref s 0) @result{} 123
 (struct-ref s 1) @result{} "abc"
@@ -9032,11 +9034,11 @@ vtables with additional data:
 
 @example
 scheme@@(guile-user)> (struct-ref $3 vtable-index-layout)
-$6 = pruhsruhpwphuhuhprprpw
+$6 = pwuhuhpwphuhuhpwpwpw
 scheme@@(guile-user)> (struct-ref $4 vtable-index-layout)
-$7 = pruhsruhpwphuhuh
+$7 = pwuhuhpwphuhuh
 scheme@@(guile-user)> standard-vtable-fields 
-$8 = "pruhsruhpwphuhuh"
+$8 = "pwuhuhpwphuhuh"
 scheme@@(guile-user)> (struct-ref $2 vtable-offset-user)
 $9 = module
 @end example
diff --git a/libguile/hash.c b/libguile/hash.c
index 6047084..84285aa 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2014, 2015 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2014, 2015, 2017 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -240,25 +240,19 @@ scm_i_struct_hash (SCM obj, size_t depth)
   if (depth > 0)
     for (field_num = 0; field_num < struct_size; field_num++)
       {
-        int protection;
-
-        protection = scm_i_symbol_ref (layout, field_num * 2 + 1);
-        if (protection != 'h' && protection != 'o')
+        int type;
+        type = scm_i_symbol_ref (layout, field_num * 2);
+        switch (type)
           {
-            int type;
-            type = scm_i_symbol_ref (layout, field_num * 2);
-            switch (type)
-              {
-              case 'p':
-                hash ^= scm_raw_ihash (SCM_PACK (data[field_num]),
-                                       depth / 2);
-                break;
-              case 'u':
-                hash ^= scm_raw_ihashq (data[field_num]);
-                break;
-              default:
-                /* Ignore 's' fields.  */;
-              }
+          case 'p':
+            hash ^= scm_raw_ihash (SCM_PACK (data[field_num]),
+                                   depth / 2);
+            break;
+          case 'u':
+            hash ^= scm_raw_ihashq (data[field_num]);
+            break;
+          default:
+            abort ();
           }
       }
 
diff --git a/libguile/print.h b/libguile/print.h
index 11f533c..2cfc392 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -53,7 +53,7 @@ do { \
 #define SCM_COERCE_OUTPORT(p) \
   (SCM_PORT_WITH_PS_P (p) ? SCM_PORT_WITH_PS_PORT (p) : p)
 
-#define SCM_PRINT_STATE_LAYOUT "pruwuwuwuwuwpwuwuwurprpw"
+#define SCM_PRINT_STATE_LAYOUT "pwuwuwuwuwuwpwuwuwuwpwpw"
 typedef struct scm_print_state {
   SCM handle;                  /* Struct handle */
   int revealed;                 /* Has the state escaped to Scheme? */
diff --git a/libguile/struct.c b/libguile/struct.c
index 4ee5a81..eb2bfbb 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -67,9 +67,8 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 
0, 0,
            "strung together.  The first character of each pair describes a 
field\n"
            "type, the second a field protection.  Allowed types are 'p' for\n"
            "GC-protected Scheme data, 'u' for unprotected binary data.  \n"
-            "Allowed protections\n"
-           "are 'w' for mutable fields, 'h' for hidden fields, and\n"
-            "'r' for read-only fields.\n\n"
+            "Allowed protections are 'w' for normal fields or 'h' for \n"
+            "hidden fields.\n\n"
             "Hidden fields are writable, but they will not consume an 
initializer arg\n"
             "passed to @code{make-struct}. They are useful to add slots to a 
struct\n"
             "in a way that preserves backward-compatibility with existing 
calls to\n"
@@ -188,7 +187,12 @@ scm_is_valid_vtable_layout (SCM layout)
           {
           case 'w':
           case 'h':
+            break;
           case 'r':
+            scm_c_issue_deprecation_warning
+              ("Read-only struct fields are deprecated.  Implement access "
+               "control at a higher level instead, as structs no longer "
+               "enforce field permissions.");
             break;
           default:
             return 0;
@@ -293,7 +297,7 @@ scm_struct_init (SCM handle, SCM layout, size_t n_inits, 
scm_t_bits *inits)
          switch (scm_i_symbol_ref (layout, i))
            {
            case 'u':
-             if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
+             if (prot == 'h' || inits_idx == n_inits)
                *mem = 0;
              else
                {
@@ -303,7 +307,7 @@ scm_struct_init (SCM handle, SCM layout, size_t n_inits, 
scm_t_bits *inits)
              break;
 
            case 'p':
-             if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
+             if (prot == 'h' || inits_idx == n_inits)
                *mem = SCM_UNPACK (SCM_BOOL_F);
              else
                {
@@ -470,9 +474,8 @@ SCM_DEFINE (scm_make_struct_no_tail, "make-struct/no-tail", 
1, 0, 1,
            "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
            "The @var{init1}, @dots{} are optional arguments describing how\n"
            "successive fields of the structure should be initialized.\n"
-            "Only fields with protection 'r' or 'w' can be initialized.\n"
-            "Hidden fields (those with protection 'h') have to be manually\n"
-            "set.\n\n"
+            "Note that hidden fields (those with protection 'h') have to be\n"
+            "manually set.\n\n"
            "If fewer optional arguments than initializable fields are 
supplied,\n"
            "fields of type 'p' get default value #f while fields of type 'u' 
are\n"
            "initialized to 0.")
@@ -677,14 +680,10 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   else
     {
       SCM layout;
-      scm_t_wchar field_type, protection;
+      scm_t_wchar field_type;
 
       layout = SCM_STRUCT_LAYOUT (handle);
       field_type = scm_i_symbol_ref (layout, p * 2);
-      protection = scm_i_symbol_ref (layout, p * 2 + 1);
-
-      if (protection == 'r')
-        SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
 
       if (field_type == 'p')
         SCM_STRUCT_SLOT_SET (handle, p, val);
diff --git a/libguile/struct.h b/libguile/struct.h
index 32af8ab..58228da 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -55,7 +55,7 @@
 
 /* All vtables have the following fields. */
 #define SCM_VTABLE_BASE_LAYOUT                                          \
-  "pr" /* layout */                                                     \
+  "pw" /* layout */                                                     \
   "uh" /* flags */                                                     \
   "uh" /* finalizer */                                                  \
   "pw" /* printer */                                                    \
diff --git a/libguile/values.c b/libguile/values.c
index 2b2ec3f..f77a977 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011, 2012 Free Software 
Foundation, Inc.
+/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011, 2012, 2017 Free Software 
Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -141,7 +141,7 @@ scm_init_values (void)
 {
   SCM print = scm_c_define_gsubr ("%print-values", 2, 0, 0, print_values);
 
-  scm_values_vtable = scm_make_vtable (scm_from_locale_string ("pr"), print);
+  scm_values_vtable = scm_make_vtable (scm_from_locale_string ("pw"), print);
 
   scm_add_feature ("values");
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index c2d3a26..a735bf4 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1178,7 +1178,7 @@ VALUE."
 
 ;; 0: type-name, 1: fields, 2: constructor
 (define record-type-vtable
-  (let ((s (make-vtable (string-append standard-vtable-fields "prprpw")
+  (let ((s (make-vtable (string-append standard-vtable-fields "pwpwpw")
                         (lambda (s p)
                           (display "#<record-type " p)
                           (display (record-type-name s) p)
@@ -1328,7 +1328,7 @@ VALUE."
 
 (define <parameter>
   ;; Three fields: the procedure itself, the fluid, and the converter.
-  (make-struct/no-tail <applicable-struct-vtable> 'pwprpr))
+  (make-struct/no-tail <applicable-struct-vtable> 'pwpwpw))
 (set-struct-vtable-name! <parameter> '<parameter>)
 
 (define* (make-parameter init #:optional (conv (lambda (x) x)))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 39bff06..a8a02f5 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -309,7 +309,7 @@
                   ((_ (name) tail)
                    (string-append "pw" tail))
                   ((_ (name #:class <protected-read-only-slot>) tail)
-                   (string-append "pr" tail))
+                   (string-append "pw" tail))
                   ((_ (name #:class <hidden-slot>) tail)
                    (string-append "uh" tail))
                   ((_ (name #:class <protected-hidden-slot>) tail)
@@ -795,7 +795,6 @@ slots as we go."
                    ((subclass? type <protected-slot>) #\p)
                    (else #\u))
                   (cond
-                   ((subclass? type <read-only-slot>) #\r)
                    ((subclass? type <hidden-slot>) #\h)
                    (else #\w)))
           (values #\p #\w))))
diff --git a/module/rnrs/records/procedural.scm 
b/module/rnrs/records/procedural.scm
index 69c5d1c..cbcd4e5 100644
--- a/module/rnrs/records/procedural.scm
+++ b/module/rnrs/records/procedural.scm
@@ -80,13 +80,13 @@
   (define vtable-base-layout (symbol->string (struct-layout (make-vtable ""))))
 
   (define record-type-vtable 
-    (make-vtable (string-append vtable-base-layout "prprprprprprprprprpr")
+    (make-vtable (string-append vtable-base-layout "pwpwpwpwpwpwpwpwpwpw")
                 (lambda (obj port) 
                   (simple-format port "#<r6rs:record-type:~A>"
                                  (struct-ref obj rtd-index-name)))))
 
   (define record-constructor-vtable 
-    (make-vtable "prprpr"
+    (make-vtable "pwpwpw"
                 (lambda (obj port) 
                   (simple-format port "#<r6rs:record-constructor:~A>" 
                                  (struct-ref (struct-ref obj rctd-index-rtd)
@@ -97,7 +97,7 @@
   (define (make-record-type-descriptor name parent uid sealed? opaque? fields)
     (define fields-pair
       (let loop ((field-list (vector->list fields))
-                 (layout-sym 'pr)
+                 (layout-sym 'pw)
                  (layout-bit-field 0)
                  (counter 0))
         (if (null? field-list)
@@ -105,7 +105,7 @@
             (case (caar field-list)
               ((immutable) 
                (loop (cdr field-list)
-                     (symbol-append layout-sym 'pr) 
+                     (symbol-append layout-sym 'pw)
                      layout-bit-field 
                      (+ counter 1)))
               ((mutable)
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 4330320..626026d 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -47,7 +47,7 @@
 (define %condition-type-vtable
   ;; The vtable of all condition types.
   ;;   user fields:   id, parent, all-field-names
-  (let ((s (make-vtable (string-append standard-vtable-fields "prprpr")
+  (let ((s (make-vtable (string-append standard-vtable-fields "pwpwpw")
                         (lambda (ct port)
                           (format port "#<condition-type ~a ~a>"
                                   (condition-type-id ct)
@@ -92,11 +92,11 @@
   ;; Return a string denoting the layout required to hold the fields listed
   ;; in FIELD-NAMES.
   (let loop ((field-names field-names)
-            (layout      '("pr")))
+            (layout      '("pw")))
     (if (null? field-names)
        (string-concatenate/shared layout)
        (loop (cdr field-names)
-             (cons "pr" layout)))))
+             (cons "pw" layout)))))
 
 (define (print-condition c port)
   ;; Print condition C to PORT in a way similar to how records print:
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 390cd8c..4536a46 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -1,6 +1,6 @@
 ;;;; goops.test --- test suite for GOOPS                      -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014, 2015 
Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014, 2015, 
2017 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -148,7 +148,7 @@
     ;; Previously, `class-of' would fail for nameless structs, i.e., structs
     ;; for which `struct-vtable-name' is #f.
     (is-a? (class-of (make-vtable
-                      (string-append standard-vtable-fields "prprpr")))
+                      (string-append standard-vtable-fields "pwpwpw")))
            <class>))
 
   ;; Two cases: one for structs created before goops, one after.
@@ -157,7 +157,7 @@
          (class-of (current-module))))
   (pass-if "late vtable class cached"
     (let ((vtable (make-vtable
-                   (string-append standard-vtable-fields "prprpr"))))
+                   (string-append standard-vtable-fields "pwpwpw"))))
       (eq? (class-of vtable)
            (class-of vtable)))))
 
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index c18e421..3cbc67d 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -27,7 +27,7 @@
 ;;;
 
 (define ball-root
-  (make-vtable (string-append standard-vtable-fields "pr") 0))
+  (make-vtable (string-append standard-vtable-fields "pw") 0))
 
 (define (make-ball-type ball-color)
   (make-struct/no-tail ball-root
@@ -69,13 +69,7 @@
          ;; end of the vtable tower
          (eq? (struct-vtable <standard-vtable>) <standard-vtable>)))
 
-  (pass-if-exception "write-access denied"
-     exception:struct-set!-denied
-
-     ;; The first field of instances of BALL-ROOT is read-only.
-     (struct-set! red vtable-offset-user "blue"))
-
-  (pass-if "write-access granted"
+  (pass-if "write"
      (set-owner! (make-ball red "Bob") "Fred")
      #t)
 
@@ -98,7 +92,7 @@
 
   (pass-if-exception "struct-ref out-of-range"
      exception:out-of-range
-     (let* ((v (make-vtable "prpr"))
+     (let* ((v (make-vtable "pwpw"))
             (s (make-struct/no-tail v 'a 'b)))
        (struct-ref s 2)))
 
@@ -112,7 +106,7 @@
 (with-test-prefix "equal?"
 
   (pass-if "simple structs"
-     (let* ((vtable (make-vtable "pr"))
+     (let* ((vtable (make-vtable "pw"))
             (s1     (make-struct/no-tail vtable "hello"))
             (s2     (make-struct/no-tail vtable "hello")))
        (equal? s1 s2)))
@@ -130,21 +124,21 @@
 (with-test-prefix "hash"
 
   (pass-if "simple structs"
-    (let* ((v  (make-vtable "pr"))
+    (let* ((v  (make-vtable "pw"))
            (s1 (make-struct/no-tail v "hello"))
            (s2 (make-struct/no-tail v "hello")))
       (= (hash s1 7777) (hash s2 7777))))
 
   (pass-if "different structs"
-    (let* ((v  (make-vtable "pr"))
+    (let* ((v  (make-vtable "pw"))
            (s1 (make-struct/no-tail v "hello"))
            (s2 (make-struct/no-tail v "world")))
       (or (not (= (hash s1 7777) (hash s2 7777)))
           (throw 'unresolved))))
 
   (pass-if "different struct types"
-    (let* ((v1 (make-vtable "pr"))
-           (v2 (make-vtable "pr"))
+    (let* ((v1 (make-vtable "pw"))
+           (v2 (make-vtable "pw"))
            (s1 (make-struct/no-tail v1 "hello"))
            (s2 (make-struct/no-tail v2 "hello")))
       (or (not (= (hash s1 7777) (hash s2 7777)))
@@ -156,7 +150,7 @@
       (= (hash s1 7777) (hash s2 7777))))
 
   (pass-if "struct with weird fields"
-    (let* ((v  (make-vtable "prurph"))
+    (let* ((v  (make-vtable "pwuwph"))
            (s1 (make-struct/no-tail v "hello" 123 "invisible-secret1"))
            (s2 (make-struct/no-tail v "hello" 123 "invisible-secret2")))
       (= (hash s1 7777) (hash s2 7777))))
@@ -191,7 +185,7 @@
 (with-test-prefix "make-vtable"
 
   (pass-if "without printer"
-    (let* ((vtable (make-vtable "pwpr"))
+    (let* ((vtable (make-vtable "pwpw"))
           (struct (make-struct/no-tail vtable 'x 'y)))
       (and (eq? 'x (struct-ref struct 0))
           (eq? 'y (struct-ref struct 1)))))
@@ -201,7 +195,7 @@
       (define (print struct port)
        (display "hello" port))
        
-      (let* ((vtable (make-vtable "pwpr" print))
+      (let* ((vtable (make-vtable "pwpw" print))
             (struct (make-struct/no-tail vtable 'x 'y))
             (str    (call-with-output-string
                      (lambda (port)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]