This repository has been archived on 2022-08-10. You can view files and clone it, but cannot push or open issues or pull requests.
chez-openbsd/mats/5_5.ms
2022-07-29 15:12:07 +02:00

782 lines
25 KiB
Scheme

;;; 5-5.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(mat string=?/string-ci=?
(error? (string=?))
(error? (string=? 'a))
(error? (string=? "hi" 'a))
(error? (string=? "hi" 'a "ho"))
(error? (string=? 'a "hi" "ho"))
(error? (string=? "hi" "ho" 'a "he"))
(error? (string-ci=?))
(error? (string-ci=? 'a))
(error? (string-ci=? "hi" 'a))
(error? (string-ci=? "hi" 'a "ho"))
(error? (string-ci=? 'a "hi" "ho"))
(error? (string-ci=? "hi" "ho" 'a "he"))
(string=? "abc" "abc")
(string-ci=? "abc" "abc")
(not (string=? "Abc" "abc"))
(string-ci=? "Abc" "abc")
(not (string=? "abc" "abc "))
(not (string-ci=? "abc" "abc "))
(not (string=? "abc " "abc"))
(not (string-ci=? "abc " "abc"))
(string=? "a")
(string=? "a" "a" "a")
(not (string=? "a" "b" "c"))
(not (string=? "c" "b" "a"))
(not (string=? "b" "c" "a"))
(not (string=? "A" "a" "A"))
(not (string=? "a" "B" "c"))
(not (string=? "C" "b" "A"))
(string-ci=? "a")
(string-ci=? "a" "a" "a")
(not (string-ci=? "a" "b" "c"))
(not (string-ci=? "c" "b" "a"))
(not (string-ci=? "b" "c" "a"))
(string-ci=? "A" "a" "A")
(not (string-ci=? "a" "B" "c"))
(not (string-ci=? "C" "b" "A"))
)
(mat string<?/string-ci<?
(error? (string<?))
(error? (string<? 'a))
(error? (string<? "hi" 'a))
(error? (string<? "hi" 'a "ho"))
(error? (string<? 'a "hi" "ho"))
(error? (string<? "hi" "ho" 'a "he"))
(error? (string-ci<?))
(error? (string-ci<? 'a))
(error? (string-ci<? "hi" 'a))
(error? (string-ci<? "hi" 'a "ho"))
(error? (string-ci<? 'a "hi" "ho"))
(error? (string-ci<? "hi" "ho" 'a "he"))
(not (string<? "abc" "abc"))
(not (string-ci<? "abc" "abc"))
(string<? "Abc" "abc")
(not (string-ci<? "aBc" "AbC"))
(string<? "abc" "abc ")
(string-ci<? "aBc" "AbC ")
(not (string<? "abc " "abc"))
(not (string-ci<? "aBc " "AbC"))
(string<? "a")
(not (string<? "a" "a" "a"))
(string<? "a" "b" "c")
(not (string<? "c" "b" "a"))
(not (string<? "b" "c" "a"))
(not (string<? "A" "a" "A"))
(not (string<? "a" "B" "c"))
(not (string<? "C" "b" "A"))
(string-ci<? "a")
(not (string-ci<? "a" "a" "a"))
(string-ci<? "a" "b" "c")
(not (string-ci<? "c" "b" "a"))
(not (string-ci<? "b" "c" "a"))
(not (string-ci<? "A" "a" "A"))
(string-ci<? "a" "B" "c")
(not (string-ci<? "C" "b" "A"))
)
(mat string>?/string-ci>?
(error? (string>?))
(error? (string>? 'a))
(error? (string>? "hi" 'a))
(error? (string>? "hi" 'a "ho"))
(error? (string>? 'a "hi" "ho"))
(error? (string>? "hi" "ho" 'a "he"))
(error? (string-ci>?))
(error? (string-ci>? 'a))
(error? (string-ci>? "hi" 'a))
(error? (string-ci>? "hi" 'a "ho"))
(error? (string-ci>? 'a "hi" "ho"))
(error? (string-ci>? "hi" "ho" 'a "he"))
(not (string>? "abc" "abc"))
(not (string-ci>? "abc" "abc"))
(string>? "abc" "Abc")
(not (string-ci>? "aBc" "AbC"))
(not (string>? "abc" "abc "))
(not (string-ci>? "aBc" "AbC "))
(string>? "abc " "abc")
(string-ci>? "aBc " "AbC")
(string>? "a")
(not (string>? "a" "a" "a"))
(not (string>? "a" "b" "c"))
(string>? "c" "b" "a")
(not (string>? "b" "c" "a"))
(not (string>? "A" "a" "A"))
(not (string>? "a" "B" "c"))
(not (string>? "C" "b" "A"))
(string-ci>? "a")
(not (string-ci>? "a" "a" "a"))
(not (string-ci>? "a" "b" "c"))
(string-ci>? "c" "b" "a")
(not (string-ci>? "b" "c" "a"))
(not (string-ci>? "A" "a" "A"))
(not (string-ci>? "a" "B" "c"))
(string-ci>? "C" "b" "A")
)
(mat string<=?/string-ci<=?
(error? (string<=?))
(error? (string<=? 'a))
(error? (string<=? "hi" 'a))
(error? (string<=? "hi" 'a "ho"))
(error? (string<=? 'a "hi" "ho"))
(error? (string<=? "hi" "ho" 'a "he"))
(error? (string-ci<=?))
(error? (string-ci<=? 'a))
(error? (string-ci<=? "hi" 'a))
(error? (string-ci<=? "hi" 'a "ho"))
(error? (string-ci<=? 'a "hi" "ho"))
(error? (string-ci<=? "hi" "ho" 'a "he"))
(string<=? "abc" "abc")
(string-ci<=? "abc" "abc")
(not (string<=? "abc" "Abc"))
(string-ci<=? "aBc" "AbC")
(string<=? "abc" "abc ")
(string-ci<=? "aBc" "AbC ")
(not (string<=? "abc " "abc"))
(not (string-ci<=? "aBc " "AbC"))
(string<=? "a")
(string<=? "a" "a" "a")
(string<=? "a" "b" "c")
(not (string<=? "c" "b" "a"))
(not (string<=? "b" "c" "a"))
(not (string<=? "A" "a" "A"))
(not (string<=? "a" "B" "c"))
(not (string<=? "C" "b" "A"))
(string-ci<=? "a")
(string-ci<=? "a" "a" "a")
(string-ci<=? "a" "b" "c")
(not (string-ci<=? "c" "b" "a"))
(not (string-ci<=? "b" "c" "a"))
(string-ci<=? "A" "a" "A")
(string-ci<=? "a" "B" "c")
(not (string-ci<=? "C" "b" "A"))
)
(mat string>=?/string-ci>=?
(error? (string>=?))
(error? (string>=? 'a))
(error? (string>=? "hi" 'a))
(error? (string>=? "hi" 'a "ho"))
(error? (string>=? 'a "hi" "ho"))
(error? (string>=? "hi" "ho" 'a "he"))
(error? (string-ci>=?))
(error? (string-ci>=? 'a))
(error? (string-ci>=? "hi" 'a))
(error? (string-ci>=? "hi" 'a "ho"))
(error? (string-ci>=? 'a "hi" "ho"))
(error? (string-ci>=? "hi" "ho" 'a "he"))
(string>=? "abc" "abc")
(string-ci>=? "abc" "abc")
(not (string>=? "Abc" "abc"))
(string-ci>=? "aBc" "AbC")
(not (string>=? "abc" "abc "))
(not (string-ci>=? "aBc" "AbC "))
(string>=? "abc " "abc")
(string-ci>=? "aBc " "AbC")
(string>=? "a")
(string>=? "a" "a" "a")
(not (string>=? "a" "b" "c"))
(string>=? "c" "b" "a")
(not (string>=? "b" "c" "a"))
(not (string>=? "A" "a" "A"))
(not (string>=? "a" "B" "c"))
(not (string>=? "C" "b" "A"))
(string-ci>=? "a")
(string-ci>=? "a" "a" "a")
(not (string-ci>=? "a" "b" "c"))
(string-ci>=? "c" "b" "a")
(not (string-ci>=? "b" "c" "a"))
(string-ci>=? "A" "a" "A")
(not (string-ci>=? "a" "B" "c"))
(string-ci>=? "C" "b" "A")
)
(mat r6rs:string=?/r6rs:string-ci=?
(error? (r6rs:string=?))
(error? (r6rs:string=? 'a))
(error? (r6rs:string=? "hi" 'a))
(error? (r6rs:string=? "hi" 'a "ho"))
(error? (r6rs:string=? 'a "hi" "ho"))
(error? (r6rs:string=? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci=?))
(error? (r6rs:string-ci=? 'a))
(error? (r6rs:string-ci=? "hi" 'a))
(error? (r6rs:string-ci=? "hi" 'a "ho"))
(error? (r6rs:string-ci=? 'a "hi" "ho"))
(error? (r6rs:string-ci=? "hi" "ho" 'a "he"))
(r6rs:string=? "abc" "abc")
(r6rs:string-ci=? "abc" "abc")
(not (r6rs:string=? "Abc" "abc"))
(r6rs:string-ci=? "Abc" "abc")
(not (r6rs:string=? "abc" "abc "))
(not (r6rs:string-ci=? "abc" "abc "))
(not (r6rs:string=? "abc " "abc"))
(not (r6rs:string-ci=? "abc " "abc"))
(r6rs:string=? "a" "a" "a")
(not (r6rs:string=? "a" "b" "c"))
(not (r6rs:string=? "c" "b" "a"))
(not (r6rs:string=? "b" "c" "a"))
(not (r6rs:string=? "A" "a" "A"))
(not (r6rs:string=? "a" "B" "c"))
(not (r6rs:string=? "C" "b" "A"))
(r6rs:string-ci=? "a" "a" "a")
(not (r6rs:string-ci=? "a" "b" "c"))
(not (r6rs:string-ci=? "c" "b" "a"))
(not (r6rs:string-ci=? "b" "c" "a"))
(r6rs:string-ci=? "A" "a" "A")
(not (r6rs:string-ci=? "a" "B" "c"))
(not (r6rs:string-ci=? "C" "b" "A"))
)
(mat r6rs:string<?/r6rs:string-ci<?
(error? (r6rs:string<?))
(error? (r6rs:string<? 'a))
(error? (r6rs:string<? "hi" 'a))
(error? (r6rs:string<? "hi" 'a "ho"))
(error? (r6rs:string<? 'a "hi" "ho"))
(error? (r6rs:string<? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci<?))
(error? (r6rs:string-ci<? 'a))
(error? (r6rs:string-ci<? "hi" 'a))
(error? (r6rs:string-ci<? "hi" 'a "ho"))
(error? (r6rs:string-ci<? 'a "hi" "ho"))
(error? (r6rs:string-ci<? "hi" "ho" 'a "he"))
(not (r6rs:string<? "abc" "abc"))
(not (r6rs:string-ci<? "abc" "abc"))
(r6rs:string<? "Abc" "abc")
(not (r6rs:string-ci<? "aBc" "AbC"))
(r6rs:string<? "abc" "abc ")
(r6rs:string-ci<? "aBc" "AbC ")
(not (r6rs:string<? "abc " "abc"))
(not (r6rs:string-ci<? "aBc " "AbC"))
(not (r6rs:string<? "a" "a" "a"))
(r6rs:string<? "a" "b" "c")
(not (r6rs:string<? "c" "b" "a"))
(not (r6rs:string<? "b" "c" "a"))
(not (r6rs:string<? "A" "a" "A"))
(not (r6rs:string<? "a" "B" "c"))
(not (r6rs:string<? "C" "b" "A"))
(not (r6rs:string-ci<? "a" "a" "a"))
(r6rs:string-ci<? "a" "b" "c")
(not (r6rs:string-ci<? "c" "b" "a"))
(not (r6rs:string-ci<? "b" "c" "a"))
(not (r6rs:string-ci<? "A" "a" "A"))
(r6rs:string-ci<? "a" "B" "c")
(not (r6rs:string-ci<? "C" "b" "A"))
)
(mat r6rs:string>?/r6rs:string-ci>?
(error? (r6rs:string>?))
(error? (r6rs:string>? 'a))
(error? (r6rs:string>? "hi" 'a))
(error? (r6rs:string>? "hi" 'a "ho"))
(error? (r6rs:string>? 'a "hi" "ho"))
(error? (r6rs:string>? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci>?))
(error? (r6rs:string-ci>? 'a))
(error? (r6rs:string-ci>? "hi" 'a))
(error? (r6rs:string-ci>? "hi" 'a "ho"))
(error? (r6rs:string-ci>? 'a "hi" "ho"))
(error? (r6rs:string-ci>? "hi" "ho" 'a "he"))
(not (r6rs:string>? "abc" "abc"))
(not (r6rs:string-ci>? "abc" "abc"))
(r6rs:string>? "abc" "Abc")
(not (r6rs:string-ci>? "aBc" "AbC"))
(not (r6rs:string>? "abc" "abc "))
(not (r6rs:string-ci>? "aBc" "AbC "))
(r6rs:string>? "abc " "abc")
(r6rs:string-ci>? "aBc " "AbC")
(not (r6rs:string>? "a" "a" "a"))
(not (r6rs:string>? "a" "b" "c"))
(r6rs:string>? "c" "b" "a")
(not (r6rs:string>? "b" "c" "a"))
(not (r6rs:string>? "A" "a" "A"))
(not (r6rs:string>? "a" "B" "c"))
(not (r6rs:string>? "C" "b" "A"))
(not (r6rs:string-ci>? "a" "a" "a"))
(not (r6rs:string-ci>? "a" "b" "c"))
(r6rs:string-ci>? "c" "b" "a")
(not (r6rs:string-ci>? "b" "c" "a"))
(not (r6rs:string-ci>? "A" "a" "A"))
(not (r6rs:string-ci>? "a" "B" "c"))
(r6rs:string-ci>? "C" "b" "A")
)
(mat r6rs:string<=?/r6rs:string-ci<=?
(error? (r6rs:string<=?))
(error? (r6rs:string<=? 'a))
(error? (r6rs:string<=? "hi" 'a))
(error? (r6rs:string<=? "hi" 'a "ho"))
(error? (r6rs:string<=? 'a "hi" "ho"))
(error? (r6rs:string<=? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci<=?))
(error? (r6rs:string-ci<=? 'a))
(error? (r6rs:string-ci<=? "hi" 'a))
(error? (r6rs:string-ci<=? "hi" 'a "ho"))
(error? (r6rs:string-ci<=? 'a "hi" "ho"))
(error? (r6rs:string-ci<=? "hi" "ho" 'a "he"))
(r6rs:string<=? "abc" "abc")
(r6rs:string-ci<=? "abc" "abc")
(not (r6rs:string<=? "abc" "Abc"))
(r6rs:string-ci<=? "aBc" "AbC")
(r6rs:string<=? "abc" "abc ")
(r6rs:string-ci<=? "aBc" "AbC ")
(not (r6rs:string<=? "abc " "abc"))
(not (r6rs:string-ci<=? "aBc " "AbC"))
(r6rs:string<=? "a" "a" "a")
(r6rs:string<=? "a" "b" "c")
(not (r6rs:string<=? "c" "b" "a"))
(not (r6rs:string<=? "b" "c" "a"))
(not (r6rs:string<=? "A" "a" "A"))
(not (r6rs:string<=? "a" "B" "c"))
(not (r6rs:string<=? "C" "b" "A"))
(r6rs:string-ci<=? "a" "a" "a")
(r6rs:string-ci<=? "a" "b" "c")
(not (r6rs:string-ci<=? "c" "b" "a"))
(not (r6rs:string-ci<=? "b" "c" "a"))
(r6rs:string-ci<=? "A" "a" "A")
(r6rs:string-ci<=? "a" "B" "c")
(not (r6rs:string-ci<=? "C" "b" "A"))
)
(mat r6rs:string>=?/r6rs:string-ci>=?
(error? (r6rs:string>=?))
(error? (r6rs:string>=? 'a))
(error? (r6rs:string>=? "hi" 'a))
(error? (r6rs:string>=? "hi" 'a "ho"))
(error? (r6rs:string>=? 'a "hi" "ho"))
(error? (r6rs:string>=? "hi" "ho" 'a "he"))
(error? (r6rs:string-ci>=?))
(error? (r6rs:string-ci>=? 'a))
(error? (r6rs:string-ci>=? "hi" 'a))
(error? (r6rs:string-ci>=? "hi" 'a "ho"))
(error? (r6rs:string-ci>=? 'a "hi" "ho"))
(error? (r6rs:string-ci>=? "hi" "ho" 'a "he"))
(r6rs:string>=? "abc" "abc")
(r6rs:string-ci>=? "abc" "abc")
(not (r6rs:string>=? "Abc" "abc"))
(r6rs:string-ci>=? "aBc" "AbC")
(not (r6rs:string>=? "abc" "abc "))
(not (r6rs:string-ci>=? "aBc" "AbC "))
(r6rs:string>=? "abc " "abc")
(r6rs:string-ci>=? "aBc " "AbC")
(r6rs:string>=? "a" "a" "a")
(not (r6rs:string>=? "a" "b" "c"))
(r6rs:string>=? "c" "b" "a")
(not (r6rs:string>=? "b" "c" "a"))
(not (r6rs:string>=? "A" "a" "A"))
(not (r6rs:string>=? "a" "B" "c"))
(not (r6rs:string>=? "C" "b" "A"))
(r6rs:string-ci>=? "a" "a" "a")
(not (r6rs:string-ci>=? "a" "b" "c"))
(r6rs:string-ci>=? "c" "b" "a")
(not (r6rs:string-ci>=? "b" "c" "a"))
(r6rs:string-ci>=? "A" "a" "A")
(not (r6rs:string-ci>=? "a" "B" "c"))
(r6rs:string-ci>=? "C" "b" "A")
)
(mat string
(error? (string 'a))
(error? (string #\a 'a))
(error? (string #\a #\b 'a))
(equal? (string #\a #\b #\c) "abc")
(equal? (string #\a (string-ref "b" 0) #\c) "abc")
(equal? (let ([x #\a]) (string x (string-ref "b" 0) #\c)) "abc")
(eq? (string) "")
)
(mat make-string
(error? (make-string))
(error? (make-string 2 #\a #\b))
(error? (make-string 3 'a))
(error? (make-string 'a 3))
(eqv? (make-string 0) "")
(eqv? (make-string (- 4 4)) (string))
(eqv? (string-length (make-string 3)) 3)
(eqv? (string-length (make-string (+ 3 4))) 7)
(eqv? (string-length (make-string 1000)) 1000)
(string=? (make-string 10 #\a) "aaaaaaaaaa")
(string=? (make-string (- 4 1) #\a) "aaa")
(string=? (make-string (- 4 1) (string-ref "b" 0)) "bbb")
(andmap char? (string->list (make-string 20)))
)
(mat string-length
(error? (string-length))
(error? (string-length "hi" "there"))
(error? (string-length 'a))
(eqv? (string-length "abc") 3)
(eqv? (string-length "") 0)
)
(mat $string-ref-check?
(let ([s (make-string 3)] [imm-s (string->immutable-string (make-string 3))] [not-s (make-vector 3)])
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
(and
(not (#%$string-ref-check? not-s i0))
(not (#%$string-ref-check? s ifalse))
(not (#%$string-ref-check? s i-1))
(not (#%$string-ref-check? imm-s i-1))
(#%$string-ref-check? s 0)
(#%$string-ref-check? s 1)
(#%$string-ref-check? s 2)
(#%$string-ref-check? imm-s 0)
(#%$string-ref-check? imm-s 1)
(#%$string-ref-check? imm-s 2)
(#%$string-ref-check? s i0)
(#%$string-ref-check? s i1)
(#%$string-ref-check? s i2)
(#%$string-ref-check? imm-s i0)
(#%$string-ref-check? imm-s i1)
(#%$string-ref-check? imm-s i2)
(not (#%$string-ref-check? s 3))
(not (#%$string-ref-check? s i3))
(not (#%$string-ref-check? s ibig))
(not (#%$string-ref-check? imm-s 3))
(not (#%$string-ref-check? imm-s i3))
(not (#%$string-ref-check? imm-s ibig)))))
)
(mat string-ref
(error? (string-ref))
(error? (string-ref "hi"))
(error? (string-ref "hi" 3 4))
(error? (string-ref 'a 3))
(error? (string-ref "hi" 'a))
(error? (string-ref "hi" -1))
(error? (string-ref "hi" 2))
(eqv? (string-ref "abc" 0) #\a)
(eqv? (string-ref "abc" 1) #\b)
(eqv? (string-ref "abc" 2) #\c)
)
(mat string-set!
(error? (string-set!))
(error? (string-set! "hi"))
(error? (string-set! "hi" 1))
(error? (string-set! "hi" 3 #\a #\b))
(error? (string-set! 'a 3 #\a))
(error? (string-set! "hi" 'a #\a))
(error? (string-set! "hi" 3 'a))
(error? (string-set! "hi" -1 #\a))
(error? (string-set! "hi" 2 #\a))
(let ((s (string #\a #\b #\c)))
(and
(begin (string-set! s 0 #\x) (equal? s "xbc"))
(begin (string-set! s 1 #\y) (equal? s "xyc"))
(begin (string-set! s 2 #\z) (equal? s "xyz"))))
)
(mat string-copy
; incorrect argument count
(error? (string-copy))
(error? (string-copy "hi" "there"))
; not a string
(error? (string-copy 'a))
(error? (if (string-copy '(a b c)) #f #t))
(equal? (string-copy "") "")
(equal? (string-copy "abc") "abc")
(let* ((x1 (string #\1 #\2 #\3)) (x2 (string-copy x1)))
(and (equal? x2 x1) (not (eq? x2 x1))))
)
(mat string-copy!
(begin
(define $s1 (string #\1 #\2 #\3 #\4))
(define $s2 (string #\a #\b #\c #\d #\e #\f #\g #\h #\i))
(and (string? $s1)
(string? $s2)
(eqv? (string-length $s1) 4)
(eqv? (string-length $s2) 9)))
; wrong number of arguments
(error? (string-copy!))
(error? (string-copy! $s2))
(error? (string-copy! $s2 3))
(error? (string-copy! $s2 3 $s1))
(error? (string-copy! $s2 3 $s1 1))
(error? (if (string-copy! $s2 3 $s1 1 2 3) #f #t))
; not string
(error? (string-copy! 0 0 $s2 0 0))
(error? (if (string-copy! $s1 0 (bytevector 1 2 3) 0 0) #f #t))
; bad index
(error? (string-copy! $s1 -1 $s2 0 0))
(error? (string-copy! $s1 0 $s2 -1 0))
(error? (string-copy! $s1 'a $s2 0 0))
(error? (string-copy! $s1 0 $s2 0.0 0))
(error? (string-copy! $s1 (+ (most-positive-fixnum) 1) $s2 0 0))
(error? (if (string-copy! $s1 0 $s2 (+ (most-positive-fixnum) 1) 0) #f #t))
; bad count
(error? (string-copy! $s1 0 $s2 0 -1))
(error? (string-copy! $s1 0 $s2 0 (+ (most-positive-fixnum) 1)))
(error? (if (string-copy! $s1 0 $s2 0 'a) #f #t))
; beyond end
(error? (string-copy! $s1 0 $s2 0 5))
(error? (string-copy! $s2 0 $s1 0 5))
(error? (string-copy! $s1 1 $s2 0 4))
(error? (string-copy! $s2 0 $s1 1 4))
(error? (string-copy! $s1 2 $s2 0 3))
(error? (string-copy! $s2 0 $s1 2 3))
(error? (string-copy! $s1 3 $s2 0 2))
(error? (string-copy! $s2 0 $s1 3 2))
(error? (string-copy! $s1 4 $s2 0 1))
(error? (string-copy! $s2 0 $s1 4 1))
(error? (string-copy! $s2 0 $s1 0 500))
(error? (if (string-copy! $s2 500 $s1 0 0) #f #t))
; make sure no damage done
(and (string? $s1)
(string? $s2)
(equal? $s1 "1234")
(equal? $s2 "abcdefghi"))
(begin
(string-copy! $s2 3 $s1 1 2)
(and (equal? $s1 "1de4")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 6 $s1 2 2)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 0 $s1 4 0)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 3 $s1 4 0)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 3 $s2 4 0)
(and (equal? $s1 "1dgh")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s2 2 $s1 1 3)
(and (equal? $s1 "1cde")
(equal? $s2 "abcdefghi")))
(begin
(string-copy! $s1 0 $s2 3 4)
(and (equal? $s1 "1cde")
(equal? $s2 "abc1cdehi")))
(begin
(string-copy! $s2 0 $s2 3 5)
(and (equal? $s1 "1cde")
(equal? $s2 "abcabc1ci")))
(begin
(string-copy! $s2 4 $s2 2 5)
(and (equal? $s1 "1cde")
(equal? $s2 "abbc1cici")))
(begin
(string-copy! $s2 1 $s2 1 7)
(and (equal? $s1 "1cde")
(equal? $s2 "abbc1cici")))
)
(mat string-truncate!
(begin
(define $s (string #\a #\b #\c #\d #\e #\f #\g #\h #\i))
(and (string? $s)
(fx= (string-length $s) 9)
(string=? $s "abcdefghi")))
; wrong number of arguments
(error? (string-truncate!))
(error? (string-truncate! $s))
(error? (string-truncate! $s 3 15))
; not string
(error? (string-truncate! 0 0))
(error? (if (string-truncate! (bytevector 1 2 3) 2) #f #t))
; bad length
(error? (string-truncate! $s -1))
(error? (string-truncate! $s 10))
(error? (string-truncate! $s 1000))
(error? (string-truncate! $s (+ (most-positive-fixnum) 1)))
(error? (string-truncate! $s 'a))
(begin
(string-truncate! $s 9)
(and (string? $s)
(fx= (string-length $s) 9)
(string=? $s "abcdefghi")))
(begin
(string-truncate! $s 8)
(and (string? $s)
(fx= (string-length $s) 8)
(string=? $s "abcdefgh")))
(begin
(string-truncate! $s 6)
(and (string? $s)
(fx= (string-length $s) 6)
(string=? $s "abcdef")))
(begin
(string-truncate! $s 3)
(and (string? $s)
(fx= (string-length $s) 3)
(string=? $s "abc")))
(begin
(define $s2 (string-truncate! $s 0))
(and (eqv? $s2 "")
(string? $s)
(fx= (string-length $s) 3)
(string=? $s "abc")))
)
(mat string-append
(error? (string-append 'a))
(error? (string-append "hi" 'b))
(error? (string-append "hi" 'b "there"))
(error? (string-copy 'a))
(eqv? (string-append) "")
(let ([x (make-string 10 #\space)])
(and (equal? x " ")
(not (eq? x (string-append x)))))
(equal? (string-append "abc") "abc")
(equal? (string-append "abc" "xyz") "abcxyz")
(equal? (string-append "hi " "there " "mom") "hi there mom")
(equal? (string-append "" "there") "there")
(equal? (string-append "hi " "") "hi ")
(eqv? (string-append "" "") "")
)
(mat substring
(error? (substring))
(error? (substring "hi"))
(error? (substring "hi" 0))
(error? (substring "hi" 0 2 3))
(error? (substring "hi" 0 3))
(error? (substring "hi" -1 2))
(error? (substring "hi" 'a 2))
(error? (substring 'a 0 1))
(error? (substring "hi" 0 'a))
(error? (substring "hi" 1 0))
(equal? (substring "hi there" 0 1) "h")
(equal? (substring "hi there" 3 6) "the")
(equal? (substring "hi there" 5 5) "")
(equal? (substring "hi there" 0 8) "hi there")
(eqv? (substring "" 0 0) "")
)
(mat string-fill!
(error? (string-fill!))
(error? (string-fill! "hi"))
(error? (string-fill! "hi" #\a #\b))
(error? (string-fill! "hi" 'a))
(error? (string-fill! 'a #\a))
(let ([s (string #\a #\b #\c)])
(and (equal? s "abc")
(begin (string-fill! s #\*) (equal? s "***"))))
; test for bug filling beyond the end of the string
(eqv? (let* ((s1 (make-string 3 #\a))
(s2 (make-string 3 #\b)))
(string-fill! s1 #\*)
(string-ref s2 0))
#\b)
)
(mat substring-fill!
(error? (substring-fill!))
(error? (substring-fill! "hi"))
(error? (substring-fill! "hi" 0))
(error? (substring-fill! "hi" 0 2))
(error? (substring-fill! "hi" 0 3 #\a))
(error? (substring-fill! "hi" -1 3 #\a))
(error? (substring-fill! 'a 0 1 #\a))
(error? (substring-fill! "hi" 0 'a #\a))
(error? (substring-fill! "hi" 1 0 #\a))
(let ([s (string-copy "hitme!")])
(substring-fill! s 0 5 #\a)
(equal? s "aaaaa!"))
(let ([s ""])
(substring-fill! s 0 0 #\a)
(eqv? s ""))
(let ([s (string-copy "ABCDE")])
(and (begin
(substring-fill! s 0 0 #\$)
(equal? s "ABCDE"))
(begin
(substring-fill! s 2 5 #\$)
(equal? s "AB$$$"))
(begin
(substring-fill! s 0 3 #\&)
(equal? s "&&&$$"))))
)
(mat list->string
(error? (list->string))
(error? (list->string '(#\a #\b) '(#\c #\d)))
(error? (list->string 'a))
(error? (list->string '(a b)))
(error? (list->string '(#\a #\b . #\c)))
(error? (list->string (let ([ls (list #\a #\b #\c)]) (set-cdr! (cddr ls) (cdr ls)) ls)))
(equal? (list->string '(#\a #\b #\c)) "abc")
(equal? (list->string '()) "")
)
(mat string->list
(error? (string->list))
(error? (string->list "ab" "cd"))
(error? (string->list 'a))
(equal? (string->list "abc") '(#\a #\b #\c))
(equal? (string->list "") '())
)
(mat string->immutable-string
(begin
(define immutable-abc-string
(string->immutable-string (string #\a #\b #\c)))
#t)
(immutable-string? immutable-abc-string)
(not (mutable-string? immutable-abc-string))
(equal? "abc" immutable-abc-string)
(eq? immutable-abc-string
(string->immutable-string immutable-abc-string))
(not (immutable-string? (make-string 5)))
(mutable-string? (make-string 5))
(immutable-string? (string->immutable-string (string)))
(not (mutable-string? (string->immutable-string (string))))
(not (immutable-string? (string)))
(mutable-string? (string))
(not (immutable-string? (string-copy immutable-abc-string)))
(error? (string-set! immutable-abc-string 0 #\a))
(error? (string-fill! immutable-abc-string #\a))
(error? (substring-fill! immutable-abc-string 0 1 #\a))
(error? (string-copy! "xyz" 0 immutable-abc-string 0 3))
(error? (string-truncate! immutable-abc-string 1))
)