guile18/test-suite/tests/strings.test

   1 ;;;; strings.test --- test suite for Guile's string functions    -*- scheme -*-
   2 ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999
   3 ;;;;
   4 ;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This program is free software; you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation; either version 2, or (at your option)
   9 ;;;; any later version.
  10 ;;;;
  11 ;;;; This program is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with this software; see the file COPYING.  If not, write to
  18 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19 ;;;; Boston, MA 02110-1301 USA
  20
  21 (define-module (test-strings)
  22   #:use-module (test-suite lib))
  23
  24
  25 (define exception:read-only-string
  26   (cons 'misc-error "^string is read-only"))
  27
  28 ;; Create a string from integer char values, eg. (string-ints 65) => "A"
  29 (define (string-ints . args)
  30   (apply string (map integer->char args)))
  31
  32
  33 ;;
  34 ;; string=?
  35 ;;
  36
  37 (with-test-prefix "string=?"
  38
  39   (pass-if "respects 1st parameter's string length"
  40     (not (string=? "foo\0" "foo")))
  41
  42   (pass-if "respects 2nd paramter's string length"
  43     (not (string=? "foo" "foo\0")))
  44
  45   (with-test-prefix "wrong argument type"
  46
  47     (pass-if-exception "1st argument symbol"
  48       exception:wrong-type-arg
  49       (string=? 'a "a"))
  50
  51     (pass-if-exception "2nd argument symbol"
  52       exception:wrong-type-arg
  53       (string=? "a" 'b))))
  54
  55 ;;
  56 ;; string<?
  57 ;;
  58
  59 (with-test-prefix "string<?"
  60
  61   (pass-if "respects string length"
  62     (and (not (string<? "foo\0a" "foo\0a"))
  63          (string<? "foo\0a" "foo\0b")))
  64
  65   (with-test-prefix "wrong argument type"
  66
  67     (pass-if-exception "1st argument symbol"
  68       exception:wrong-type-arg
  69       (string<? 'a "a"))
  70
  71     (pass-if-exception "2nd argument symbol"
  72       exception:wrong-type-arg
  73       (string<? "a" 'b)))
  74
  75   (pass-if "same as char<?"
  76     (eq? (char<? (integer->char 0) (integer->char 255))
  77          (string<? (string-ints 0) (string-ints 255)))))
  78
  79 ;;
  80 ;; string-ci<?
  81 ;;
  82
  83 (with-test-prefix "string-ci<?"
  84
  85   (pass-if "respects string length"
  86     (and (not (string-ci<? "foo\0a" "foo\0a"))
  87          (string-ci<? "foo\0a" "foo\0b")))
  88
  89   (with-test-prefix "wrong argument type"
  90
  91     (pass-if-exception "1st argument symbol"
  92       exception:wrong-type-arg
  93       (string-ci<? 'a "a"))
  94
  95     (pass-if-exception "2nd argument symbol"
  96       exception:wrong-type-arg
  97       (string-ci<? "a" 'b)))
  98
  99   (pass-if "same as char-ci<?"
 100     (eq? (char-ci<? (integer->char 0) (integer->char 255))
 101          (string-ci<? (string-ints 0) (string-ints 255)))))
 102
 103 ;;
 104 ;; string<=?
 105 ;;
 106
 107 (with-test-prefix "string<=?"
 108
 109   (pass-if "same as char<=?"
 110     (eq? (char<=? (integer->char 0) (integer->char 255))
 111          (string<=? (string-ints 0) (string-ints 255)))))
 112
 113 ;;
 114 ;; string-ci<=?
 115 ;;
 116
 117 (with-test-prefix "string-ci<=?"
 118
 119   (pass-if "same as char-ci<=?"
 120     (eq? (char-ci<=? (integer->char 0) (integer->char 255))
 121          (string-ci<=? (string-ints 0) (string-ints 255)))))
 122
 123 ;;
 124 ;; string>?
 125 ;;
 126
 127 (with-test-prefix "string>?"
 128
 129   (pass-if "same as char>?"
 130     (eq? (char>? (integer->char 0) (integer->char 255))
 131          (string>? (string-ints 0) (string-ints 255)))))
 132
 133 ;;
 134 ;; string-ci>?
 135 ;;
 136
 137 (with-test-prefix "string-ci>?"
 138
 139   (pass-if "same as char-ci>?"
 140     (eq? (char-ci>? (integer->char 0) (integer->char 255))
 141          (string-ci>? (string-ints 0) (string-ints 255)))))
 142
 143 ;;
 144 ;; string>=?
 145 ;;
 146
 147 (with-test-prefix "string>=?"
 148
 149   (pass-if "same as char>=?"
 150     (eq? (char>=? (integer->char 0) (integer->char 255))
 151          (string>=? (string-ints 0) (string-ints 255)))))
 152
 153 ;;
 154 ;; string-ci>=?
 155 ;;
 156
 157 (with-test-prefix "string-ci>=?"
 158
 159   (pass-if "same as char-ci>=?"
 160     (eq? (char-ci>=? (integer->char 0) (integer->char 255))
 161          (string-ci>=? (string-ints 0) (string-ints 255)))))
 162
 163 ;;
 164 ;; string-ref
 165 ;;
 166
 167 (with-test-prefix "string-ref"
 168
 169   (pass-if-exception "empty string"
 170     exception:out-of-range
 171     (string-ref "" 0))
 172
 173   (pass-if-exception "empty string and non-zero index"
 174     exception:out-of-range
 175     (string-ref "" 123))
 176
 177   (pass-if-exception "out of range"
 178     exception:out-of-range
 179     (string-ref "hello" 123))
 180
 181   (pass-if-exception "negative index"
 182     exception:out-of-range
 183     (string-ref "hello" -1))
 184
 185   (pass-if "regular string"
 186     (char=? (string-ref "GNU Guile" 4) #\G)))
 187
 188 ;;
 189 ;; string-set!
 190 ;;
 191
 192 (with-test-prefix "string-set!"
 193
 194   (pass-if-exception "empty string"
 195     exception:out-of-range
 196     (string-set! (string-copy "") 0 #\x))
 197
 198   (pass-if-exception "empty string and non-zero index"
 199     exception:out-of-range
 200     (string-set! (string-copy "") 123 #\x))
 201
 202   (pass-if-exception "out of range"
 203     exception:out-of-range
 204     (string-set! (string-copy "hello") 123 #\x))
 205
 206   (pass-if-exception "negative index"
 207     exception:out-of-range
 208     (string-set! (string-copy "hello") -1 #\x))
 209
 210   (pass-if-exception "read-only string"
 211     exception:read-only-string
 212     (string-set! (substring/read-only "abc" 0) 1 #\space))
 213
 214   (pass-if "regular string"
 215     (let ((s (string-copy "GNU guile")))
 216       (string-set! s 4 #\G)
 217       (char=? (string-ref s 4) #\G))))
 218
 219
 220 (with-test-prefix "string-split"
 221
 222   ;; in guile 1.6.7 and earlier, character >=128 wasn't matched in the string
 223   (pass-if "char 255"
 224     (equal? '("a" "b")
 225             (string-split (string #\a (integer->char 255) #\b)
 226                           (integer->char 255)))))
 227
 228 (with-test-prefix "substring-move!"
 229
 230   (pass-if-exception "substring-move! checks start and end correctly"
 231     exception:out-of-range
 232     (substring-move! "sample" 3 0 "test" 3)))
 233
 234 (with-test-prefix "substring/shared"
 235
 236   (pass-if "modify indirectly"
 237     (let ((str (string-copy "foofoofoo")))
 238       (string-upcase! (substring/shared str 3 6))
 239       (string=? str "fooFOOfoo")))
 240
 241   (pass-if "modify cow indirectly"
 242     (let* ((str1 (string-copy "foofoofoo"))
 243            (str2 (string-copy str1)))
 244       (string-upcase! (substring/shared str2 3 6))
 245       (and (string=? str1 "foofoofoo")
 246            (string=? str2 "fooFOOfoo"))))
 247
 248   (pass-if "modify double indirectly"
 249     (let* ((str1 (string-copy "foofoofoo"))
 250            (str2 (substring/shared str1 2 7)))
 251       (string-upcase! (substring/shared str2 1 4))
 252       (string=? str1 "fooFOOfoo")))
 253
 254   (pass-if "modify cow double indirectly"
 255     (let* ((str1 "foofoofoo")
 256            (str2 (substring str1 2 7)))
 257       (string-upcase! (substring/shared str2 1 4))
 258       (and (string=? str1 "foofoofoo")
 259            (string=? str2 "oFOOf")))))