guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] 04/07: Deprecate make-struct


From: Andy Wingo
Subject: [Guile-commits] 04/07: Deprecate make-struct
Date: Fri, 22 Sep 2017 05:49:33 -0400 (EDT)

wingo pushed a commit to branch stable-2.2
in repository guile.

commit fe4a34d20d8342106a46fc2b842a892c17a11920
Author: Andy Wingo <address@hidden>
Date:   Fri Sep 22 10:25:38 2017 +0200

    Deprecate make-struct
    
    * libguile/struct.c: Replace uses of scm_make_struct with
      scm_make_struct_no_tail or scm_c_make_struct.
      (scm_make_struct_no_tail): Move this function to C instead of Scheme
      to be able to deprecate scm_make_struct.
    * libguile/struct.h (scm_make_struct_no_tail): New public declaration.
    * libguile/deprecated.h:
    * libguile/deprecated.c (scm_make_struct): Deprecate.
    * libguile/print.c:
    * libguile/procs.c:
    * libguile/stacks.c: Replace uses of scm_make_struct with
      scm_make_struct_no_tail.
    * test-suite/tests/coverage.test:
    * test-suite/tests/structs.test: Use make-struct/no-tail instead of
      make-struct.
    * NEWS: Add entry.
---
 NEWS                           | 31 +++++++++++++++++++
 libguile/deprecated.c          | 51 +++++++++++++++++++++++++++++-
 libguile/deprecated.h          |  6 +++-
 libguile/print.c               |  5 ++-
 libguile/procs.c               |  5 ++-
 libguile/stacks.c              |  4 +--
 libguile/struct.c              | 29 ++++++++---------
 libguile/struct.h              |  5 +--
 module/ice-9/boot-9.scm        |  8 -----
 test-suite/tests/coverage.test |  6 ++--
 test-suite/tests/structs.test  | 70 +++++++++++++++++-------------------------
 11 files changed, 139 insertions(+), 81 deletions(-)

diff --git a/NEWS b/NEWS
index 7ce583b..f13f40a 100644
--- a/NEWS
+++ b/NEWS
@@ -26,6 +26,37 @@ If you don't care whether the URI is a relative-ref or not, 
use
 In the future `uri?' will return a true value only for URIs that specify
 a scheme.
 
+** Tail arrays deprecated
+
+Guile's structures used to have a facility whereby each instance of a
+vtable can contain a variable-length tail array of values.  The length
+of the tail array was stored in the structure.  This facility was
+originally intended to allow C code to expose raw C structures with
+word-sized tail arrays to Scheme.
+
+However, the tail array facility was confusing and doesn't work very
+well.  It was very rarely used, but it insinuates itself into all
+invocations of `make-struct'.  For this reason the clumsily-named
+`make-struct/no-tail' procedure can actually be more elegant in actual
+use, because it doesn't have a random `0' argument stuck in the middle.
+
+Tail arrays also inhibit optimization by allowing instances to affect
+their shapes.  In the absence of tail arrays, all instances of a given
+vtable have the same number and kinds of fields.  This uniformity can be
+exploited by the runtime and the optimizer.  The presence of tail arrays
+make some of these optimizations more difficult.
+
+Finally, the tail array facility is ad-hoc and does not compose with the
+rest of Guile.  If a Guile user wants an array with user-specified
+length, it's best to use a vector.  It is more clear in the code, and
+the standard optimization techniques will do a good job with it.
+
+For all of these reasons, tail arrays are deprecated in Guile 2.2 and
+will be removed from Guile 3.0.  Likewise, `make-struct' /
+`scm_make_struct' is deprecated in favor of `make-struct/no-tail' /
+`scm_make_struct_no_tail'.  Perhaps one day we will be able to reclaim
+the `make-struct' name!
+
 * Bug fixes
 
 ** Enable GNU Readline 7.0's support for "bracketed paste".
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index cee6b1d..9d94bc2 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2,7 +2,7 @@
    deprecate something, move it here when that is feasible.
 */
 
-/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 
2015 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 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
@@ -26,6 +26,7 @@
 
 #define SCM_BUILDING_DEPRECATED_CODE
 
+#include <alloca.h>
 #include <sys/types.h>
 #include <unistd.h>
 
@@ -954,6 +955,54 @@ SCM_FDES_RANDOM_P (int fdes)
 
 
 
+SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, 
+            (SCM vtable, SCM tail_array_size, SCM init),
+           "Create a new structure.\n\n"
+           "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
+           "@var{tail_array_size} must be a non-negative integer.  If the 
layout\n"
+           "specification indicated by @var{vtable} includes a tail-array,\n"
+           "this is the number of elements allocated to that array.\n\n"
+           "The @var{init1}, @dots{} are optional arguments describing how\n"
+           "successive fields of the structure should be initialized.  Only 
fields\n"
+           "with protection 'r' or 'w' can be initialized, except for fields 
of\n"
+           "type 's', which are automatically initialized to point to the 
new\n"
+           "structure itself. Fields with protection 'o' can not be 
initialized by\n"
+           "Scheme programs.\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.")
+#define FUNC_NAME s_scm_make_struct
+{
+  size_t i, n_init;
+  long ilen;
+  scm_t_bits *v;
+
+  scm_c_issue_deprecation_warning
+    ("make-struct is deprecated.  Use make-struct/no-tail instead.");
+
+  SCM_VALIDATE_VTABLE (1, vtable);
+  ilen = scm_ilength (init);
+  if (ilen < 0)
+    SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL);
+  
+  n_init = (size_t)ilen;
+
+  /* best to use alloca, but init could be big, so hack to avoid a possible
+     stack overflow */
+  if (n_init < 64)
+    v = alloca (n_init * sizeof(scm_t_bits));
+  else
+    v = scm_gc_malloc (n_init * sizeof(scm_t_bits), "struct");
+
+  for (i = 0; i < n_init; i++, init = SCM_CDR (init))
+    v[i] = SCM_UNPACK (SCM_CAR (init));
+
+  return scm_c_make_structv (vtable, scm_to_size_t (tail_array_size), n_init, 
v);
+}
+#undef FUNC_NAME
+
+
+
 void
 scm_i_init_deprecated ()
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 2c49076..68cd654 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -5,7 +5,7 @@
 #ifndef SCM_DEPRECATED_H
 #define SCM_DEPRECATED_H
 
-/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 
2014, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 
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
@@ -274,6 +274,10 @@ SCM_DEPRECATED int SCM_FDES_RANDOM_P (int fdes);
 
 
 
+SCM_DEPRECATED SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/libguile/print.c b/libguile/print.c
index 7667d24..4d57a87 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 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
@@ -194,8 +194,7 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0,
 static SCM
 make_print_state (void)
 {
-  SCM print_state
-    = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
+  SCM print_state = scm_make_struct_no_tail (scm_print_state_vtable, SCM_EOL);
   scm_print_state *pstate = SCM_PRINT_STATE (print_state);
   pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
   pstate->ceiling = SCM_SIMPLE_VECTOR_LENGTH (pstate->ref_vect);
diff --git a/libguile/procs.c b/libguile/procs.c
index 08c5c35..2329f4a 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2010, 2011, 2012, 2013, 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
@@ -90,8 +90,7 @@ SCM_DEFINE (scm_make_procedure_with_setter, 
"make-procedure-with-setter", 2, 0,
 {
   SCM_VALIDATE_PROC (1, procedure);
   SCM_VALIDATE_PROC (2, setter);
-  return scm_make_struct (pws_vtable, SCM_INUM0,
-                          scm_list_2 (procedure, setter));
+  return scm_make_struct_no_tail (pws_vtable, scm_list_2 (procedure, setter));
 }
 #undef FUNC_NAME
 
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 9bd2db8..76e10fa 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
 /* A stack holds a frame chain
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 
2012, 2013, 2014 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 
2012, 2013, 2014, 2017 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -388,7 +388,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
   if (n > 0)
     {
       /* Make the stack object. */
-      SCM stack = scm_make_struct (scm_stack_type, SCM_INUM0, SCM_EOL);
+      SCM stack = scm_make_struct_no_tail (scm_stack_type, SCM_EOL);
       SCM_SET_STACK_LENGTH (stack, n);
       SCM_SET_STACK_ID (stack, scm_stack_id (obj));
       SCM_SET_STACK_FRAME (stack, scm_c_make_frame (kind, &frame));
diff --git a/libguile/struct.c b/libguile/struct.c
index 51c0f11..78099ac 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007,
- *   2008, 2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 1996-2001, 2003-2004, 2006-2013, 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
@@ -553,13 +553,10 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 
0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, 
-            (SCM vtable, SCM tail_array_size, SCM init),
+SCM_DEFINE (scm_make_struct_no_tail, "make-struct/no-tail", 1, 0, 1, 
+            (SCM vtable, SCM init),
            "Create a new structure.\n\n"
            "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
-           "@var{tail_array_size} must be a non-negative integer.  If the 
layout\n"
-           "specification indicated by @var{vtable} includes a tail-array,\n"
-           "this is the number of elements allocated to that array.\n\n"
            "The @var{init1}, @dots{} are optional arguments describing how\n"
            "successive fields of the structure should be initialized.  Only 
fields\n"
            "with protection 'r' or 'w' can be initialized, except for fields 
of\n"
@@ -569,7 +566,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
            "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.")
-#define FUNC_NAME s_scm_make_struct
+#define FUNC_NAME s_scm_make_struct_no_tail
 {
   size_t i, n_init;
   long ilen;
@@ -592,7 +589,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
   for (i = 0; i < n_init; i++, init = SCM_CDR (init))
     v[i] = SCM_UNPACK (SCM_CAR (init));
 
-  return scm_c_make_structv (vtable, scm_to_size_t (tail_array_size), n_init, 
v);
+  return scm_c_make_structv (vtable, 0, n_init, v);
 }
 #undef FUNC_NAME
 
@@ -638,9 +635,9 @@ SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
   if (SCM_UNBNDP (printer))
     printer = SCM_BOOL_F;
 
-  return scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
-                          scm_list_2 (scm_make_struct_layout (fields),
-                                      printer));
+  return scm_c_make_struct (scm_standard_vtable_vtable, 0, 2,
+                            SCM_UNPACK (scm_make_struct_layout (fields)),
+                            SCM_UNPACK (printer));
 }
 #undef FUNC_NAME
 
@@ -1002,8 +999,8 @@ scm_init_struct ()
   scm_define (name, scm_standard_vtable_vtable);
 
   scm_applicable_struct_vtable_vtable =
-    scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
-                     scm_list_1 (scm_make_struct_layout 
(required_vtable_fields)));
+    scm_c_make_struct (scm_standard_vtable_vtable, 0, 1,
+                       SCM_UNPACK (scm_make_struct_layout 
(required_vtable_fields)));
   name = scm_from_utf8_symbol ("<applicable-struct-vtable>");
   SCM_SET_VTABLE_FLAGS (scm_applicable_struct_vtable_vtable,
                         SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
@@ -1011,8 +1008,8 @@ scm_init_struct ()
   scm_define (name, scm_applicable_struct_vtable_vtable);
 
   scm_applicable_struct_with_setter_vtable_vtable =
-    scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
-                     scm_list_1 (scm_make_struct_layout 
(required_vtable_fields)));
+    scm_c_make_struct (scm_standard_vtable_vtable, 0, 1,
+                       SCM_UNPACK (scm_make_struct_layout 
(required_vtable_fields)));
   name = scm_from_utf8_symbol ("<applicable-struct-with-setter-vtable>");
   scm_set_struct_vtable_name_x 
(scm_applicable_struct_with_setter_vtable_vtable, name);
   SCM_SET_VTABLE_FLAGS (scm_applicable_struct_with_setter_vtable_vtable,
diff --git a/libguile/struct.h b/libguile/struct.h
index e8db316..257e40e 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -3,7 +3,8 @@
 #ifndef SCM_STRUCT_H
 #define SCM_STRUCT_H
 
-/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 
2012, 2013, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1999-2001, 2006-2013, 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
@@ -175,7 +176,7 @@ SCM_API SCM scm_make_struct_layout (SCM fields);
 SCM_API SCM scm_struct_p (SCM x);
 SCM_API SCM scm_struct_vtable_p (SCM x);
 SCM_INTERNAL SCM scm_allocate_struct (SCM vtable, SCM n_words);
-SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
+SCM_API SCM scm_make_struct_no_tail (SCM vtable, SCM init);
 SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits,
                                scm_t_bits init, ...);
 SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits,
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7f8962b..7127d73 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -208,14 +208,6 @@ This is handy for tracing function calls, e.g.:
 
 
 
-;;; {Structs}
-;;;
-
-(define (make-struct/no-tail vtable . args)
-  (apply make-struct vtable 0 args))
-
-
-
 ;;; {map and for-each}
 ;;;
 
diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test
index c1b417f..96d1744 100644
--- a/test-suite/tests/coverage.test
+++ b/test-suite/tests/coverage.test
@@ -1,6 +1,6 @@
 ;;;; coverage.test --- Code coverage.    -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015 Free Software 
Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2012, 2013, 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
@@ -248,9 +248,9 @@
              (zero? (procedure-execution-count data proc))))))
 
   (pass-if "applicable struct"
-    (let* ((<box> (make-struct <applicable-struct-vtable> 0 'pw))
+    (let* ((<box> (make-struct/no-tail <applicable-struct-vtable> 'pw))
            (proc  (lambda args (length args)))
-           (b     (make-struct <box> 0 proc)))
+           (b     (make-struct/no-tail <box> proc)))
       (let-values (((data result)
                     (with-code-coverage b)))
         (and (coverage-data? data)
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index 0e3b241..c18e421 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -1,7 +1,7 @@
 ;;;; structs.test --- Structures.      -*- mode: scheme; coding: utf-8; -*-
 ;;;; Ludovic Courtès <address@hidden>, 2006-06-12.
 ;;;;
-;;;; Copyright (C) 2006, 2007, 2009, 2010, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009, 2010, 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
@@ -30,13 +30,13 @@
   (make-vtable (string-append standard-vtable-fields "pr") 0))
 
 (define (make-ball-type ball-color)
-  (make-struct ball-root 0
-              (make-struct-layout "pw")
-              (lambda (ball port)
-                (format port "#<a ~A ball owned by ~A>"
-                        (color ball)
-                        (owner ball)))
-              ball-color))
+  (make-struct/no-tail ball-root
+                       (make-struct-layout "pw")
+                       (lambda (ball port)
+                         (format port "#<a ~A ball owned by ~A>"
+                                 (color ball)
+                                 (owner ball)))
+                       ball-color))
 
 (define (color ball) (struct-ref (struct-vtable ball) vtable-offset-user))
 (define (owner ball) (struct-ref ball 0))
@@ -45,7 +45,7 @@
 (define red (make-ball-type 'red))
 (define green (make-ball-type 'green))
 
-(define (make-ball type owner) (make-struct type 0 owner))
+(define (make-ball type owner) (make-struct/no-tail type owner))
 
 
 
@@ -90,7 +90,7 @@
 
   (pass-if "struct-set!"
      (let* ((v (make-vtable "pw"))
-            (s (make-struct v 0))
+            (s (make-struct/no-tail v))
             (r (struct-set! s 0 'a)))
        (eq? r
             (struct-ref s 0)
@@ -99,13 +99,13 @@
   (pass-if-exception "struct-ref out-of-range"
      exception:out-of-range
      (let* ((v (make-vtable "prpr"))
-            (s (make-struct v 0 'a 'b)))
+            (s (make-struct/no-tail v 'a 'b)))
        (struct-ref s 2)))
 
   (pass-if-exception "struct-set! out-of-range"
      exception:out-of-range
      (let* ((v (make-vtable "pwpw"))
-            (s (make-struct v 0 'a 'b)))
+            (s (make-struct/no-tail v 'a 'b)))
        (struct-set! s 2 'c))))
 
 
@@ -113,8 +113,8 @@
 
   (pass-if "simple structs"
      (let* ((vtable (make-vtable "pr"))
-            (s1     (make-struct vtable 0 "hello"))
-            (s2     (make-struct vtable 0 "hello")))
+            (s1     (make-struct/no-tail vtable "hello"))
+            (s2     (make-struct/no-tail vtable "hello")))
        (equal? s1 s2)))
 
   (pass-if "more complex structs"
@@ -131,22 +131,22 @@
 
   (pass-if "simple structs"
     (let* ((v  (make-vtable "pr"))
-           (s1 (make-struct v 0 "hello"))
-           (s2 (make-struct v 0 "hello")))
+           (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"))
-           (s1 (make-struct v 0 "hello"))
-           (s2 (make-struct v 0 "world")))
+           (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"))
-           (s1 (make-struct v1 0 "hello"))
-           (s2 (make-struct v2 0 "hello")))
+           (s1 (make-struct/no-tail v1 "hello"))
+           (s2 (make-struct/no-tail v2 "hello")))
       (or (not (= (hash s1 7777) (hash s2 7777)))
           (throw 'unresolved))))
 
@@ -157,14 +157,14 @@
 
   (pass-if "struct with weird fields"
     (let* ((v  (make-vtable "prurph"))
-           (s1 (make-struct v 0 "hello" 123 "invisible-secret1"))
-           (s2 (make-struct v 0 "hello" 123 "invisible-secret2")))
+           (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))))
 
   (pass-if "cyclic structs"
     (let* ((v (make-vtable "pw"))
-           (a (make-struct v 0 #f))
-           (b (make-struct v 0 a)))
+           (a (make-struct/no-tail v #f))
+           (b (make-struct/no-tail v a)))
       (struct-set! a 0 b)
       (and (hash a 7777) (hash b 7777) #t))))
 
@@ -173,9 +173,6 @@
 ;; make-struct
 ;;
 
-(define exception:bad-tail
-  (cons 'misc-error "tail array not allowed unless"))
-
 (with-test-prefix "make-struct"
 
   ;; in guile 1.8.1 and earlier, this caused an error throw out of an
@@ -184,19 +181,8 @@
   ;;
   (pass-if-exception "wrong type for `u' field" exception:wrong-type-arg
     (let* ((vv (make-vtable standard-vtable-fields))
-          (v  (make-struct vv 0 (make-struct-layout "uw"))))
-      (make-struct v 0 'x)))
-
-  ;; In guile 1.8.1 and earlier, and 1.6.8 and earlier, there was no check
-  ;; on a tail array being created without an R/W/O type for it.  This left
-  ;; it uninitialized by scm_struct_init(), resulting in garbage getting
-  ;; into an SCM when struct-ref read it (and attempting to print a garbage
-  ;; SCM can cause a segv).
-  ;;
-  (pass-if-exception "no R/W/O for tail array" exception:bad-tail
-    (let* ((vv (make-vtable standard-vtable-fields))
-          (v  (make-struct vv 0 (make-struct-layout "pw"))))
-      (make-struct v 123 'x))))
+          (v  (make-struct/no-tail vv (make-struct-layout "uw"))))
+      (make-struct/no-tail v 'x))))
 
 ;;
 ;; make-vtable
@@ -206,7 +192,7 @@
 
   (pass-if "without printer"
     (let* ((vtable (make-vtable "pwpr"))
-          (struct (make-struct vtable 0 'x 'y)))
+          (struct (make-struct/no-tail vtable 'x 'y)))
       (and (eq? 'x (struct-ref struct 0))
           (eq? 'y (struct-ref struct 1)))))
 
@@ -216,7 +202,7 @@
        (display "hello" port))
        
       (let* ((vtable (make-vtable "pwpr" print))
-            (struct (make-struct vtable 0 'x 'y))
+            (struct (make-struct/no-tail vtable 'x 'y))
             (str    (call-with-output-string
                      (lambda (port)
                        (display struct port)))))



reply via email to

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