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 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-set!
 165 ;;
 166
 167 (with-test-prefix "string-set!"
 168
 169   (pass-if-exception "read-only string"
 170     exception:read-only-string
 171     (string-set! (substring/read-only "abc" 0) 1 #\space)))
 172
 173 (with-test-prefix "string-split"
 174
 175   ;; in guile 1.6.7 and earlier, character >=128 wasn't matched in the string
 176   (pass-if "char 255"
 177     (equal? '("a" "b")
 178             (string-split (string #\a (integer->char 255) #\b)
 179                           (integer->char 255)))))
 180
 181 (with-test-prefix "substring-move!"
 182
 183   (pass-if-exception "substring-move! checks start and end correctly"
 184     exception:out-of-range
 185     (substring-move! "sample" 3 0 "test" 3)))
 186
 187 (with-test-prefix "substring/shared"
 188
 189   (pass-if "modify indirectly"
 190     (let ((str (string-copy "foofoofoo")))
 191       (string-upcase! (substring/shared str 3 6))
 192       (string=? str "fooFOOfoo")))
 193
 194   (pass-if "modify cow indirectly"
 195     (let* ((str1 (string-copy "foofoofoo"))
 196            (str2 (string-copy str1)))
 197       (string-upcase! (substring/shared str2 3 6))
 198       (and (string=? str1 "foofoofoo")
 199            (string=? str2 "fooFOOfoo"))))
 200
 201   (pass-if "modify double indirectly"
 202     (let* ((str1 (string-copy "foofoofoo"))
 203            (str2 (substring/shared str1 2 7)))
 204       (string-upcase! (substring/shared str2 1 4))
 205       (string=? str1 "fooFOOfoo")))
 206
 207   (pass-if "modify cow double indirectly"
 208     (let* ((str1 "foofoofoo")
 209            (str2 (substring str1 2 7)))
 210       (string-upcase! (substring/shared str2 1 4))
 211       (and (string=? str1 "foofoofoo")
 212            (string=? str2 "oFOOf")))))