guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-354-ga38da40


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-354-ga38da40
Date: Fri, 06 Jul 2012 17:28:41 +0000

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 <address@hidden>
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,
address@hidden   2007, 2009, 2010, 2011  Free Software Foundation, Inc.
address@hidden   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
 
address@hidden Vtables, Structure Basics, Structures, Structures
address@hidden Vtables
 @subsubsection Vtables
 
 A vtable is a structure type, specifying its layout, and other
@@ -2460,7 +2460,7 @@ structure.
 @end deffn
 
 
address@hidden Structure Basics, Vtable Contents, Vtables, Structures
address@hidden 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
 
 
address@hidden Vtable Contents, Vtable Vtables, Structure Basics, Structures
address@hidden 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
 
address@hidden {Scheme Procedure} struct-vtable-tag vtable
address@hidden {C Function} scm_struct_vtable_tag (vtable)
-Return the tag of the given @var{vtable}.
address@hidden
address@hidden FIXME: what can be said about what this means?
address@hidden
address@hidden deffn
-
 
address@hidden Vtable Vtables,  , Vtable Contents, Structures
address@hidden 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://address@hidden:22/baz";
             (uri->string (string->uri "ftp://address@hidden: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



reply via email to

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