[uim-commit] r2762 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-03 05:20:19 -0800 (Tue, 03 Jan 2006)
New Revision: 2762

Modified:
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/test/test-string.scm
Log:
* This fix is only performed to stop the explicit test failure
  on runtest.sh. I'll not perform comprehensive debug or test
  writing for string immutability, at least for now.

* sigscheme/operations.c
  - (scm_p_substring): Fix broken range check
* sigscheme/test/test-string.scm
  - Fix incorrect tests of "substring immutable", and add some more


Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2006-01-03 12:51:02 UTC (rev 2761)
+++ branches/r5rs/sigscheme/operations.c	2006-01-03 13:20:19 UTC (rev 2762)
@@ -1364,9 +1364,9 @@
     c_end_index   = SCM_INT_VALUE(end);
 
     /* sanity check */
-    if (c_start_index < 0 || SCM_STRING_LEN(str) <= c_start_index)
+    if (c_start_index < 0 || SCM_STRING_LEN(str) < c_start_index)
         ERR_OBJ("start index out of range", start);
-    if (c_end_index < 0 || SCM_STRING_LEN(str) <= c_end_index)
+    if (c_end_index < 0 || SCM_STRING_LEN(str) < c_end_index)
         ERR_OBJ("end index out of range", end);
     if (c_start_index > c_end_index)
         ERR("substring: start index is greater than end index.");

Modified: branches/r5rs/sigscheme/test/test-string.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-string.scm	2006-01-03 12:51:02 UTC (rev 2761)
+++ branches/r5rs/sigscheme/test/test-string.scm	2006-01-03 13:20:19 UTC (rev 2762)
@@ -32,6 +32,7 @@
 
 (load "./test/unittest.scm")
 
+(define tn test-name)
 
 ;;
 ;; All procedures which take the string as argument is tested with
@@ -143,9 +144,21 @@
 
 ;; substring check
 ;;;; immutable
-(assert-error "substring immutable" (lambda () (substring "foo" 0 0)))
-(assert-error "substring immutable" (lambda () (substring "foo" 0 3)))
-(assert-error "substring immutable" (lambda () (substring (symbol->string 'foo) 0 3)))
+(tn "substring immutable")
+(assert-error  (tn) (lambda () (substring "foo" 0 -1)))
+(assert-equal? (tn) ""    (substring "foo" 0 0))
+(assert-equal? (tn) "f"   (substring "foo" 0 1))
+(assert-equal? (tn) "fo"  (substring "foo" 0 2))
+(assert-equal? (tn) "foo" (substring "foo" 0 3))
+(assert-error  (tn) (lambda () (substring "foo" 0 4)))
+(assert-error  (tn) (lambda () (substring "foo" -1 0)))
+(assert-error  (tn) (lambda () (substring "foo" 1 0)))
+(assert-equal? (tn) "oo"  (substring "foo" 1 3))
+(assert-equal? (tn) "o"   (substring "foo" 2 3))
+(assert-equal? (tn) ""    (substring "foo" 3 3))
+(assert-error  (tn) (lambda () (substring "foo" 4 3)))
+(assert-error  (tn) (lambda () (substring "foo" 4 4)))
+(assert-equal? (tn) "foo" (substring (symbol->string 'foo) 0 3))
 ;;;; mutable
 (assert-equal? "substring mutable" ""    (substring (string-copy "abcde") 0 0))
 (assert-equal? "substring mutable" "a"   (substring (string-copy "abcde") 0 1))