[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-64-ge7
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-64-ge7bee74 |
|
Date: |
Thu, 23 Sep 2010 20:02:49 +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=e7bee747712be9ee98f4f739cc1b52df8fd7dcd8
The branch, master has been updated
via e7bee747712be9ee98f4f739cc1b52df8fd7dcd8 (commit)
via b88a954c7ae6a8b56ed9c0c3fa631292199a403e (commit)
via 5a99a574e43a08817f21bdeebe1c302051ffb237 (commit)
via cb2d8076effd1b3f0a01a7148af5a97b64f4c29d (commit)
from fb5c4dc52337603e7526a1f944533ce8217a9e29 (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 e7bee747712be9ee98f4f739cc1b52df8fd7dcd8
Author: Ludovic Courtès <address@hidden>
Date: Thu Sep 23 12:16:28 2010 +0200
Fixlet in `coverage.test'.
* test-suite/tests/coverage.test ("line-execution-counts")["several
times"]: Add missing `else' clause.
commit b88a954c7ae6a8b56ed9c0c3fa631292199a403e
Author: Ludovic Courtès <address@hidden>
Date: Thu Sep 23 12:14:32 2010 +0200
Strengthen the weak hash table tests.
* test-suite/tests/weaks.test: Enclose in a module.
(valid?): New procedure.
("weak-hash")["weak-key dies, "weak-value dies", "double-weak dies"]:
Check that all the values are `valid?', in addition to checking that
at least one of them is #f.
commit 5a99a574e43a08817f21bdeebe1c302051ffb237
Author: Ludovic Courtès <address@hidden>
Date: Thu Sep 23 11:51:28 2010 +0200
Fix weak-value hash tables.
* libguile/hashtab.c (scm_hash_fn_set_x): Register a disappearing link
to VAL when TABLE is weak-value.
* test-suite/tests/weaks.test ("weak-hash")["weak-key dies", "weak-value
dies", "doubly-weak dies"]: Use `hash-set!' and `hash-ref', not
`hashq-set!' and `hashq-ref', otherwise these tests would always
succeed because (eq? "this" "this") => #f.
["lives"]: Use `hash-ref' and `hash-set!' too for consistency.
commit cb2d8076effd1b3f0a01a7148af5a97b64f4c29d
Author: Ludovic Courtès <address@hidden>
Date: Thu Sep 23 10:55:24 2010 +0200
Define `equal?' for pointer objects.
* libguile/eq.c (scm_equal_p): Handle pointer objects.
* test-suite/tests/foreign.test ("make-pointer")["equal?", "equal?
modulo finalizer", "not equal?"]: New tests.
-----------------------------------------------------------------------
Summary of changes:
libguile/eq.c | 3 +
libguile/hashtab.c | 7 ++
test-suite/tests/coverage.test | 3 +-
test-suite/tests/foreign.test | 13 ++++-
test-suite/tests/weaks.test | 124 +++++++++++++++++++++++-----------------
5 files changed, 96 insertions(+), 54 deletions(-)
diff --git a/libguile/eq.c b/libguile/eq.c
index 923fa77..7502559 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -303,6 +303,9 @@ scm_equal_p (SCM x, SCM y)
else
goto generic_equal;
}
+ if (SCM_POINTER_P (x) && SCM_POINTER_P (y))
+ return scm_from_bool (SCM_POINTER_VALUE (x) == SCM_POINTER_VALUE (y));
+
/* This ensures that types and scm_length are the same. */
if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
{
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 9cb75f2..78a265d 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -623,6 +623,13 @@ scm_hash_fn_set_x (SCM table, SCM obj, SCM val,
it = scm_hash_fn_create_handle_x (table, obj, SCM_BOOL_F, hash_fn, assoc_fn,
closure);
SCM_SETCDR (it, val);
+
+ if (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_VALUE_P (table)
+ && SCM_NIMP (val))
+ /* IT is a weak-cdr pair. Register a disappearing link from IT's
+ cdr to VAL like `scm_weak_cdr_pair' does. */
+ SCM_I_REGISTER_DISAPPEARING_LINK ((void *) SCM_CDRLOC (it), SCM2PTR (val));
+
return val;
}
diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test
index eefb7bb..52635a9 100644
--- a/test-suite/tests/coverage.test
+++ b/test-suite/tests/coverage.test
@@ -106,7 +106,8 @@
((2 3) (= count 78))
((4 5 6) (= count 77))
((7) (= count 1))
- ((8) (= count 0)))))
+ ((8) (= count 0))
+ (else #f))))
counts))))))
(pass-if "some"
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 274a06d..db92eca 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -47,7 +47,18 @@
(with-test-prefix "make-pointer"
(pass-if "address preserved"
- (= 123 (pointer-address (make-pointer 123)))))
+ (= 123 (pointer-address (make-pointer 123))))
+
+ (pass-if "equal?"
+ (equal? (make-pointer 123) (make-pointer 123)))
+
+ (pass-if "equal? modulo finalizer"
+ (let ((finalizer (dynamic-func "scm_is_pair" (dynamic-link))))
+ (equal? (make-pointer 123)
+ (make-pointer 123 finalizer))))
+
+ (pass-if "not equal?"
+ (not (equal? (make-pointer 123) (make-pointer 456)))))
(with-test-prefix "pointer<->bytevector"
diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test
index b39d2e7..b08d2e0 100644
--- a/test-suite/tests/weaks.test
+++ b/test-suite/tests/weaks.test
@@ -1,5 +1,5 @@
;;;; weaks.test --- tests guile's weaks -*- scheme -*-
-;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010 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
@@ -33,8 +33,12 @@
;;; other reasons why they might not work as tested here, so if you
;;; haven't done anything to weaks, don't sweat it :)
-(use-modules (test-suite lib)
- (ice-9 weak-vector))
+(define-module (test-weaks)
+ #:use-module (test-suite lib)
+ #:use-module (ice-9 weak-vector)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26))
+
;;; Creation functions
@@ -122,6 +126,18 @@
(not (vector-ref global-weak 4)))
(throw 'unresolved))))))
+
+;;;
+;;; Weak hash tables & weak alist vectors.
+;;;
+
+(define (valid? value initial-value)
+ ;; Return true if VALUE is "valid", i.e., if it's either #f or
+ ;; INITIAL-VALUE. The idea is to make sure `hash-ref' doesn't return
+ ;; garbage.
+ (or (not value)
+ (equal? val initial-value)))
+
(let ((x (make-weak-key-alist-vector 17))
(y (make-weak-value-alist-vector 17))
(z (make-doubly-weak-alist-vector 17))
@@ -131,59 +147,63 @@
"weak-hash"
(pass-if "lives"
(begin
- (hashq-set! x test-key test-value)
- (hashq-set! y test-key test-value)
- (hashq-set! z test-key test-value)
+ (hash-set! x test-key test-value)
+ (hash-set! y test-key test-value)
+ (hash-set! z test-key test-value)
(gc)
(gc)
- (and (hashq-ref x test-key)
- (hashq-ref y test-key)
- (hashq-ref z test-key)
+ (and (hash-ref x test-key)
+ (hash-ref y test-key)
+ (hash-ref z test-key)
#t)))
+
+ ;; In the tests below we use `string-copy' to avoid the risk of
+ ;; unintended retention of a string that we want to be GC'd.
+
(pass-if "weak-key dies"
- (begin
- (hashq-set! x "this" "is")
- (hashq-set! x "a" "test")
- (hashq-set! x "of" "the")
- (hashq-set! x "emergency" "weak")
- (hashq-set! x "key" "hash system")
- (gc)
- (and
- (or (not (hashq-ref x "this"))
- (not (hashq-ref x "a"))
- (not (hashq-ref x "of"))
- (not (hashq-ref x "emergency"))
- (not (hashq-ref x "key")))
- (hashq-ref x test-key)
- #t)))
+ (begin
+ (hash-set! x (string-copy "this") "is")
+ (hash-set! x (string-copy "a") "test")
+ (hash-set! x (string-copy "of") "the")
+ (hash-set! x (string-copy "emergency") "weak")
+ (hash-set! x (string-copy "key") "hash system")
+ (gc)
+ (let ((values (map (cut hash-ref x <>)
+ '("this" "a" "of" "emergency" "key"))))
+ (and (every valid? values
+ '("is" "test" "the" "weak" "hash system"))
+ (any not values)
+ (hash-ref x test-key)
+ #t))))
(pass-if "weak-value dies"
- (begin
- (hashq-set! y "this" "is")
- (hashq-set! y "a" "test")
- (hashq-set! y "of" "the")
- (hashq-set! y "emergency" "weak")
- (hashq-set! y "value" "hash system")
- (gc)
- (and (or (not (hashq-ref y "this"))
- (not (hashq-ref y "a"))
- (not (hashq-ref y "of"))
- (not (hashq-ref y "emergency"))
- (not (hashq-ref y "value")))
- (hashq-ref y test-key)
- #t)))
+ (begin
+ (hash-set! y "this" (string-copy "is"))
+ (hash-set! y "a" (string-copy "test"))
+ (hash-set! y "of" (string-copy "the"))
+ (hash-set! y "emergency" (string-copy "weak"))
+ (hash-set! y "value" (string-copy "hash system"))
+ (gc)
+ (let ((values (map (cut hash-ref y <>)
+ '("this" "a" "of" "emergency" "key"))))
+ (and (every valid? values
+ '("is" "test" "the" "weak" "hash system"))
+ (any not values)
+ (hash-ref y test-key)
+ #t))))
+
(pass-if "doubly-weak dies"
- (begin
- (hashq-set! z "this" "is")
- (hashq-set! z "a" "test")
- (hashq-set! z "of" "the")
- (hashq-set! z "emergency" "weak")
- (hashq-set! z "all" "hash system")
- (gc)
- (and (or (not (hashq-ref z "this"))
- (not (hashq-ref z "a"))
- (not (hashq-ref z "of"))
- (not (hashq-ref z "emergency"))
- (not (hashq-ref z "all")))
- (hashq-ref z test-key)
- #t)))))
+ (begin
+ (hash-set! z (string-copy "this") (string-copy "is"))
+ (hash-set! z "a" (string-copy "test"))
+ (hash-set! z (string-copy "of") "the")
+ (hash-set! z "emergency" (string-copy "weak"))
+ (hash-set! z (string-copy "all") (string-copy "hash system"))
+ (gc)
+ (let ((values (map (cut hash-ref z <>)
+ '("this" "a" "of" "emergency" "key"))))
+ (and (every valid? values
+ '("is" "test" "the" "weak" "hash system"))
+ (any not values)
+ (hash-ref z test-key)
+ #t))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-12-64-ge7bee74,
Ludovic Courtès <=