;;;; string-utils-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Oct '17

(import scheme utf8)

(import test)

(test-begin "String Utils")

;;;

(import rabin-karp (srfi 1))

(test-group "Rabin-Karp String Search"
  (let ((srch1 (make-string-search '("foo" "bar" "baz")))
        (str1 "abc foo cbs bar nbc baz") )
    (test-assert (procedure? srch1))
    (test '(("foo" 4 . 7) ("bar" 12 . 15) ("baz" 20 . 23))
          (collect-string-search srch1 str1))
   (test-assert (null? (collect-string-search srch1 "no match"))) )
)

(import unicode-utils to-hex string-hexadecimal)

(test-group "Unicode"
  (test-assert (ascii-codepoint? #\a))
  (test "abc" (unicode-string #\a #\b #\c))
  (test "cebb" (string->hex (char->unicode-string #\u03BB)))
  (test "cebbcebbcebb" (string->hex (unicode-string #\u03BB #\u03BB #\u03BB)))
  (test "cebbcebb" (string->hex (unicode-make-string 2 #\u03BB)))
)

(import memoized-string)

;NOTE interspersed define non-standard
(test-group "Memoized"
  (define a5 (make-string+ 5 #\a))
  (test "a" (make-string+ 1 #\a))
  (test "aaaaa" a5)
  
  (define spc5 (make-string+ 5))
  (test "     " spc5)
  (test-assert (eq? a5 (make-string+ 5 #\a)))
  (test-assert (eq? spc5 (make-string+ 5 #\space)))
  
  (define tststr1 (string+ #\我 #\你))
  (test "(string+ #\\我 #\\你)" tststr1 "我你")
  (test-assert (eq? tststr1 (string+ #\我 #\你)))
  
  (define tststr2 "上海的东西很便宜")
  (test-assert (eq? tststr2 (global-string tststr2)))
)

(import string-hexadecimal (chicken blob) (srfi 4))

(test-group "To Hex"

  (let* ((len 3) (t (make-string (* 2 len))))
		(test-error (begin (blob_to_hex t (string->blob "12abc34") 2 (+ 2 len)) t)) )

	(let* ((len 3) (t (make-string (* 2 len))))
		(blob_to_hex t (string->blob "12abc34") 2 len)
		(test "616263" t) )
  ;
	(let* ((len 3) (t (make-string (* 2 len))))
		(u8vec_to_hex t (u8vector 1 2 #x61 #x62 #x63 3 4) 2 len)
		(test "616263" t) )
  ;
	(let* ((len 2) (t (make-string (* 2 len))))
		(s8vec_to_hex t (s8vector 1 2 -45 -54 3 4) 2 len)
		(test "d3ca" t) )
)

(test-group "String -> Hex"
	(test "616263" (string->hex "12abc34" 2 5))
	(test "414243444546" (string->hex "ABCDEF"))
	(test "4243444546" (string->hex "ABCDEF" 1))
	(test "4243" (string->hex "ABCDEF" 1 3))
	(test-error (string->hex "a" 2))
	(test-error (string->hex "ab" 0 3))
	(test-error (string->hex "12abc34" -2 -5))
)

(test-group "Hex -> String"
	(test "abc" (hex->string "616263"))
	(test "ABCDEF" (hex->string "414243444546"))
	(test "BCDEF" (hex->string "4243444546"))
	(test "BC" (hex->string "4243"))
	(test "k]" (hex->string "6a6B5D4c" 2 6))
	(test-error (hex->string "424"))
	(test-error (hex->string "4243" 1))
	(test-error (hex->string "4243" 0 3))
	(test-error (hex->string "4243" -2 -6))
)

;;

(import string-interpolation)

(test-group "String Interpolation"
  (let ((res '(##sys#print-to-string (list "foo " (+ 1 2) " bar"))))
    (test res (string-interpolate "foo #(+ 1 2) bar"))
    (test res (string-interpolate "foo #(+ 1 2) bar"))
    ;...${...} unsuported
    (test '(##sys#print-to-string (list "foo " ((+ 1 2)) " bar"))
          (string-interpolate "foo ${(+ 1 2)} bar" eval-tag: #\$))
    (test res (string-interpolate "foo $(+ 1 2) bar" eval-tag: #\$)) )
)

(import (prefix utf8-string-interpolation utf8::))

(test-group "String Interpolation (UTF-8)"
  (let ((res '(##sys#print-to-string (list "听说上海的 " (+ 1 2) " 东西很贵"))))
    (test res (utf8::string-interpolate "听说上海的 #(+ 1 2) 东西很贵"))
    (test res (utf8::string-interpolate "听说上海的 #(+ 1 2) 东西很贵"))
    ;...${...} unsuported
    (test '(##sys#print-to-string (list "听说上海的 " ((+ 1 2)) " 东西很贵"))
          (utf8::string-interpolate "听说上海的 ${(+ 1 2)} 东西很贵" eval-tag: #\$))
    (test res (utf8::string-interpolate "听说上海的 $(+ 1 2) 东西很贵" eval-tag: #\$)) )
)

(import string-interpolation-syntax (chicken port))

;must be "top level"; cannot be test-group
(test-begin "String Interpolation Syntax")
  (set-sharp-string-interpolation-syntax string-interpolate)
  ;...${...} unsuported
  (test
    '((##sys#print-to-string (list "foo " ((+ 1 2)) " bar")))
    (list (call-with-input-string "#\"foo #{(+ 1 2)} bar\"" read)))
  (set-sharp-string-interpolation-syntax #f)

  (set-sharp-string-interpolation-syntax
    (cute string-interpolate <> eval-tag: #\$))
  ;...${...} unsuported
  (test
    '((##sys#print-to-string (list "foo " ((+ 1 2)) " bar")))
    (list (call-with-input-string "#\"foo ${(+ 1 2)} bar\"" read)))
  (set-sharp-string-interpolation-syntax #f)
(test-end "String Interpolation Syntax")

;;

(import string-utils)

(test-group "string-utils"

  (test "foo" (string-fixed-length "abcde" 1 #:trailing "foo"))
  (test "a..." (string-fixed-length "abcde" 4))
  (test "abc " (string-fixed-length "abc" 4))
  (test "👤..." (string-fixed-length "👤👩👨📷📺" 4))
  (test "👤👩🎑🎍" (string-fixed-length "👤👩👨📷📺" 4 #:trailing "🎑🎍"))
  #; ;FIXME char is not 24-bit
  (test "👤👩👨📷📺🎋" (string-fixed-length "👤👩👨📷📺" 6 #:pad-char #\U0001F38B))

  (test "foo" (string-trim-whitespace-both "  foo \t \n  \r "))
  (test "(a b)" (list-as-string '(a b)))
  (test "...27" (number->padded-string 23 5 #\. 8))

  (test "foobar" (string-longest-prefix "foobarbaz" '("foobaz" "foobar" "barbaz" "barfoo" "bazfoo")))
  (test "barbaz" (string-longest-suffix "foobarbaz" '("foobaz" "foobar" "barbaz" "barfoo" "bazfoo")))

  (test "fooba" (string-longest-common-prefix '("foobaz" "foobar")))
  (test "foo" (string-longest-common-suffix '("bazfoo" "barfoo")))

  (test "unzip default" "a.b,c" (apply string-zip (receive (string-unzip "a.b,c"))))
  (test "a.b,c" (apply string-zip (receive (string-unzip "a.b,c" ",."))))
)

;;;

(test-end "String Utils")

(test-exit)