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-2006,2008-2011,2013,2015,2018,2020
5;;;;   Free Software Foundation, Inc.
6;;;;
7;;;; This library is free software; you can redistribute it and/or
8;;;; modify it under the terms of the GNU Lesser General Public
9;;;; License as published by the Free Software Foundation; either
10;;;; version 3 of the License, or (at your option) any later version.
11;;;;
12;;;; This library is distributed in the hope that it will be useful,
13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15;;;; Lesser General Public License for more details.
16;;;;
17;;;; You should have received a copy of the GNU Lesser General Public
18;;;; License along with this library; if not, write to the Free Software
19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20
21(define-module (test-strings)
22  #:use-module ((system base compile) #:select (compile))
23  #:use-module (test-suite lib)
24  #:use-module (ice-9 string-fun))
25
26(define exception:read-only-string
27  (cons 'misc-error "^string is read-only"))
28(define exception:invalid-escape
29  (cons 'read-error "invalid character in escape sequence"))
30
31;; Create a string from integer char values, eg. (string-ints 65) => "A"
32(define (string-ints . args)
33  (apply string (map integer->char args)))
34
35;;
36;; string internals
37;;
38
39;; Some abbreviations
40;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
41;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
42
43(with-test-prefix "string internals"
44
45  (pass-if "new string starts at 1st char in stringbuf"
46    (let ((s "abc"))
47      (= 0 (assq-ref (%string-dump s) 'start))))
48
49  (pass-if "length of new string same as stringbuf"
50    (let ((s "def"))
51      (= (string-length s) (assq-ref (%string-dump s) 'stringbuf-length))))
52
53  (pass-if "contents of new string same as stringbuf"
54    (let ((s "ghi"))
55      (string=? s (assq-ref (%string-dump s) 'stringbuf-chars))))
56
57  (pass-if "writable strings are not read-only"
58    (let ((s "zyx"))
59      (not (assq-ref (%string-dump s) 'read-only))))
60
61  (pass-if "read-only strings are read-only"
62    (let ((s (substring/read-only "zyx" 0)))
63      (assq-ref (%string-dump s) 'read-only)))
64
65  (pass-if "new Latin-1 encoded strings are not shared"
66    (let ((s "abc"))
67      (not (assq-ref (%string-dump s) 'stringbuf-shared))))
68
69  (pass-if "new UCS-4 encoded strings are not shared"
70    (let ((s "\u0100bc"))
71      (not (assq-ref (%string-dump s) 'stringbuf-shared))))
72
73  ;; Should this be true? It isn't currently true.
74  (pass-if "null shared substrings are shared"
75    (let* ((s1 "")
76           (s2 (substring/shared s1 0 0)))
77      (throw 'untested)
78      (eq? (assq-ref (%string-dump s2) 'shared)
79           s1)))
80
81  (pass-if "ASCII shared substrings are shared"
82    (let* ((s1 "foobar")
83           (s2 (substring/shared s1 0 3)))
84      (eq? (assq-ref (%string-dump s2) 'shared)
85           s1)))
86
87  (pass-if "BMP shared substrings are shared"
88    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
89           (s2 (substring/shared s1 0 3)))
90      (eq? (assq-ref (%string-dump s2) 'shared)
91           s1)))
92
93  (pass-if "null substrings are not shared"
94    (let* ((s1 "")
95           (s2 (substring s1 0 0)))
96      (not (eq? (assq-ref (%string-dump s2) 'shared)
97                s1))))
98
99  (pass-if "ASCII substrings are not shared"
100    (let* ((s1 "foobar")
101           (s2 (substring s1 0 3)))
102      (not (eq? (assq-ref (%string-dump s2) 'shared)
103                s1))))
104
105  (pass-if "BMP substrings are not shared"
106    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
107           (s2 (substring s1 0 3)))
108      (not (eq? (assq-ref (%string-dump s2) 'shared)
109                s1))))
110
111  (pass-if "ASCII substrings immutable before copy-on-write"
112    (let* ((s1 "foobar")
113           (s2 (substring s1 0 3)))
114      (and (not (assq-ref (%string-dump s1) 'stringbuf-mutable))
115           (not (assq-ref (%string-dump s2) 'stringbuf-mutable)))))
116
117  (pass-if "BMP substrings immutable before copy-on-write"
118    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
119           (s2 (substring s1 0 3)))
120      (and (not (assq-ref (%string-dump s1) 'stringbuf-mutable))
121           (not (assq-ref (%string-dump s2) 'stringbuf-mutable)))))
122
123  (pass-if "ASCII base string still immutable after copy-on-write"
124    (let* ((s1 "foobar")
125           (s2 (substring s1 0 3)))
126      (string-set! s2 0 #\F)
127      (and (not (assq-ref (%string-dump s1) 'stringbuf-mutable))
128           (assq-ref (%string-dump s2) 'stringbuf-mutable))))
129
130  (pass-if "BMP base string still immutable after copy-on-write"
131    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
132           (s2 (substring s1 0 3)))
133      (string-set! s2 0 #\F)
134      (and (not (assq-ref (%string-dump s1) 'stringbuf-mutable))
135           (assq-ref (%string-dump s2) 'stringbuf-mutable))))
136
137  (pass-if "ASCII substrings mutable after shared mutation"
138    (let* ((s1 "foobar")
139           (s2 (substring/shared s1 0 3)))
140      (string-set! s2 0 #\F)
141      (and (assq-ref (%string-dump s1) 'stringbuf-mutable)
142           (assq-ref (%string-dump s2) 'stringbuf-mutable))))
143
144  (pass-if "BMP substrings mutable after shared mutation"
145    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
146           (s2 (substring/shared s1 0 3)))
147      (string-set! s2 0 #\F)
148      (and (assq-ref (%string-dump s1) 'stringbuf-mutable)
149           (assq-ref (%string-dump s2) 'stringbuf-mutable))))
150
151  (with-test-prefix "encodings"
152
153    (pass-if "null strings are Latin-1 encoded"
154      (let ((s ""))
155        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
156
157    (pass-if "ASCII strings are Latin-1 encoded"
158      (let ((s "jkl"))
159        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
160
161    (pass-if "Latin-1 strings are Latin-1 encoded"
162      (let ((s "\xC0\xC1\xC2"))
163        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
164
165    (pass-if "BMP strings are UCS-4 encoded"
166      (let ((s "\u0100\u0101\x0102"))
167        (assq-ref (%string-dump s) 'stringbuf-wide)))
168
169    (pass-if "SMP strings are UCS-4 encoded"
170      (let ((s "\U010300\u010301\x010302"))
171        (assq-ref (%string-dump s) 'stringbuf-wide)))
172
173    (pass-if "null list->string is Latin-1 encoded"
174      (let ((s (string-ints)))
175        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
176
177    (pass-if "ASCII list->string is Latin-1 encoded"
178      (let ((s (string-ints 65 66 67)))
179        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
180
181    (pass-if "Latin-1 list->string is Latin-1 encoded"
182      (let ((s (string-ints #xc0 #xc1 #xc2)))
183        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
184
185    (pass-if "BMP list->string is UCS-4 encoded"
186      (let ((s (string-ints #x0100 #x0101 #x0102)))
187        (assq-ref (%string-dump s) 'stringbuf-wide)))
188
189    (pass-if "SMP list->string is UCS-4 encoded"
190      (let ((s (string-ints #x010300 #x010301 #x010302)))
191        (assq-ref (%string-dump s) 'stringbuf-wide)))
192
193    (pass-if "encoding of string not based on escape style"
194      (let ((s "\U000040"))
195        (not (assq-ref (%string-dump s) 'stringbuf-wide))))))
196
197(with-test-prefix "escapes"
198
199  (pass-if-exception "non-hex char in two-digit hex-escape"
200    exception:invalid-escape
201    (with-input-from-string "\"\\x0g\"" read))
202
203  (pass-if-exception "non-hex char in four-digit hex-escape"
204    exception:invalid-escape
205    (with-input-from-string "\"\\u000g\"" read))
206
207  (pass-if-exception "non-hex char in six-digit hex-escape"
208    exception:invalid-escape
209    (with-input-from-string "\"\\U00000g\"" read))
210
211  (pass-if-exception "premature termination of two-digit hex-escape"
212    exception:invalid-escape
213    (with-input-from-string "\"\\x0\"" read))
214
215  (pass-if-exception "premature termination of four-digit hex-escape"
216    exception:invalid-escape
217    (with-input-from-string "\"\\u000\"" read))
218
219  (pass-if-exception "premature termination of six-digit hex-escape"
220    exception:invalid-escape
221    (with-input-from-string "\"\\U00000\"" read))
222
223  (pass-if "extra hex digits ignored for two-digit hex escape"
224    (eqv? (string-ref "--\xfff--" 2)
225          (integer->char #xff)))
226
227  (pass-if "extra hex digits ignored for four-digit hex escape"
228    (eqv? (string-ref "--\u0100f--" 2)
229          (integer->char #x0100)))
230
231  (pass-if "extra hex digits ignored for six-digit hex escape"
232    (eqv? (string-ref "--\U010300f--" 2)
233          (integer->char #x010300)))
234
235  (pass-if "escaped characters match non-escaped ASCII characters"
236    (string=? "ABC" "\x41\u0042\U000043"))
237
238  (pass-if "R5RS backslash escapes"
239    (string=? "\"\\" (string #\" #\\)))
240
241  (pass-if "R6RS backslash escapes"
242    (string=? "\a\b\t\n\v\f\r"
243              (string #\alarm #\backspace #\tab #\newline #\vtab
244                      #\page #\return)))
245
246  (pass-if "Guile extensions backslash escapes"
247    (string=? "\0" (string #\nul))))
248
249;;
250;; string?
251;;
252(with-test-prefix "string?"
253
254  (pass-if "string"
255    (string? "abc"))
256
257  (pass-if "symbol"
258    (not (string? 'abc))))
259
260;;
261;; literals
262;;
263
264(with-test-prefix "literals"
265
266  ;; The "Storage Model" section of R5RS reads: "In such systems literal
267  ;; constants and the strings returned by `symbol->string' are
268  ;; immutable objects".  `eval' doesn't support it yet, but it doesn't
269  ;; really matter because `eval' doesn't coalesce repeated constants,
270  ;; unlike the bytecode compiler.
271
272  (pass-if-exception "literals are constant"
273    exception:read-only-string
274    (compile '(string-set! "literal string" 0 #\x)
275             #:from 'scheme
276             #:to 'value)))
277
278;;
279;; string-null?
280;;
281
282(with-test-prefix "string-null?"
283
284  (pass-if "null string"
285    (string-null? ""))
286
287  (pass-if "non-null string"
288    (not (string-null? "a")))
289
290  (pass-if "respects \\0"
291    (not (string-null? "\0")))
292
293  (pass-if-exception "symbol"
294    exception:wrong-type-arg
295    (string-null? 'a)))
296
297;;
298;; string=?
299;;
300
301(with-test-prefix "string=?"
302
303  (pass-if "respects 1st parameter's string length"
304    (not (string=? "foo\0" "foo")))
305
306  (pass-if "respects 2nd paramter's string length"
307    (not (string=? "foo" "foo\0")))
308
309  (with-test-prefix "wrong argument type"
310
311    (pass-if-exception "1st argument symbol"
312      exception:wrong-type-arg
313      (string=? 'a "a"))
314
315    (pass-if-exception "2nd argument symbol"
316      exception:wrong-type-arg
317      (string=? "a" 'b))
318
319    (pass-if-exception "1st argument EOF"
320      exception:wrong-type-arg
321      (string=? (with-input-from-string "" read) "b"))
322
323    (pass-if-exception "2nd argument EOF"
324      exception:wrong-type-arg
325      (string=? "a" (with-input-from-string "" read)))))
326
327;;
328;; string<?
329;;
330
331(with-test-prefix "string<?"
332
333  (pass-if "respects string length"
334    (and (not (string<? "foo\0a" "foo\0a"))
335	 (string<? "foo\0a" "foo\0b")))
336
337  (with-test-prefix "wrong argument type"
338
339    (pass-if-exception "1st argument symbol"
340      exception:wrong-type-arg
341      (string<? 'a "a"))
342
343    (pass-if-exception "2nd argument symbol"
344      exception:wrong-type-arg
345      (string<? "a" 'b)))
346
347  (pass-if "same as char<?"
348    (eq? (char<? (integer->char 0) (integer->char 255))
349	 (string<? (string-ints 0) (string-ints 255)))))
350
351;;
352;; string-ci<?
353;;
354
355(with-test-prefix "string-ci<?"
356
357  (pass-if "respects string length"
358    (and (not (string-ci<? "foo\0a" "foo\0a"))
359	 (string-ci<? "foo\0a" "foo\0b")))
360
361  (with-test-prefix "wrong argument type"
362
363    (pass-if-exception "1st argument symbol"
364      exception:wrong-type-arg
365      (string-ci<? 'a "a"))
366
367    (pass-if-exception "2nd argument symbol"
368      exception:wrong-type-arg
369      (string-ci<? "a" 'b)))
370
371  (pass-if "same as char-ci<?"
372    (eq? (char-ci<? (integer->char 0) (integer->char 255))
373	 (string-ci<? (string-ints 0) (string-ints 255)))))
374
375;;
376;; string<=?
377;;
378
379(with-test-prefix "string<=?"
380
381  (pass-if "same as char<=?"
382    (eq? (char<=? (integer->char 0) (integer->char 255))
383	 (string<=? (string-ints 0) (string-ints 255)))))
384
385;;
386;; string-ci<=?
387;;
388
389(with-test-prefix "string-ci<=?"
390
391  (pass-if "same as char-ci<=?"
392    (eq? (char-ci<=? (integer->char 0) (integer->char 255))
393	 (string-ci<=? (string-ints 0) (string-ints 255)))))
394
395;;
396;; string>?
397;;
398
399(with-test-prefix "string>?"
400
401  (pass-if "same as char>?"
402    (eq? (char>? (integer->char 0) (integer->char 255))
403	 (string>? (string-ints 0) (string-ints 255)))))
404
405;;
406;; string-ci>?
407;;
408
409(with-test-prefix "string-ci>?"
410
411  (pass-if "same as char-ci>?"
412    (eq? (char-ci>? (integer->char 0) (integer->char 255))
413	 (string-ci>? (string-ints 0) (string-ints 255)))))
414
415;;
416;; string>=?
417;;
418
419(with-test-prefix "string>=?"
420
421  (pass-if "same as char>=?"
422    (eq? (char>=? (integer->char 0) (integer->char 255))
423	 (string>=? (string-ints 0) (string-ints 255)))))
424
425;;
426;; string-ci>=?
427;;
428
429(with-test-prefix "string-ci>=?"
430
431  (pass-if "same as char-ci>=?"
432    (eq? (char-ci>=? (integer->char 0) (integer->char 255))
433	 (string-ci>=? (string-ints 0) (string-ints 255)))))
434
435;;
436;; Unicode string normalization forms
437;;
438
439;;
440;; string-normalize-nfd
441;;
442
443(with-test-prefix "string-normalize-nfd"
444
445  (pass-if "canonical decomposition is equal?"
446    (equal? (string-normalize-nfd "\xe9") "\x65\u0301")))
447
448;;
449;; string-normalize-nfkd
450;;
451
452(with-test-prefix "string-normalize-nfkd"
453
454  (pass-if "compatibility decomposition is equal?"
455    (equal? (string-normalize-nfkd "\u1e9b\u0323") "s\u0323\u0307")))
456
457;;
458;; string-normalize-nfc
459;;
460
461(with-test-prefix "string-normalize-nfc"
462
463  (pass-if "canonical composition is equal?"
464    (equal? (string-normalize-nfc "\x65\u0301") "\xe9")))
465
466;;
467;; string-normalize-nfkc
468;;
469
470(with-test-prefix "string-normalize-nfkc"
471
472  (pass-if "compatibility composition is equal?"
473    (equal? (string-normalize-nfkc "\u1e9b\u0323") "\u1e69")))
474
475;;
476;; normalizing large strings
477;;
478
479(pass-if "string-normalize-{nfd,nfc,nfkd,nfkc} on large strings"
480  ;; In Guile <= 2.2.4, these would overflow the C stack and crash.
481  (let ((large (make-string 4000000 #\a)))
482    (and (string=? large (string-normalize-nfd large))
483         (string=? large (string-normalize-nfc large))
484         (string=? large (string-normalize-nfkd large))
485         (string=? large (string-normalize-nfkc large)))))
486
487;;
488;; string-utf8-length
489;;
490
491(with-test-prefix "string-utf8-length"
492
493  (pass-if-exception "wrong type argument"
494      exception:wrong-type-arg
495    (string-utf8-length 50))
496
497  (pass-if-equal 0 (string-utf8-length ""))
498  (pass-if-equal 1 (string-utf8-length "\0"))
499  (pass-if-equal 5 (string-utf8-length "hello"))
500  (pass-if-equal 7 (string-utf8-length "helloλ"))
501  (pass-if-equal 9 (string-utf8-length "ሠላም")))
502
503;;
504;; string-ref
505;;
506
507(with-test-prefix "string-ref"
508
509  (pass-if-exception "empty string"
510    exception:out-of-range
511    (string-ref "" 0))
512
513  (pass-if-exception "empty string and non-zero index"
514    exception:out-of-range
515    (string-ref "" 123))
516
517  (pass-if-exception "out of range"
518    exception:out-of-range
519    (string-ref "hello" 123))
520
521  (pass-if-exception "negative index"
522    exception:out-of-range
523    (string-ref "hello" -1))
524
525  (pass-if "regular string, ASCII char"
526    (char=? (string-ref "GNU Guile" 4) #\G))
527
528  (pass-if "regular string, hex escaped Latin-1 char"
529    (char=? (string-ref "--\xff--" 2)
530            (integer->char #xff)))
531
532  (pass-if "regular string, hex escaped BMP char"
533    (char=? (string-ref "--\u0100--" 2)
534            (integer->char #x0100)))
535
536  (pass-if "regular string, hex escaped SMP char"
537    (char=? (string-ref "--\U010300--" 2)
538            (integer->char #x010300))))
539
540;;
541;; string-set!
542;;
543
544(with-test-prefix "string-set!"
545
546  (pass-if-exception "empty string"
547    exception:out-of-range
548    (string-set! (string-copy "") 0 #\x))
549
550  (pass-if-exception "empty string and non-zero index"
551    exception:out-of-range
552    (string-set! (string-copy "") 123 #\x))
553
554  (pass-if-exception "out of range"
555    exception:out-of-range
556    (string-set! (string-copy "hello") 123 #\x))
557
558  (pass-if-exception "negative index"
559    exception:out-of-range
560    (string-set! (string-copy "hello") -1 #\x))
561
562  (pass-if-exception "read-only string"
563    exception:read-only-string
564    (string-set! (substring/read-only "abc" 0) 1 #\space))
565
566  (pass-if "regular string, ASCII char"
567    (let ((s (string-copy "GNU guile")))
568      (string-set! s 4 #\G)
569      (char=? (string-ref s 4) #\G)))
570
571  (pass-if "regular string, Latin-1 char"
572    (let ((s (string-copy "GNU guile")))
573      (string-set! s 4 (integer->char #xfe))
574      (char=? (string-ref s 4) (integer->char #xfe))))
575
576  (pass-if "regular string, BMP char"
577    (let ((s (string-copy "GNU guile")))
578      (string-set! s 4 (integer->char #x0100))
579      (char=? (string-ref s 4) (integer->char #x0100))))
580
581  (pass-if "regular string, SMP char"
582    (let ((s (string-copy "GNU guile")))
583      (string-set! s 4 (integer->char #x010300))
584      (char=? (string-ref s 4) (integer->char #x010300)))))
585
586;;
587;; list->string
588;;
589(with-test-prefix "string"
590
591  (pass-if-exception "convert circular list to string"
592    '(wrong-type-arg . "Apply to non-list")
593    (let ((foo (list #\a #\b #\c)))
594      (set-cdr! (cddr foo) (cdr foo))
595      (apply string foo))))
596
597(with-test-prefix "string-split"
598
599  ;; in guile 1.6.7 and earlier, character >=128 wasn't matched in the string
600  (pass-if "char 255"
601    (equal? '("a" "b")
602	    (string-split (string #\a (integer->char 255) #\b)
603			  (integer->char 255))))
604
605  (pass-if "empty string - char"
606    (equal? '("")
607            (string-split "" #\:)))
608
609  (pass-if "non-empty - char - no delimiters"
610    (equal? '("foobarfrob")
611            (string-split "foobarfrob" #\:)))
612
613  (pass-if "non-empty - char - delimiters"
614    (equal? '("foo" "bar" "frob")
615            (string-split "foo:bar:frob" #\:)))
616
617  (pass-if "non-empty - char - leading delimiters"
618    (equal? '("" "" "foo" "bar" "frob")
619            (string-split "::foo:bar:frob" #\:)))
620
621  (pass-if "non-empty - char - trailing delimiters"
622    (equal? '("foo" "bar" "frob" "" "")
623            (string-split "foo:bar:frob::" #\:)))
624
625  (pass-if "empty string - charset"
626    (equal? '("")
627            (string-split "" (char-set #\:))))
628
629  (pass-if "non-empty - charset - no delimiters"
630    (equal? '("foobarfrob")
631            (string-split "foobarfrob" (char-set #\:))))
632
633  (pass-if "non-empty - charset - delimiters"
634    (equal? '("foo" "bar" "frob")
635            (string-split "foo:bar:frob" (char-set #\:))))
636
637  (pass-if "non-empty - charset - leading delimiters"
638    (equal? '("" "" "foo" "bar" "frob")
639            (string-split "::foo:bar:frob" (char-set #\:))))
640
641  (pass-if "non-empty - charset - trailing delimiters"
642    (equal? '("foo" "bar" "frob" "" "")
643            (string-split "foo:bar:frob::" (char-set #\:))))
644
645  (pass-if "empty string - pred"
646    (equal? '("")
647            (string-split "" (negate char-alphabetic?))))
648
649  (pass-if "non-empty - pred - no delimiters"
650    (equal? '("foobarfrob")
651            (string-split "foobarfrob" (negate char-alphabetic?))))
652
653  (pass-if "non-empty - pred - delimiters"
654    (equal? '("foo" "bar" "frob")
655            (string-split "foo:bar:frob" (negate char-alphabetic?))))
656
657  (pass-if "non-empty - pred - leading delimiters"
658    (equal? '("" "" "foo" "bar" "frob")
659            (string-split "::foo:bar:frob" (negate char-alphabetic?))))
660
661  (pass-if "non-empty - pred - trailing delimiters"
662    (equal? '("foo" "bar" "frob" "" "")
663            (string-split "foo:bar:frob::" (negate char-alphabetic?)))))
664
665(with-test-prefix "substring-move!"
666
667  (pass-if-exception "substring-move! checks start and end correctly"
668    exception:out-of-range
669    (substring-move! "sample" 3 0 "test" 3)))
670
671(with-test-prefix "substring/shared"
672
673  (pass-if "modify indirectly"
674    (let ((str (string-copy "foofoofoo")))
675      (string-upcase! (substring/shared str 3 6))
676      (string=? str "fooFOOfoo")))
677
678  (pass-if "modify cow indirectly"
679    (let* ((str1 (string-copy "foofoofoo"))
680	   (str2 (string-copy str1)))
681      (string-upcase! (substring/shared str2 3 6))
682      (and (string=? str1 "foofoofoo")
683	   (string=? str2 "fooFOOfoo"))))
684
685  (pass-if "modify double indirectly"
686    (let* ((str1 (string-copy "foofoofoo"))
687	   (str2 (substring/shared str1 2 7)))
688      (string-upcase! (substring/shared str2 1 4))
689      (string=? str1 "fooFOOfoo")))
690
691  (pass-if "modify cow double indirectly"
692    (let* ((str1 "foofoofoo")
693	   (str2 (substring str1 2 7)))
694      (string-upcase! (substring/shared str2 1 4))
695      (and (string=? str1 "foofoofoo")
696	   (string=? str2 "oFOOf")))))
697
698(with-test-prefix "miscellaneous string functions"
699
700  (pass-if "string-replace-substring"
701    (string=? (string-replace-substring "a ring of strings" "ring" "rut")
702              "a rut of struts")))
703