mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
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.
This commit is contained in:
Andy Wingo
parent
53d4df80c9
commit
fe4a34d20d
11 changed files with 139 additions and 81 deletions
31
NEWS
31
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".
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
;;;
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;;; structs.test --- Structures. -*- mode: scheme; coding: utf-8; -*-
|
||||
;;;; Ludovic Courtès <ludo@gnu.org>, 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)))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue