[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-56-g3278efd

[Ludovic Courtès]

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=3278efd3fa3fc106da5c5b704b26f35e5ec16ac4

The branch, master has been updated
       via  3278efd3fa3fc106da5c5b704b26f35e5ec16ac4 (commit)
       via  b8ed3de36e56bff0ffab2000b9ba55c585a4bc0e (commit)
       via  d900a8557db21641413db8995a7cdc1453adbe1f (commit)
      from  69c9600678e67a51b258f2e3cfe1b5e0f842b45d (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 3278efd3fa3fc106da5c5b704b26f35e5ec16ac4
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 3 00:36:41 2010 +0100

    Add test checking whether fluids are GC'd.
    
    * test-suite/tests/fluids.test ("fluids are GC'd"): New test.

commit b8ed3de36e56bff0ffab2000b9ba55c585a4bc0e
Author: Ludovic Courtès <address@hidden>
Date:   Tue Mar 2 23:36:29 2010 +0100

    Fix "coding:" cookies in the test suite.
    
    * test-suite/tests/bytevectors.test, test-suite/tests/keywords.test,
      test-suite/tests/procprop.test, test-suite/tests/srfi-35.test,
      test-suite/tests/srfi-88.test: Add "coding:" cookie on the first line.

commit d900a8557db21641413db8995a7cdc1453adbe1f
Author: Ludovic Courtès <address@hidden>
Date:   Tue Mar 2 23:16:26 2010 +0100

    Fix off-by-one error when initializing vectors in `make-srfi-4-vector'.
    
    * libguile/srfi-4.c (scm_make_srfi_4_vector): When FILL is bound and
      non-zero, initialize the last element.
    
    * test-suite/tests/srfi-4.test ("TAG vectors")["make-TAGvector"]: New
      tests.

-----------------------------------------------------------------------

Summary of changes:
 libguile/srfi-4.c                 |    6 ++++
 test-suite/tests/bytevectors.test |   10 +-----
 test-suite/tests/fluids.test      |   12 +++++++
 test-suite/tests/keywords.test    |    8 +----
 test-suite/tests/procprop.test    |   11 ++-----
 test-suite/tests/srfi-35.test     |   11 ++-----
 test-suite/tests/srfi-4.test      |   60 ++++++++++++++++++++++++++++++------
 test-suite/tests/srfi-88.test     |   11 ++-----
 8 files changed, 81 insertions(+), 48 deletions(-)

diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 005a5a0..cb92b80 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -267,9 +267,15 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 
2, 1, 0,
             scm_t_array_handle h;
             size_t len;
             ssize_t pos, inc;
+
             scm_uniform_vector_writable_elements (ret, &h, &len, &inc);
+
             for (pos = 0; pos != h.dims[0].ubnd; pos += inc)
               scm_array_handle_set (&h, pos, fill);
+
+           /* Initialize the last element.  */
+           scm_array_handle_set (&h, pos, fill);
+
             scm_array_handle_release (&h);
           }
         return ret;
diff --git a/test-suite/tests/bytevectors.test 
b/test-suite/tests/bytevectors.test
index fe54b02..35bdb47 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -1,6 +1,6 @@
-;;;; bytevectors.test --- Exercise the R6RS bytevector API.
+;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: 
iso-8859-1; -*-
 ;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -696,9 +696,3 @@
   (pass-if "bitvector > 8"
     (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
       (= (bytevector-length bv) 2))))
-
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; mode: scheme
-;;; End:
diff --git a/test-suite/tests/fluids.test b/test-suite/tests/fluids.test
index f00fdc4..51353fa 100644
--- a/test-suite/tests/fluids.test
+++ b/test-suite/tests/fluids.test
@@ -55,3 +55,15 @@
                        (a 2))
            (eqv? (fluid-ref a) 2))
          (eqv? (fluid-ref a) #f))))
+
+(pass-if "fluids are GC'd"
+
+  (let ((g (make-guardian)))
+    (g (make-fluid))
+    (let loop ((i 1000))
+      (and (> i 0)
+           (begin
+             (make-fluid)
+             (loop (1- i)))))
+    (gc)
+    (fluid? (g))))
diff --git a/test-suite/tests/keywords.test b/test-suite/tests/keywords.test
index 78053ad..42bb379 100644
--- a/test-suite/tests/keywords.test
+++ b/test-suite/tests/keywords.test
@@ -1,6 +1,6 @@
-;;;; keywords.test --- Keywords                  -*- Scheme -*-
+;;;; keywords.test --- Keywords.           -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;   Copyright (C) 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
@@ -24,7 +24,3 @@
   (pass-if "printing"
     (string=? (with-output-to-string (lambda () (write #:this)))
              "#:this")))
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
diff --git a/test-suite/tests/procprop.test b/test-suite/tests/procprop.test
index 6af73f6..c009f88 100644
--- a/test-suite/tests/procprop.test
+++ b/test-suite/tests/procprop.test
@@ -1,7 +1,7 @@
-;;;; procprop.test --- Procedure properties               -*- Scheme -*-
-;;;; Ludovic Courtès <address@hidden>
+;;;; procprop.test --- Procedure properties -*- mode: scheme; coding: utf-8; 
-*-
+;;;; Ludovic Courtès <address@hidden>
 ;;;;
-;;;;   Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;   Copyright (C) 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
@@ -53,8 +53,3 @@
   (pass-if "list"
     (equal? (procedure-property list 'arity)
             '(0 0 #t))))
-
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test
index 849d1de..6d725dc 100644
--- a/test-suite/tests/srfi-35.test
+++ b/test-suite/tests/srfi-35.test
@@ -1,7 +1,7 @@
-;;;; srfi-35.test --- Test suite for SRFI-35               -*- Scheme -*-
-;;;; Ludovic Courtès <address@hidden>
+;;;; srfi-35.test --- SRFI-35.             -*- mode: scheme; coding: utf-8; -*-
+;;;; Ludovic Courtès <address@hidden>
 ;;;;
-;;;;   Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2007, 2008, 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
@@ -316,8 +316,3 @@
 
   (pass-if "(c2-b v5)"
     (equal? (c2-b v5) "b2")))
-
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index 8251884..d7e5b1a 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -51,7 +51,11 @@
 
   (pass-if "u8vector->list/uniform-vector->list"
     (equal? (u8vector->list (u8vector 1 2 3 4))
-           (uniform-vector->list (u8vector 1 2 3 4)))))
+           (uniform-vector->list (u8vector 1 2 3 4))))
+
+  (pass-if "make-u8vector"
+    (equal? (list->u8vector '(7 7 7 7))
+            (make-u8vector 4 7))))
 
 (with-test-prefix "s8 vectors"
 
@@ -84,7 +88,11 @@
 
   (pass-if "s8vector->list/uniform-vector->list"
     (equal? (s8vector->list (s8vector 1 2 3 4))
-           (uniform-vector->list (s8vector 1 2 3 4)))))
+           (uniform-vector->list (s8vector 1 2 3 4))))
+
+  (pass-if "make-s8vector"
+    (equal? (list->s8vector '(7 7 7 7))
+            (make-s8vector 4 7))))
 
 
 (with-test-prefix "u16 vectors"
@@ -118,7 +126,11 @@
 
   (pass-if "u16vector->list/uniform-vector->list"
     (equal? (u16vector->list (u16vector 1 2 3 4))
-           (uniform-vector->list (u16vector 1 2 3 4)))))
+           (uniform-vector->list (u16vector 1 2 3 4))))
+
+  (pass-if "make-u16vector"
+    (equal? (list->u16vector '(7 7 7 7))
+            (make-u16vector 4 7))))
 
 (with-test-prefix "s16 vectors"
 
@@ -151,7 +163,11 @@
 
   (pass-if "s16vector->list/uniform-vector->list"
     (equal? (s16vector->list (s16vector 1 2 3 4))
-           (uniform-vector->list (s16vector 1 2 3 4)))))
+           (uniform-vector->list (s16vector 1 2 3 4))))
+
+  (pass-if "make-s16vector"
+    (equal? (list->s16vector '(7 7 7 7))
+            (make-s16vector 4 7))))
 
 (with-test-prefix "u32 vectors"
 
@@ -184,7 +200,11 @@
 
   (pass-if "u32vector->list/uniform-vector->list"
     (equal? (u32vector->list (u32vector 1 2 3 4))
-           (uniform-vector->list (u32vector 1 2 3 4)))))
+           (uniform-vector->list (u32vector 1 2 3 4))))
+
+  (pass-if "make-u32vector"
+    (equal? (list->u32vector '(7 7 7 7))
+            (make-u32vector 4 7))))
 
 (with-test-prefix "s32 vectors"
 
@@ -217,7 +237,11 @@
 
   (pass-if "s32vector->list/uniform-vector->list"
     (equal? (s32vector->list (s32vector 1 2 3 4))
-           (uniform-vector->list (s32vector 1 2 3 4)))))
+           (uniform-vector->list (s32vector 1 2 3 4))))
+
+  (pass-if "make-s32vector"
+    (equal? (list->s32vector '(7 7 7 7))
+            (make-s32vector 4 7))))
 
 (with-test-prefix "u64 vectors"
 
@@ -250,7 +274,11 @@
 
   (pass-if "u64vector->list/uniform-vector->list"
     (equal? (u64vector->list (u64vector 1 2 3 4))
-           (uniform-vector->list (u64vector 1 2 3 4)))))
+           (uniform-vector->list (u64vector 1 2 3 4))))
+
+  (pass-if "make-u64vector"
+    (equal? (list->u64vector '(7 7 7 7))
+            (make-u64vector 4 7))))
 
 (with-test-prefix "s64 vectors"
 
@@ -283,7 +311,11 @@
 
   (pass-if "s64vector->list/uniform-vector->list"
     (equal? (s64vector->list (s64vector 1 2 3 4))
-           (uniform-vector->list (s64vector 1 2 3 4)))))
+           (uniform-vector->list (s64vector 1 2 3 4))))
+
+  (pass-if "make-s64vector"
+    (equal? (list->s64vector '(7 7 7 7))
+            (make-s64vector 4 7))))
 
 (with-test-prefix "f32 vectors"
 
@@ -316,7 +348,11 @@
 
   (pass-if "f32vector->list/uniform-vector->list"
     (equal? (f32vector->list (f32vector 1 2 3 4))
-           (uniform-vector->list (f32vector 1 2 3 4)))))
+           (uniform-vector->list (f32vector 1 2 3 4))))
+
+  (pass-if "make-f32vector"
+    (equal? (list->f32vector '(7 7 7 7))
+            (make-f32vector 4 7))))
 
 (with-test-prefix "f64 vectors"
 
@@ -349,4 +385,8 @@
 
   (pass-if "f64vector->list/uniform-vector->list"
     (equal? (f64vector->list (f64vector 1 2 3 4))
-           (uniform-vector->list (f64vector 1 2 3 4)))))
+           (uniform-vector->list (f64vector 1 2 3 4))))
+
+  (pass-if "make-f64vector"
+    (equal? (list->f64vector '(7 7 7 7))
+            (make-f64vector 4 7))))
diff --git a/test-suite/tests/srfi-88.test b/test-suite/tests/srfi-88.test
index b879941..07b9e43 100644
--- a/test-suite/tests/srfi-88.test
+++ b/test-suite/tests/srfi-88.test
@@ -1,7 +1,7 @@
-;;;; srfi-88.test --- Test suite for SRFI-88               -*- Scheme -*-
-;;;; Ludovic Courtès <address@hidden>
+;;;; srfi-88.test --- SRFI-88.             -*- mode: scheme; coding: utf-8; -*-
+;;;; Ludovic Courtès <address@hidden>
 ;;;;
-;;;;   Copyright (C) 2008 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2008, 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
@@ -51,8 +51,3 @@
     ;; `#{extended symbol}#:'.
     (string=? ""
               (keyword->string (string->keyword "")))))
-
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:


hooks/post-receive
-- 
GNU Guile