[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-21-g5fc4243

[Michael Gran]

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=5fc424379f360ef1be2e388ec9af3e72f8b65240

The branch, master has been updated
       via  5fc424379f360ef1be2e388ec9af3e72f8b65240 (commit)
       via  fee95176df1686b9844cd53dc703f0d5a549bb34 (commit)
      from  e5f5113c21f396705d7479a570c96690135c9d36 (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 5fc424379f360ef1be2e388ec9af3e72f8b65240
Author: Michael Gran <address@hidden>
Date:   Sun Sep 20 20:59:05 2009 -0700

    Tests for record types
    
    * test-suite/tests/records.test: new tests

commit fee95176df1686b9844cd53dc703f0d5a549bb34
Author: Michael Gran <address@hidden>
Date:   Sun Sep 20 20:58:08 2009 -0700

    More tests for strings
    
    * test-suite/tests/vectors.test: test make-vector and interactions between
      strings and vectors
    
    * test-suite/tests/strings.test: test string-null?, string? and backslash
      escapes
    
    * test-suite/tests/srfi-13.test: test null input strings in string-any and
      string-every

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

Summary of changes:
 test-suite/tests/records.test |   74 +++++++++++++++++++++++++++++++++++++++++
 test-suite/tests/srfi-13.test |   12 +++++++
 test-suite/tests/strings.test |   41 +++++++++++++++++++++-
 test-suite/tests/vectors.test |   22 ++++++++++++
 4 files changed, 147 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/tests/records.test

diff --git a/test-suite/tests/records.test b/test-suite/tests/records.test
new file mode 100644
index 0000000..7f8e636
--- /dev/null
+++ b/test-suite/tests/records.test
@@ -0,0 +1,74 @@
+;;;; records.test --- Test suite for Guile's records. -*- mode: scheme; 
coding: utf-8 -*-
+;;;;
+;;;; Copyright (C) 2009 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 as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
+
+(define-module (test-records)
+  #:use-module (test-suite lib))
+
+;; ascii names and symbols
+(define rtd-foo (make-record-type "foo" '(x y)))
+(define make-foo (record-constructor rtd-foo))
+(define foo? (record-predicate rtd-foo))
+(define get-foo-x (record-accessor rtd-foo 'x))
+(define get-foo-y (record-accessor rtd-foo 'y))
+(define set-foo-x! (record-modifier rtd-foo 'x))
+(define set-foo-y! (record-modifier rtd-foo 'y))
+
+;; non-Latin-1 names and symbols
+(define rtd-fŏŏ (make-record-type "fŏŏ" '(x ȳ)))
+(define make-fŏŏ (record-constructor rtd-fŏŏ))
+(define fŏŏ? (record-predicate rtd-fŏŏ))
+(define get-fŏŏ-x (record-accessor rtd-fŏŏ 'x))
+(define get-fŏŏ-ȳ (record-accessor rtd-fŏŏ 'ȳ))
+(define set-fŏŏ-x! (record-modifier rtd-fŏŏ 'x))
+(define set-fŏŏ-ȳ! (record-modifier rtd-fŏŏ 'ȳ))
+
+(with-test-prefix "records"
+  
+  (with-test-prefix "constructor"
+
+    (pass-if-exception "0 args (2 required)" exception:wrong-num-args
+      (make-foo))
+
+    (pass-if-exception "1 arg (2 required)" exception:wrong-num-args
+      (make-foo 1))
+
+    (pass-if "2 args (2 required)" exception:wrong-num-args
+      (foo? (make-foo 1 2)))
+
+    (pass-if "non-latin-1" exception:wrong-num-args
+      (fŏŏ? (make-fŏŏ 1 2))))
+
+  (with-test-prefix "modifier and getter"
+
+    (pass-if "set"
+      (let ((r (make-foo 1 2)))
+        (set-foo-x! r 3)
+        (eqv? (get-foo-x r) 3)))
+
+    (pass-if "set 2"
+      (let ((r (make-fŏŏ 1 2)))
+        (set-fŏŏ-ȳ! r 3)
+        (eqv? (get-fŏŏ-ȳ r) 3))))
+
+  (with-test-prefix "record type name"
+    
+    (pass-if "foo"
+      (string=? "foo" (record-type-name rtd-foo)))
+
+    (pass-if "fŏŏ"
+      (string=? "fŏŏ" (record-type-name rtd-fŏŏ)))))
diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test
index d8e3799..0d2ff59 100644
--- a/test-suite/tests/srfi-13.test
+++ b/test-suite/tests/srfi-13.test
@@ -40,6 +40,12 @@
 
 (with-test-prefix "string-any"
 
+  (pass-if "null string"
+    (not (string-any #\a "")))
+
+  (pass-if "start index == end index"
+    (not (string-any #\a "aaa" 1 1)))
+
   (with-test-prefix "bad char_pred"
 
     (pass-if-exception "integer" exception:wrong-type-arg
@@ -259,6 +265,12 @@
 
 (with-test-prefix "string-every"
 
+  (pass-if "null string"
+    (string-every #\a ""))
+
+  (pass-if "start index == end index"
+    (string-every #\a "bbb" 1 1))
+
   (with-test-prefix "bad char_pred"
 
     (pass-if-exception "integer" exception:wrong-type-arg
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index c78fe55..013c1a8 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -177,7 +177,7 @@
       (let ((s "\U000040"))
         (not (assq-ref (%string-dump s) 'stringbuf-wide))))))
 
-(with-test-prefix "hex escapes"
+(with-test-prefix "escapes"
 
   (pass-if-exception "non-hex char in two-digit hex-escape"
     exception:illegal-escape                     
@@ -216,7 +216,44 @@
           (integer->char #x010300)))
 
   (pass-if "escaped characters match non-escaped ASCII characters"
-    (string=? "ABC" "\x41\u0042\U000043")))
+    (string=? "ABC" "\x41\u0042\U000043"))
+
+  (pass-if "R5RS backslash escapes"
+    (string=? "\"\\" (string #\" #\\)))
+
+  (pass-if "Guile extensions backslash escapes"
+    (string=? "\0\a\f\n\r\t\v"
+              (apply string (map integer->char '(0 7 12 10 13 9 11))))))
+
+;;
+;; string?
+;;
+(with-test-prefix "string?"
+
+  (pass-if "string"
+    (string? "abc"))
+
+  (pass-if "symbol"
+    (not (string? 'abc))))
+
+;;
+;; string-null?
+;; 
+
+(with-test-prefix "string-null?"
+
+  (pass-if "null string"
+    (string-null? ""))
+
+  (pass-if "non-null string"
+    (not (string-null? "a")))
+
+  (pass-if "respects \\0"
+    (not (string-null? "\0")))
+
+  (pass-if-exception "symbol"
+    exception:wrong-type-arg
+    (string-null? 'a)))
 
 ;;
 ;; string=?
diff --git a/test-suite/tests/vectors.test b/test-suite/tests/vectors.test
index 22434bf..fe85625 100644
--- a/test-suite/tests/vectors.test
+++ b/test-suite/tests/vectors.test
@@ -36,7 +36,29 @@
   (pass-if "simple vector"
     (equal? '(1 2 3) (vector->list #(1 2 3))))
 
+  (pass-if "string vector 1"
+    (equal? '("abc" "def" "ghi") (vector->list #("abc" "def" "ghi"))))
+
+  (pass-if "string-vector 2"
+    (equal? '("abc\u0100" "def\u0101" "ghi\u0102") 
+            (vector->list #("abc\u0100" "def\u0101" "ghi\u0102"))))
+
   (pass-if "shared array"
     (let ((b (make-shared-array #(1) (lambda (x) '(0)) 2)))
       (equal? b (list->vector (vector->list b))))))
 
+(with-test-prefix "make-vector"
+
+  (pass-if "null"
+    (equal? #() (make-vector 0)))
+
+  (pass-if "fill with num"
+    (equal? #(1 1 1) (make-vector 3 1)))
+
+  (pass-if "fill with string"
+    (equal? #("abc" "abc" "abc") (make-vector 3 "abc")))
+
+  (pass-if "fill with string 2"
+    (equal? #("ab\u0100" "ab\u0100" "ab\u0100") 
+            (make-vector 3 "ab\u0100"))))
+


hooks/post-receive
-- 
GNU Guile