Author: yamakenz
Date: Thu Jul 12 15:17:38 2007
New Revision: 4714
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/src/module-sscm-ext.c
sigscheme-trunk/src/string-procedure.c
sigscheme-trunk/src/vector.c
sigscheme-trunk/test/test-string-proc.scm
sigscheme-trunk/test/test-vector.scm
Log:
* src/vector.c
- (scm_p_vector_mutablep): Rename %vector-mutable? with %%vector-mutable?
* src/module-sscm-ext.c
- (scm_p_pair_mutablep): Rename %pair-mutable? with %%pair-mutable?
* src/string-procedure.c
- (scm_p_string_mutablep): Rename %string-mutable? with %%string-mutable?
* test/test-string-proc.scm
* test/test-vector.scm
- Follow the renamings
* NEWS
- Modify the description about the procedures
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Thu Jul 12 15:17:38 2007
@@ -16,8 +16,8 @@
- New character codec procedures %%current-char-codec,
%%set-current-char-codec! and with-char-codec
- - New debugging procedures %pair-mutable?, %string-mutable?,
- %vector-mutable?
+ - New debugging procedures %%pair-mutable?, %%string-mutable?,
+ %%vector-mutable?
* Specification changes
Modified: sigscheme-trunk/src/module-sscm-ext.c
==============================================================================
--- sigscheme-trunk/src/module-sscm-ext.c (original)
+++ sigscheme-trunk/src/module-sscm-ext.c Thu Jul 12 15:17:38 2007
@@ -177,7 +177,7 @@
SCM_EXPORT ScmObj
scm_p_pair_mutablep(ScmObj kons)
{
- DECLARE_FUNCTION("%pair-mutable?", procedure_fixed_1);
+ DECLARE_FUNCTION("%%pair-mutable?", procedure_fixed_1);
ENSURE_CONS(kons);
Modified: sigscheme-trunk/src/string-procedure.c
==============================================================================
--- sigscheme-trunk/src/string-procedure.c (original)
+++ sigscheme-trunk/src/string-procedure.c Thu Jul 12 15:17:38 2007
@@ -609,7 +609,7 @@
SCM_EXPORT ScmObj
scm_p_string_mutablep(ScmObj str)
{
- DECLARE_FUNCTION("%string-mutable?", procedure_fixed_1);
+ DECLARE_FUNCTION("%%string-mutable?", procedure_fixed_1);
ENSURE_STRING(str);
Modified: sigscheme-trunk/src/vector.c
==============================================================================
--- sigscheme-trunk/src/vector.c (original)
+++ sigscheme-trunk/src/vector.c Thu Jul 12 15:17:38 2007
@@ -218,7 +218,7 @@
SCM_EXPORT ScmObj
scm_p_vector_mutablep(ScmObj vec)
{
- DECLARE_FUNCTION("%vector-mutable?", procedure_fixed_1);
+ DECLARE_FUNCTION("%%vector-mutable?", procedure_fixed_1);
ENSURE_VECTOR(vec);
Modified: sigscheme-trunk/test/test-string-proc.scm
==============================================================================
--- sigscheme-trunk/test/test-string-proc.scm (original)
+++ sigscheme-trunk/test/test-string-proc.scm Thu Jul 12 15:17:38 2007
@@ -45,12 +45,12 @@
(define mutable?
(if sigscheme?
- %string-mutable?
+ %%string-mutable?
(lambda (s) #t)))
(define pair-mutable?
(if sigscheme?
- %pair-mutable?
+ %%pair-mutable?
(lambda (kons) #t)))
;;
Modified: sigscheme-trunk/test/test-vector.scm
==============================================================================
--- sigscheme-trunk/test/test-vector.scm (original)
+++ sigscheme-trunk/test/test-vector.scm Thu Jul 12 15:17:38 2007
@@ -42,6 +42,16 @@
(define tn test-name)
+(define vector-mutable?
+ (if sigscheme?
+ %%vector-mutable?
+ (lambda (v) #t)))
+
+(define pair-mutable?
+ (if sigscheme?
+ %%pair-mutable?
+ (lambda (kons) #t)))
+
;;
;; vector?
;;
@@ -130,14 +140,14 @@
(tn "make-vector mutability")
(if sigscheme?
(begin
- (assert-true (tn) (%vector-mutable? (make-vector 0)))
- (assert-true (tn) (%vector-mutable? (make-vector 1)))
- (assert-true (tn) (%vector-mutable? (make-vector 2)))
- (assert-true (tn) (%vector-mutable? (make-vector 3)))
- (assert-true (tn) (%vector-mutable? (make-vector 0 #t)))
- (assert-true (tn) (%vector-mutable? (make-vector 1 #t)))
- (assert-true (tn) (%vector-mutable? (make-vector 2 #t)))
- (assert-true (tn) (%vector-mutable? (make-vector 3 #t)))))
+ (assert-true (tn) (vector-mutable? (make-vector 0)))
+ (assert-true (tn) (vector-mutable? (make-vector 1)))
+ (assert-true (tn) (vector-mutable? (make-vector 2)))
+ (assert-true (tn) (vector-mutable? (make-vector 3)))
+ (assert-true (tn) (vector-mutable? (make-vector 0 #t)))
+ (assert-true (tn) (vector-mutable? (make-vector 1 #t)))
+ (assert-true (tn) (vector-mutable? (make-vector 2 #t)))
+ (assert-true (tn) (vector-mutable? (make-vector 3 #t)))))
;;
;; vector
@@ -158,9 +168,9 @@
(tn "vector mutability")
(if sigscheme?
(begin
- (assert-true (tn) (%vector-mutable? (vector)))
- (assert-true (tn) (%vector-mutable? (vector 'a)))
- (assert-true (tn) (%vector-mutable? (vector 'a 'b 'c 'd)))))
+ (assert-true (tn) (vector-mutable? (vector)))
+ (assert-true (tn) (vector-mutable? (vector 'a)))
+ (assert-true (tn) (vector-mutable? (vector 'a 'b 'c 'd)))))
;;
;; vector-length
@@ -194,8 +204,8 @@
(define immv5 '#(e0 e1 e2 e3 e4))
(if sigscheme?
(begin
- (assert-true (tn) (not (%vector-mutable? immv1)))
- (assert-true (tn) (not (%vector-mutable? immv5)))))
+ (assert-true (tn) (not (vector-mutable? immv1)))
+ (assert-true (tn) (not (vector-mutable? immv5)))))
(assert-error (tn) (lambda () (vector-ref '#() -1)))
(assert-error (tn) (lambda () (vector-ref '#() 0)))
(assert-error (tn) (lambda () (vector-ref '#() 1)))
@@ -220,8 +230,8 @@
(define mutv5 (vector e0 e1 e2 e3 e4))
(if sigscheme?
(begin
- (assert-true (tn) (%vector-mutable? mutv1))
- (assert-true (tn) (%vector-mutable? mutv5))))
+ (assert-true (tn) (vector-mutable? mutv1))
+ (assert-true (tn) (vector-mutable? mutv5))))
(assert-error (tn) (lambda () (vector-ref (vector) -1)))
(assert-error (tn) (lambda () (vector-ref (vector) 0)))
(assert-error (tn) (lambda () (vector-ref (vector) 1)))
@@ -258,7 +268,7 @@
(if sigscheme?
(assert-true (tn) (let ((v (vector e0)))
(vector-set! v 0 x)
- (%vector-mutable? v))))
+ (vector-mutable? v))))
;; length 0
(assert-error (tn) (lambda () (vector-set! (vector) -1 x)))
@@ -365,13 +375,13 @@
(tn "vector->list mutability")
(if sigscheme?
(begin
- (assert-true (tn) (%pair-mutable? (vector->list '#(a))))
- (assert-true (tn) (%pair-mutable? (vector->list '#(a b))))
- (assert-true (tn) (%pair-mutable? (vector->list '#(a b c))))
-
- (assert-true (tn) (%pair-mutable? (vector->list (vector 'a))))
- (assert-true (tn) (%pair-mutable? (vector->list (vector 'a 'b))))
- (assert-true (tn) (%pair-mutable? (vector->list (vector 'a 'b 'c))))))
+ (assert-true (tn) (pair-mutable? (vector->list '#(a))))
+ (assert-true (tn) (pair-mutable? (vector->list '#(a b))))
+ (assert-true (tn) (pair-mutable? (vector->list '#(a b c))))
+
+ (assert-true (tn) (pair-mutable? (vector->list (vector 'a))))
+ (assert-true (tn) (pair-mutable? (vector->list (vector 'a 'b))))
+ (assert-true (tn) (pair-mutable? (vector->list (vector 'a 'b 'c))))))
;;
;; list->vector
@@ -428,14 +438,14 @@
(tn "list->vector mutability")
(if sigscheme?
(begin
- (assert-true (tn) (%vector-mutable? (list->vector '())))
- (assert-true (tn) (%vector-mutable? (list->vector '(a))))
- (assert-true (tn) (%vector-mutable? (list->vector '(a b))))
- (assert-true (tn) (%vector-mutable? (list->vector '(a b c))))
-
- (assert-true (tn) (%vector-mutable? (list->vector (list 'a))))
- (assert-true (tn) (%vector-mutable? (list->vector (list 'a 'b))))
- (assert-true (tn) (%vector-mutable? (list->vector (list 'a 'b 'c))))))
+ (assert-true (tn) (vector-mutable? (list->vector '())))
+ (assert-true (tn) (vector-mutable? (list->vector '(a))))
+ (assert-true (tn) (vector-mutable? (list->vector '(a b))))
+ (assert-true (tn) (vector-mutable? (list->vector '(a b c))))
+
+ (assert-true (tn) (vector-mutable? (list->vector (list 'a))))
+ (assert-true (tn) (vector-mutable? (list->vector (list 'a 'b))))
+ (assert-true (tn) (vector-mutable? (list->vector (list 'a 'b 'c))))))
;;
;; vector-fill!
