Author: yamakenz
Date: Fri Sep 7 13:36:39 2007
New Revision: 4943
Added:
sigscheme-trunk/test/test-srfi43.scm
Modified:
sigscheme-trunk/QALog
sigscheme-trunk/lib/srfi-43.scm
sigscheme-trunk/src/module-srfi43.c
sigscheme-trunk/test/Makefile.am
Log:
[QA] module-srfi43.c
* lib/srfi-43.scm
- (check-indices): Fix an incorrect error message in check-indices
* test/test-srfi43.scm
- New file
- Add tests for let-vector-start+end
* test/Makefile.am
- (sscm_tests): Add test-srfi43.scm
* src/module-srfi43.c
- (scm_s_let_vector_start_plus_end): Rename local vars
* QALog
- Update
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Fri Sep 7 13:36:39 2007
@@ -1022,14 +1022,14 @@
file: module-srfi43.c
category: srfi
-spec by eyes:
-spec by tests:
-general review:
-64-bit by eyes:
-64-bit by tests:
-coding style:
-normal case tests:
-corner case tests:
+spec by eyes: [EMAIL PROTECTED]
+spec by tests: [EMAIL PROTECTED]
+general review: [EMAIL PROTECTED]
+64-bit by eyes: [EMAIL PROTECTED]
+64-bit by tests:
+coding style: [EMAIL PROTECTED]
+normal case tests: [EMAIL PROTECTED]
+corner case tests: [EMAIL PROTECTED]
file: module-srfi48.c
category: srfi
@@ -1133,6 +1133,10 @@
Log
---
+2007-09-08 YamaKen <yamaken AT bp.iij4u.or.jp>
+ * module-srfi43.c
+ - QA done @r4943 with test-srfi43.scm
+
2007-09-04 YamaKen <yamaken AT bp.iij4u.or.jp>
* module-srfi9.c
- QA done again @r4939 (including the fix in r4928) with
Modified: sigscheme-trunk/lib/srfi-43.scm
==============================================================================
--- sigscheme-trunk/lib/srfi-43.scm (original)
+++ sigscheme-trunk/lib/srfi-43.scm Fri Sep 7 13:36:39 2007
@@ -8,6 +8,7 @@
;; 2007-08-28 yamaken - Imported from
;; http://srfi.schemers.org/srfi-43/vector-lib.scm
;; and adapted to SigScheme
+;; 2007-09-08 yamaken - Fix an incorrect error message in check-indices
;;; --------------------
@@ -243,7 +244,7 @@
callee))
((>= start (vector-length vec))
(check-indices vec
- (lose `(,start-name > len)
+ (lose `(,start-name >= len)
`(len was ,(vector-length vec)))
start-name
end end-name
Modified: sigscheme-trunk/src/module-srfi43.c
==============================================================================
--- sigscheme-trunk/src/module-srfi43.c (original)
+++ sigscheme-trunk/src/module-srfi43.c Fri Sep 7 13:36:39 2007
@@ -101,7 +101,8 @@
ScmObj body,
ScmEvalState *eval_state)
{
- ScmObj env, start, end, proc_check_type, check_type_args, receive_expr;
+ ScmObj env, start_name, end_name, proc_check_type, check_type_args;
+ ScmObj receive_expr;
DECLARE_FUNCTION("let-vector-start+end", syntax_variadic_tailrec_4);
if (!LIST_2_P(start_plus_end))
@@ -117,9 +118,9 @@
EVAL(callee, env));
vec = scm_call(proc_check_type, check_type_args);
- start = QUOTE(CAR(start_plus_end));
- end = QUOTE(CADR(start_plus_end));
+ start_name = QUOTE(CAR(start_plus_end));
+ end_name = QUOTE(CADR(start_plus_end));
receive_expr = CONS(l_sym_vector_parse_start_plus_end,
- LIST_5(QUOTE(vec), args, start, end, callee));
+ LIST_5(QUOTE(vec), args, start_name, end_name,
callee));
return scm_s_srfi8_receive(start_plus_end, receive_expr, body, eval_state);
}
Modified: sigscheme-trunk/test/Makefile.am
==============================================================================
--- sigscheme-trunk/test/Makefile.am (original)
+++ sigscheme-trunk/test/Makefile.am Fri Sep 7 13:36:39 2007
@@ -50,6 +50,7 @@
test-srfi34.scm \
test-srfi34-2.scm \
test-srfi38.scm \
+ test-srfi43.scm \
test-srfi48.scm \
test-srfi55.scm \
test-srfi60.scm \
Added: sigscheme-trunk/test/test-srfi43.scm
==============================================================================
--- (empty file)
+++ sigscheme-trunk/test/test-srfi43.scm Fri Sep 7 13:36:39 2007
@@ -0,0 +1,218 @@
+;; Filename : test-srfi43.scm
+;; About : unit tests for SRFI-43
+;;
+;; Copyright (c) 2007 SigScheme Project <uim-en AT googlegroups.com>
+;;
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of authors nor the names of its contributors
+;; may be used to endorse or promote products derived from this software
+;; without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(require-extension (unittest) (srfi 43))
+
+
+(test-begin "let-vector-start+end invalid forms")
+(define vec (vector 'foo 'bar 'baz))
+;; nonexistent <callee>
+(test-error (let-vector-start+end nonexistent vec '() (start end) #t))
+;; invalid <vector>
+(test-error (let-vector-start+end vector-ref '() '() (start end) #t))
+(test-error (let-vector-start+end vector-ref #f '() (start end) #t))
+;; invalid <args>
+(test-error (let-vector-start+end vector-ref vec '(#t) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(0 #t) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(0 1 2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '#() (start end) #t))
+(test-error (let-vector-start+end vector-ref vec #f (start end) #t))
+;; malformed bindings
+(test-error (let-vector-start+end vector-ref vec '() () #t))
+(test-error (let-vector-start+end vector-ref vec '() (start) #t))
+(test-error (let-vector-start+end vector-ref vec '() (start end extra) #t))
+(test-error (let-vector-start+end vector-ref vec '() '(start end) #t))
+(test-error (let-vector-start+end vector-ref vec '() #() #t))
+(test-error (let-vector-start+end vector-ref vec '() '#() #t))
+;; no body
+(test-error (let-vector-start+end vector-ref vec '() (start end)))
+(test-end)
+
+(test-begin "let-vector-start+end null vector")
+(test-error (let-vector-start+end vector-ref '#() '(-1) (start end) #t))
+(test-equal '(0 0)
+ (let-vector-start+end vector-ref '#() '() (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref '#() '(0) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref '#() '(0 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref '#() '(0 0) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref '#() '(0 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref '#() '(1) (start end) #t))
+(test-error (let-vector-start+end vector-ref '#() '(1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref '#() '(1 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref '#() '(1 1) (start end) #t))
+(test-end)
+
+(test-begin "let-vector-start+end length 1")
+(define vec (vector 'foo))
+(test-error (let-vector-start+end vector-ref vec '(-1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 2) (start end) #t))
+(test-equal '(0 1)
+ (let-vector-start+end vector-ref vec '() (start end)
+ (list start end)))
+(test-equal '(0 1)
+ (let-vector-start+end vector-ref vec '(0) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(0 -1) (start end) #t))
+(test-equal '(0 0)
+ (let-vector-start+end vector-ref vec '(0 0) (start end)
+ (list start end)))
+(test-equal '(0 1)
+ (let-vector-start+end vector-ref vec '(0 1) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(0 2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1 2) (start end) #t))
+(test-end)
+
+(test-begin "let-vector-start+end length 2")
+(define vec (vector 'foo 'bar))
+(test-error (let-vector-start+end vector-ref vec '(-1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 3) (start end) #t))
+(test-equal '(0 2)
+ (let-vector-start+end vector-ref vec '() (start end)
+ (list start end)))
+(test-equal '(0 2)
+ (let-vector-start+end vector-ref vec '(0) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(0 -1) (start end) #t))
+(test-equal '(0 0)
+ (let-vector-start+end vector-ref vec '(0 0) (start end)
+ (list start end)))
+(test-equal '(0 1)
+ (let-vector-start+end vector-ref vec '(0 1) (start end)
+ (list start end)))
+(test-equal '(0 2)
+ (let-vector-start+end vector-ref vec '(0 2) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(0 3) (start end) #t))
+
+(test-equal '(1 2)
+ (let-vector-start+end vector-ref vec '(1) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1 0) (start end) #t))
+(test-equal '(1 1)
+ (let-vector-start+end vector-ref vec '(1 1) (start end)
+ (list start end)))
+(test-equal '(1 2)
+ (let-vector-start+end vector-ref vec '(1 2) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(1 3) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 3) (start end) #t))
+(test-end)
+
+(test-begin "let-vector-start+end length 3")
+(define vec (vector 'foo 'bar 'baz))
+(test-error (let-vector-start+end vector-ref vec '(-1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(-1 3) (start end) #t))
+(test-equal '(0 3)
+ (let-vector-start+end vector-ref vec '() (start end)
+ (list start end)))
+(test-equal '(0 3)
+ (let-vector-start+end vector-ref vec '(0) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(0 -1) (start end) #t))
+(test-equal '(0 0)
+ (let-vector-start+end vector-ref vec '(0 0) (start end)
+ (list start end)))
+(test-equal '(0 1)
+ (let-vector-start+end vector-ref vec '(0 1) (start end)
+ (list start end)))
+(test-equal '(0 2)
+ (let-vector-start+end vector-ref vec '(0 2) (start end)
+ (list start end)))
+(test-equal '(0 3)
+ (let-vector-start+end vector-ref vec '(0 3) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(0 4) (start end) #t))
+
+(test-equal '(1 3)
+ (let-vector-start+end vector-ref vec '(1) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(1 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(1 0) (start end) #t))
+(test-equal '(1 1)
+ (let-vector-start+end vector-ref vec '(1 1) (start end)
+ (list start end)))
+(test-equal '(1 2)
+ (let-vector-start+end vector-ref vec '(1 2) (start end)
+ (list start end)))
+(test-equal '(1 3)
+ (let-vector-start+end vector-ref vec '(1 3) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(1 4) (start end) #t))
+
+(test-equal '(2 3)
+ (let-vector-start+end vector-ref vec '(2) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(2 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(2 1) (start end) #t))
+(test-equal '(2 2)
+ (let-vector-start+end vector-ref vec '(2 2) (start end)
+ (list start end)))
+(test-equal '(2 3)
+ (let-vector-start+end vector-ref vec '(2 3) (start end)
+ (list start end)))
+(test-error (let-vector-start+end vector-ref vec '(2 4) (start end) #t))
+
+(test-error (let-vector-start+end vector-ref vec '(3) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(3 -1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(3 0) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(3 1) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(3 2) (start end) #t))
+(test-error (let-vector-start+end vector-ref vec '(3 3) (start end) #t))
+(test-end)
+
+(test-report-result)
