This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a38da400d7d7d65f1b2f667d80648816683ada8d The branch, master has been updated via a38da400d7d7d65f1b2f667d80648816683ada8d (commit) via 5f8d67ad09d21263d1ea2d537afcc5464d922dc5 (commit) via 581bd72a7d8346d32d02379d64b3012fdd6eef31 (commit) via 2921f537609547e7c9ee0df555a840407313eabd (commit) via 0bb1353a6b618f1b355da13b6b7c3b56b201a2dc (commit) via 66b1dbf649c82e34aa6d62a982cae3218419d160 (commit) via d192791373b79e905eb02f9c0b01413051a7b2f8 (commit) via 5d312f3c2c5db3a7677a9c8ec4306feabce8445f (commit) from 2aed2667fce5ccb115667a36ffd368c4c3b6e9f4 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a38da400d7d7d65f1b2f667d80648816683ada8d Merge: 2aed266 5f8d67a Author: Andy Wingo <[email protected]> Date: Fri Jul 6 19:28:06 2012 +0200 Merge remote-tracking branch 'origin/stable-2.0' This anticipates deprecation of make-vtable-vtable in stable-2.0, which hasn't happened yet. Conflicts: libguile/deprecated.c libguile/deprecated.h libguile/print.c libguile/struct.c ----------------------------------------------------------------------- Summary of changes: doc/ref/api-compound.texi | 18 ++----- libguile/struct.c | 112 +---------------------------------------- libguile/struct.h | 6 +-- test-suite/tests/web-uri.test | 73 ++++++++++++++------------- 4 files changed, 45 insertions(+), 164 deletions(-) diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index 6fc5b2e..78d6789 100644 --- a/doc/ref/api-compound.texi +++ b/doc/ref/api-compound.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -@c 2007, 2009, 2010, 2011 Free Software Foundation, Inc. +@c 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Compound Data Types @@ -2372,7 +2372,7 @@ to be stored along side usual Scheme @code{SCM} values. * Vtable Vtables:: @end menu -@node Vtables, Structure Basics, Structures, Structures +@node Vtables @subsubsection Vtables A vtable is a structure type, specifying its layout, and other @@ -2460,7 +2460,7 @@ structure. @end deffn -@node Structure Basics, Vtable Contents, Vtables, Structures +@node Structure Basics @subsubsection Structure Basics This section describes the basic procedures for working with @@ -2542,7 +2542,7 @@ This can be used to examine the layout of an unknown structure, see @end deffn -@node Vtable Contents, Vtable Vtables, Structure Basics, Structures +@node Vtable Contents @subsubsection Vtable Contents A vtable is itself a structure, with particular fields that hold @@ -2614,16 +2614,8 @@ from @var{vtable}. @end example @end deffn -@deffn {Scheme Procedure} struct-vtable-tag vtable -@deffnx {C Function} scm_struct_vtable_tag (vtable) -Return the tag of the given @var{vtable}. -@c -@c FIXME: what can be said about what this means? -@c -@end deffn - -@node Vtable Vtables, , Vtable Contents, Structures +@node Vtable Vtables @subsubsection Vtable Vtables As noted above, a vtable is a structure and that structure is itself diff --git a/libguile/struct.c b/libguile/struct.c index e8182a2..fe6b042 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -561,108 +561,9 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, } #undef FUNC_NAME - - -#if SCM_ENABLE_DEPRECATED == 1 -SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, - (SCM user_fields, SCM tail_array_size, SCM init), - "Return a new, self-describing vtable structure.\n\n" - "@var{user-fields} is a string describing user defined fields of the\n" - "vtable beginning at index @code{vtable-offset-user}\n" - "(see @code{make-struct-layout}).\n\n" - "@var{tail_array_size} specifies the size of the tail-array (if any) of\n" - "this vtable.\n\n" - "@var{init1}, @dots{} are the optional initializers for the fields of\n" - "the vtable.\n\n" - "Vtables have one initializable system field---the struct printer.\n" - "This field comes before the user fields in the initializers passed\n" - "to @code{make-vtable-vtable} and @code{make-struct}, and thus works as\n" - "a third optional argument to @code{make-vtable-vtable} and a fourth to\n" - "@code{make-struct} when creating vtables:\n\n" - "If the value is a procedure, it will be called instead of the standard\n" - "printer whenever a struct described by this vtable is printed.\n" - "The procedure will be called with arguments STRUCT and PORT.\n\n" - "The structure of a struct is described by a vtable, so the vtable is\n" - "in essence the type of the struct. The vtable is itself a struct with\n" - "a vtable. This could go on forever if it weren't for the\n" - "vtable-vtables which are self-describing vtables, and thus terminate\n" - "the chain.\n\n" - "There are several potential ways of using structs, but the standard\n" - "one is to use three kinds of structs, together building up a type\n" - "sub-system: one vtable-vtable working as the root and one or several\n" - "\"types\", each with a set of \"instances\". (The vtable-vtable should be\n" - "compared to the class <class> which is the class of itself.)\n\n" - "@lisp\n" - "(define ball-root (make-vtable-vtable \"pr\" 0))\n\n" - "(define (make-ball-type ball-color)\n" - " (make-struct ball-root 0\n" - " (make-struct-layout \"pw\")\n" - " (lambda (ball port)\n" - " (format port \"#<a ~A ball owned by ~A>\"\n" - " (color ball)\n" - " (owner ball)))\n" - " ball-color))\n" - "(define (color ball) (struct-ref (struct-vtable ball) vtable-offset-user))\n" - "(define (owner ball) (struct-ref ball 0))\n\n" - "(define red (make-ball-type 'red))\n" - "(define green (make-ball-type 'green))\n\n" - "(define (make-ball type owner) (make-struct type 0 owner))\n\n" - "(define ball (make-ball green 'Nisse))\n" - "ball @result{} #<a green ball owned by Nisse>\n" - "@end lisp") -#define FUNC_NAME s_scm_make_vtable_vtable -{ - SCM fields, layout, obj; - size_t basic_size, n_tail, i, n_init; - long ilen; - scm_t_bits *v; - - SCM_VALIDATE_STRING (1, user_fields); - 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 + 1; /* + 1 for the layout */ - - /* 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"); - - fields = scm_string_append (scm_list_2 (required_vtable_fields, - user_fields)); - layout = scm_make_struct_layout (fields); - if (!scm_is_valid_vtable_layout (layout)) - SCM_MISC_ERROR ("invalid user fields", scm_list_1 (user_fields)); - - basic_size = scm_i_symbol_length (layout) / 2; - n_tail = scm_to_size_t (tail_array_size); - - i = 0; - v[i++] = SCM_UNPACK (layout); - for (; i < n_init; i++, init = SCM_CDR (init)) - v[i] = SCM_UNPACK (SCM_CAR (init)); - - SCM_CRITICAL_SECTION_START; - obj = scm_i_alloc_struct (NULL, basic_size + n_tail); - /* Make it so that the vtable of OBJ is itself. */ - SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj) | scm_tc3_struct); - SCM_CRITICAL_SECTION_END; - - scm_struct_init (obj, layout, n_tail, n_init, v); - SCM_SET_VTABLE_FLAGS (obj, - SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED); - - return obj; -} -#undef FUNC_NAME -#endif - SCM scm_i_make_vtable_vtable (SCM user_fields) -#define FUNC_NAME s_scm_make_vtable_vtable +#define FUNC_NAME "make-vtable-vtable" { SCM fields, layout, obj; size_t basic_size; @@ -950,17 +851,6 @@ SCM_DEFINE (scm_struct_vtable, "struct-vtable", 1, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0, - (SCM handle), - "Return the vtable tag of the structure @var{handle}.") -#define FUNC_NAME s_scm_struct_vtable_tag -{ - SCM_VALIDATE_VTABLE (1, handle); - return scm_from_unsigned_integer - (((scm_t_bits)SCM_STRUCT_DATA (handle)) >> 3); -} -#undef FUNC_NAME - /* {Associating names and classes with vtables} * * The name of a vtable should probably be stored as a slot. This is diff --git a/libguile/struct.h b/libguile/struct.h index 3e2bc53..97b6768 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -3,7 +3,7 @@ #ifndef SCM_STRUCT_H #define SCM_STRUCT_H -/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012 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 @@ -181,13 +181,9 @@ SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits, scm_t_bits init[]); SCM_API SCM scm_make_vtable (SCM fields, SCM printer); SCM_INTERNAL SCM scm_i_make_vtable_vtable (SCM extra_fields); -#if SCM_ENABLE_DEPRECATED == 1 -SCM_DEPRECATED SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init); -#endif SCM_API SCM scm_struct_ref (SCM handle, SCM pos); SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val); SCM_API SCM scm_struct_vtable (SCM handle); -SCM_API SCM scm_struct_vtable_tag (SCM handle); SCM_API SCM scm_struct_vtable_name (SCM vtable); SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name); SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *); diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 7431025..4621a19 100644 --- a/test-suite/tests/web-uri.test +++ b/test-suite/tests/web-uri.test @@ -94,17 +94,18 @@ (uri=? (build-uri 'http #:host "1.good.host") #:scheme 'http #:host "1.good.host" #:path "")) - (pass-if "http://192.0.2.1" - (uri=? (build-uri 'http #:host "192.0.2.1") - #:scheme 'http #:host "192.0.2.1" #:path "")) + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (uri=? (build-uri 'http #:host "192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) - (pass-if "http://[2001:db8::1]" - (uri=? (build-uri 'http #:host "2001:db8::1") - #:scheme 'http #:host "2001:db8::1" #:path "")) + (pass-if "http://[2001:db8::1]" + (uri=? (build-uri 'http #:host "2001:db8::1") + #:scheme 'http #:host "2001:db8::1" #:path "")) - (pass-if "http://[::ffff:192.0.2.1]" - (uri=? (build-uri 'http #:host "::ffff:192.0.2.1") - #:scheme 'http #:host "::ffff:192.0.2.1" #:path "")) + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (build-uri 'http #:host "::ffff:192.0.2.1") + #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))) (pass-if-uri-exception "http://foo:not-a-port" "Expected.*port" @@ -155,24 +156,25 @@ (uri=? (string->uri "http://1.good.host") #:scheme 'http #:host "1.good.host" #:path "")) - (pass-if "http://192.0.2.1" - (uri=? (string->uri "http://192.0.2.1") - #:scheme 'http #:host "192.0.2.1" #:path "")) + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (uri=? (string->uri "http://192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) - (pass-if "http://[2001:db8::1]" - (uri=? (string->uri "http://[2001:db8::1]") - #:scheme 'http #:host "2001:db8::1" #:path "")) + (pass-if "http://[2001:db8::1]" + (uri=? (string->uri "http://[2001:db8::1]") + #:scheme 'http #:host "2001:db8::1" #:path "")) - (pass-if "http://[2001:db8::1]:80" - (uri=? (string->uri "http://[2001:db8::1]:80") - #:scheme 'http - #:host "2001:db8::1" - #:port 80 - #:path "")) + (pass-if "http://[2001:db8::1]:80" + (uri=? (string->uri "http://[2001:db8::1]:80") + #:scheme 'http + #:host "2001:db8::1" + #:port 80 + #:path "")) - (pass-if "http://[::ffff:192.0.2.1]" - (uri=? (string->uri "http://[::ffff:192.0.2.1]") - #:scheme 'http #:host "::ffff:192.0.2.1" #:path "")) + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (string->uri "http://[::ffff:192.0.2.1]") + #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))) (pass-if "http://foo:" (uri=? (string->uri "http://foo:") @@ -227,17 +229,18 @@ (equal? "ftp://foo@bar:22/baz" (uri->string (string->uri "ftp://foo@bar:22/baz")))) - (pass-if "http://192.0.2.1" - (equal? "http://192.0.2.1" - (uri->string (string->uri "http://192.0.2.1")))) - - (pass-if "http://[2001:db8::1]" - (equal? "http://[2001:db8::1]" - (uri->string (string->uri "http://[2001:db8::1]")))) - - (pass-if "http://[::ffff:192.0.2.1]" - (equal? "http://[::ffff:192.0.2.1]" - (uri->string (string->uri "http://[::ffff:192.0.2.1]")))) + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (equal? "http://192.0.2.1" + (uri->string (string->uri "http://192.0.2.1")))) + + (pass-if "http://[2001:db8::1]" + (equal? "http://[2001:db8::1]" + (uri->string (string->uri "http://[2001:db8::1]")))) + + (pass-if "http://[::ffff:192.0.2.1]" + (equal? "http://[::ffff:192.0.2.1]" + (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))) (pass-if "http://foo:" (equal? "http://foo" hooks/post-receive -- GNU Guile
