tests/string.pure.lisp

   1 ;;;; miscellaneous tests of STRING-related stuff
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 (in-package "CL-USER")
  15
  16 ;;; basic non-destructive case operations
  17 (assert (string= (string-upcase     "This is a test.") "THIS IS A TEST."))
  18 (assert (string= (string-downcase   "This is a test.") "this is a test."))
  19 (assert (string= (string-capitalize "This is a test.") "This Is A Test."))
  20 (assert (string= (string-upcase "Is this 900-Sex-hott, please?" :start 3)
  21                  "Is THIS 900-SEX-HOTT, PLEASE?"))
  22 (assert (string= (string-downcase "Is this 900-Sex-hott, please?"
  23                                   :start 10 :end 16)
  24                  "Is this 900-sex-hott, please?"))
  25 (assert (string= (string-capitalize "Is this 900-Sex-hott, please?")
  26                  "Is This 900-Sex-Hott, Please?"))
  27
  28 ;;; The non-destructive case operations accept string designators, not
  29 ;;; just strings.
  30 (assert (string= (string-upcase '|String designator|) "STRING DESIGNATOR"))
  31 (assert (string= (string-downcase #\S) "s"))
  32 (assert (string= (string-downcase #\.) "."))
  33 (assert (string= (string-capitalize 'ya-str-desig :end 5) "Ya-StR-DESIG"))
  34
  35 ;;; basic destructive case operations
  36 (let ((nstring (make-array 5 :element-type 'character :fill-pointer 0)))
  37   (vector-push-extend #\c nstring)
  38   (vector-push-extend #\a nstring)
  39   (vector-push-extend #\t nstring)
  40   (nstring-upcase nstring)
  41   (assert (string= nstring "CAT"))
  42   (setf (fill-pointer nstring) 2)
  43   (nstring-downcase nstring :start 1)
  44   (setf (fill-pointer nstring) 3)
  45   (assert (string= nstring "CaT"))
  46   (nstring-capitalize nstring)
  47   (assert (string= nstring "Cat")))