#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/string-fun.scm -- string primitives test
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; Load the test framework.

(load "test-suite.scm")

;; Actual tests.

(begin-section "string predicates")

(begin-sub-section "string?")
(pass-if (string? "") #t eq?)
(pass-if (string? "\n") #t eq?)
(pass-if (string? "Hello world") #t eq?)
(pass-if (string? #\c) #f eq?)
(pass-if (string? 'not-a-string) #f eq?)

(begin-sub-section "string-null?")
(pass-if (string-null? "") #t eq?)
(pass-if (string-null? "baz") #f eq?)
(pass-if (string-null? " ") #f eq?)

(begin-section "string constructors")

(begin-sub-section "make-string")
(pass-if (make-string 0) "" equal?)
(pass-if (string-length (make-string 0)) 0 =)
(pass-if (string-length (make-string 10)) 10 =)

(begin-sub-section "string")
(pass-if (string #\H #\e #\l #\l #\o #\  #\W #\o #\r #\l #\d #\!)
	 "Hello World!" equal?)

(begin-sub-section "string-append")
(pass-if (string-append "" "") "" equal?)
(pass-if (string-append "1" "2" "3") "123" equal?)
(pass-if (string-append "" "asas" "") "asas" equal?)

(begin-sub-section "string-copy")
(define string-bla "blurb")
(pass-if (string-copy string-bla) "blurb" equal?)
(pass-if (string-copy string-bla) (string-copy string-bla) equal?)

(begin-sub-section "string-reverse")
(pass-if (string-reverse "") "" equal?)
(pass-if (string-reverse "abcde") "edcba" equal?)
(pass-if (string-reverse "abcde" 1) "aedcb" equal?)
(pass-if (string-reverse "abcde" 1 4) "adcbe" equal?)

(begin-sub-section "string-reverse!")
(define s (string-copy ""))
(string-reverse! s)
(pass-if s "" equal?)
(set! s (string-copy "abcde"))
(string-reverse! s)
(pass-if s "edcba" equal?)
(set! s (string-copy "abcde"))
(string-reverse! s 1)
(pass-if s "aedcb" equal?)
(set! s (string-copy "abcde"))
(string-reverse! s 1 4)
(pass-if s "adcbe" equal?)

(begin-section "string accesssors")

(begin-sub-section "string-length")
(pass-if (string-length "") 0 =)
(pass-if (string-length "hell o hell o") 13 =)

(begin-sub-section "string-ref")
(pass-if (string-ref "Hello" 0) #\H eq?)
(pass-if (string-ref "Hello" 2) #\l eq?)
(pass-if (string-ref "Hello" 4) #\o eq?)

(begin-sub-section "substring")
(pass-if (substring "" 0 0) "" equal?)
(pass-if (substring "!" 0 1) "!" equal?)
(pass-if (substring "hello world" 0 (string-length "hello world"))
	 "hello world" equal?)
(pass-if (substring "test-test" 4 5) "-" equal?)

(begin-section "string comparing")

(begin-sub-section "string=?")
(pass-if (string=? "oops" "oops") #t eq?)
(pass-if (string=? "" "") #t eq?)

(begin-sub-section "string<?")
(pass-if (string<? "a" "b") #t eq?)
(pass-if (string<? "oop" "oops") #t eq?)
(pass-if (string<? "" "!") #t eq?)
(pass-if (string<? "%%%" "%%%") #f eq?)

(begin-sub-section "string<=?")
(pass-if (string<=? "a" "b") #t eq?)
(pass-if (string<=? "oop" "oops") #t eq?)
(pass-if (string<=? "" "!") #t eq?)
(pass-if (string<=? "%%%" "%%%") #t eq?)

(begin-sub-section "string>?")
(pass-if (string>? "Y" "D") #t eq?)
(pass-if (string>? "oopt" "oops") #t eq?)
(pass-if (string>? "!!" "!") #t eq?)
(pass-if (string>? "%%%" "%%%") #f eq?)

(begin-sub-section "string>=?")
(pass-if (string>=? "Y" "D") #t eq?)
(pass-if (string>=? "oopt" "oops") #t eq?)
(pass-if (string>=? "!" "") #t eq?)
(pass-if (string>=? "%%%" "%%%") #t eq?)

(begin-sub-section "string-ci=?")
(pass-if (string-ci=? "OOPS" "oops") #t eq?)
(pass-if (string-ci=? "" "") #t eq?)

(begin-sub-section "string-ci<?")
(pass-if (string-ci<? "A" "b") #t eq?)
(pass-if (string-ci<? "oop" "OOPS") #t eq?)
(pass-if (string-ci<? "" "!") #t eq?)
(pass-if (string-ci<? "%%%" "%%%") #f eq?)

(begin-sub-section "string-ci<=?")
(pass-if (string-ci<=? "A" "b") #t eq?)
(pass-if (string-ci<=? "oop" "oops") #t eq?)
(pass-if (string-ci<=? "" "!") #t eq?)
(pass-if (string-ci<=? "%%%" "%%%") #t eq?)

(begin-sub-section "string-ci>?")
(pass-if (string-ci>? "Y" "d") #t eq?)
(pass-if (string-ci>? "oopt" "OOPS") #t eq?)
(pass-if (string-ci>? "!!" "!") #t eq?)
(pass-if (string-ci>? "%%%" "%%%") #f eq?)

(begin-sub-section "string-ci>=?")
(pass-if (string-ci>=? "Y" "d") #t eq?)
(pass-if (string-ci>=? "oopt" "OOPS") #t eq?)
(pass-if (string-ci>=? "!" "") #t eq?)
(pass-if (string-ci>=? "%%%" "%%%") #t eq?)

(begin-section "string conversion")

(begin-sub-section "string->list")
(pass-if (string->list "") '() equal?)
(pass-if (string->list "Oops!") '(#\O #\o #\p #\s #\!) equal?)

(begin-sub-section "list->string")
(pass-if (list->string '()) "" equal?)
(pass-if (list->string '(#\p #\u #\p #\p #\y)) "puppy" equal?)

(begin-sub-section "reverse-list->string")
(pass-if (reverse-list->string '()) "" equal?)
(pass-if (reverse-list->string '(#\a #\B #\c)) "cBa" equal?)

(begin-section "string modifiers")

(begin-sub-section "string-set!")
(define a-test-string (string-copy "oops"))
(string-set! a-test-string 0 #\a)
(pass-if a-test-string "aops" equal?)
(string-set! a-test-string 3 #\a)
(pass-if a-test-string "aopa" equal?)

(begin-sub-section "string-fill!")
(define string-fill-s (string-copy "aAaAaAaA"))
(define string-fill-a (string-copy ""))
(string-fill! string-fill-s #\_)
(pass-if string-fill-s "________" equal?)
(string-fill! string-fill-s #\!)
(pass-if string-fill-s "!!!!!!!!" equal?)
(string-fill! string-fill-a #\!)
(pass-if string-fill-a "" equal?)

(begin-sub-section "string-split")
(pass-if (string-split #\space "1 2 3 4 5 6 7") '("1" "2" "3" "4" "5" "6" "7")
	 equal?)
(pass-if (string-split #\: "mgrabmue:x:M.G.") '("mgrabmue" "x" "M.G.")
	 equal?)
(pass-if (string-split #\: "") '("") equal?)
(pass-if (string-split #\: "bla") '("bla") equal?)

(begin-section "filename functions")

(begin-sub-section "basename")
(pass-if (basename "") "" string=?)
(pass-if (basename "bar") "bar" string=?)
(pass-if (basename "foo/bar") "bar" string=?)
(pass-if (basename "/foo/bar") "bar" string=?)
(pass-if (basename "/foo/bar.c") "bar.c" string=?)
(pass-if (basename "/foo/bar.c" ".c") "bar" string=?)

(begin-sub-section "dirname")
(pass-if (dirname "") "." string=?)
(pass-if (dirname "bar") "." string=?)
(pass-if (dirname "foo/bar") "foo" string=?)
(pass-if (dirname "/foo/bar") "/foo" string=?)
(pass-if (dirname "/foo/bar.c") "/foo" string=?)

(begin-sub-section "cleanup-filename")
(pass-if (cleanup-filename "") "" string=?)
(pass-if (cleanup-filename "/") "/" string=?)
(pass-if (cleanup-filename "//") "/" string=?)
(pass-if (cleanup-filename "/////") "/" string=?)
(pass-if (cleanup-filename "./") "" string=?)
(pass-if (cleanup-filename "/.") "/." string=?)
(pass-if (cleanup-filename ".") "." string=?)
(pass-if (cleanup-filename "foo.c") "foo.c" string=?)
(pass-if (cleanup-filename "bar//foo.c") "bar/foo.c" string=?)
(pass-if (cleanup-filename "//foo.c") "/foo.c" string=?)
(pass-if (cleanup-filename "/./foo.c") "/foo.c" string=?)
(pass-if (cleanup-filename "/././foo.c") "/foo.c" string=?)
(pass-if (cleanup-filename "/bla/../foo.c") "/foo.c" string=?)
(pass-if (cleanup-filename "/bla/./foo.c") "/bla/foo.c" string=?)

(begin-section "case conversion")

(begin-sub-section "string-upcase!")
(define s (string-copy ""))
(string-upcase! s)
(pass-if s "" string=?)
(define s (string-copy "Hello World!"))
(string-upcase! s)
(pass-if s "HELLO WORLD!" string=?)

(begin-sub-section "string-upcase")
(pass-if (string-upcase "") "" string=?)
(pass-if (string-upcase "Hello World!") "HELLO WORLD!" string=?)

(begin-sub-section "string-downcase!")
(define s (string-copy ""))
(string-downcase! s)
(pass-if s "" string=?)
(define s (string-copy "Hello World!"))
(string-downcase! s)
(pass-if s "hello world!" string=?)

(begin-sub-section "string-downcase")
(pass-if (string-downcase "") "" string=?)
(pass-if (string-downcase "Hello World!") "hello world!" string=?)

(begin-sub-section "string-titlecase!")
(define s (string-copy ""))
(string-titlecase! s)
(pass-if s "" string=?)
(define s (string-copy "Hello World!"))
(string-titlecase! s)
(pass-if s "Hello World!" string=?)
(define s (string-copy "hello world!"))
(string-titlecase! s)
(pass-if s "Hello World!" string=?)
(define s (string-copy "HELLO WORLD!"))
(string-titlecase! s)
(pass-if s "Hello World!" string=?)

(begin-sub-section "string-titlecase")
(pass-if (string-titlecase "") "" string=?)
(pass-if (string-titlecase "Hello World!") "Hello World!" string=?)
(pass-if (string-titlecase "hello world!") "Hello World!" string=?)
(pass-if (string-titlecase "HELLO WORLD!") "Hello World!" string=?)

(begin-section "string trimming")

(begin-sub-section "string-chop")
(pass-if (string-chop "") "" string=?)
(pass-if (string-chop "\n") "" string=?)
(pass-if (string-chop "\n\n") "" string=?)
(pass-if (string-chop "hello\nworld") "hello\nworld" string=?)
(pass-if (string-chop "hello\nworld\n") "hello\nworld" string=?)
(pass-if (string-chop "hello\nworld\n\n") "hello\nworld" string=?)

(begin-sub-section "string-trim")
(pass-if (string-trim "" #\space) "" string=?)
(pass-if (string-trim "  foo" #\space) "foo" string=?)
(pass-if (string-trim " \nfoo" #\space) "\nfoo" string=?)
(pass-if (string-trim " \nfoo" char-whitespace?) "foo" string=?)
(pass-if (string-trim "!!foo" #\space 2 4) "fo" string=?)

(begin-sub-section "string-trim-right")
(pass-if (string-trim-right "" #\space) "" string=?)
(pass-if (string-trim-right "foo  " #\space) "foo" string=?)
(pass-if (string-trim-right "foo\n " #\space) "foo\n" string=?)
(pass-if (string-trim-right "foo\n " char-whitespace?) "foo" string=?)
(pass-if (string-trim-right "foo!!" #\space 2 4) "o!" string=?)

(begin-sub-section "string-trim-both")
(pass-if (string-trim-both "" #\space) "" string=?)
(pass-if (string-trim-both "  foo  " #\space) "foo" string=?)
(pass-if (string-trim-both " \nfoo\n " #\space) "\nfoo\n" string=?)
(pass-if (string-trim-both " \nfoo\n " char-whitespace?) "foo" string=?)

(begin-section "string investigating")

(begin-sub-section "string-index")
(pass-if (string-index "bla" #\a) 2 =)
(pass-if (string-index "bla" #\x) #f eq?)
(pass-if (string-index "hello" #\l) 2 =)
(pass-if (string-index "hello" #\l 3) 3 =)
(pass-if (string-index "hello" #\l 4) #f eq?)
(pass-if (string-index "hello" #\l 0 2) #f eq?)

(begin-sub-section "string-index-right")
(pass-if (string-index-right "bla" #\a) 2 =)
(pass-if (string-index-right "bla" #\x) #f eq?)
(pass-if (string-index-right "hello" #\l) 3 =)
(pass-if (string-index-right "hello" #\l 0 3) 2 =)
(pass-if (string-index-right "hello" #\l 0 3) 2 =)

(begin-sub-section "string-every")
(pass-if (string-every char-whitespace? "") #t eq?)
(pass-if (string-every char-whitespace? " \n") #t eq?)
(pass-if (string-every char-whitespace? "! \n" 1) #t eq?)
(pass-if (string-every char-whitespace? "! \n!" 1 3) #t eq?)
(pass-if (string-every char-whitespace? "! \n") #f eq?)
(pass-if (string-every char-whitespace? "! \n!" 1 4) #f eq?)

(begin-sub-section "string-any")
(pass-if (string-any char-upper-case? "") #f eq?)
(pass-if (string-any char-upper-case? "ajfhajfhas") #f eq?)
(pass-if (string-any char-upper-case? "jahdfkljafJasdfasd") #t eq?)
(pass-if (string-any char-upper-case? "jahdfkljafJasdfasd" 11) #f eq?)
(pass-if (string-any char-upper-case? "jahdfkljafJasdfasd" 0 10) #f eq?)

(test-summary)
