;;;; symbol-utils-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

(import test)

(test-begin "Symbol Utils")

;;;

(import symbol-utils)

(test-group "value"
  (cond-expand
    (compiling
      (test-assert (symbol-value symbol->keyword)) )
    (else) )
  (test-assert (unspecified? (unspecified-value)))
)

(test-group "keyword"
  (test 'foo (keyword->symbol #:foo))
  (test "foo" (symbol->string (keyword->uninterned-symbol #:foo)))
  (test #:foo (symbol->keyword 'foo))
)

(test-group "printname"
  (test-assert (symbol-printname=? 'foo 'foo))
  (test-assert (not (symbol-printname=? 'foo 'bar)))
  (test-assert (symbol-printname=? '##sys#list->string '##sys#list->string))
  (test-assert (not (symbol-printname=? '##sys#list->string 'list->string)))

  (test-assert (not (symbol-printname<? 'foo 'foo)))
  (test-assert (symbol-printname<? 'bar 'foo))
  (test-assert (not (symbol-printname<? '##sys#list->string '##sys#list->string)))
  #;(test-assert (symbol-printname<? 'list->string '##sys#list->string))

  (test-assert (symbol-printname-ci=? 'foo 'FOO))
  (test-assert (not (symbol-printname-ci=? 'foo 'BAR)))
  (test-assert (symbol-printname-ci=? '##sys#list->string '##sys#list->STRING))
  (test-assert (not (symbol-printname-ci=? '##sys#list->string 'list->STRING)))

  (test-assert (not (symbol-printname-ci<? 'foo 'FOO)))
  (test-assert (symbol-printname-ci<? 'bar 'FOO))
  (test-assert (not (symbol-printname-ci<? '##sys#list->string '##sys#list->STRING)))
  #;(test-assert (symbol-printname-ci<? 'list->string '##sys#list->STRING))

  (test 3 (symbol-printname-length 'foo))
  (test 4 (symbol-printname-length #:foo))
  (test 5 (symbol-printname-length #:foo #t))

  (test 0 (max-symbol-printname-length '()))
  (test 3 (max-symbol-printname-length '(a abc ab)))
  (test 5 (max-symbol-printname-length '(a abc ab #:foo) #t))
)

(test-group "module printname"
  (test-assert "must be list" (not (module-printnames "abc")))
  (test-assert "not a #" (not (module-printnames '(a 23 "c"))))
  (test-assert "xplody must be symbol" (not (module-printnames '(a (b "c") "d"))))
  (test-assert "no negatives" (not (module-printnames '(a (srfi -8) "d"))))
  (let ((mns (module-printnames '((foo bar baz) foo (srfi 0)))))
    (test "xplody" "foo.bar.baz" (car mns))
    (test "just a'" "foo" (cadr mns))
    (test "special" "srfi-0" (caddr mns)) )
)

#;
(test-group "qualified"
  (test '##foo#bar (make-qualified-symbol "foo" 'bar))
  (test-assert (qualified-symbol? '##sys#list->string))
  (test-assert (not (qualified-symbol? 'sym)))
  (test "##sys#list->string" (symbol->qualified-string '##sys#list->string))
  (test "list->string" (symbol->qualified-string 'list->string))
  (test-assert (not (interned-symbol? (make-qualified-uninterned-symbol "bar" 'foo))))
)

(test-group "interned"
  (test-assert (interned-symbol? 'foo))
  (test-assert (not (interned-symbol? (gensym))))
)

(test-group "gensym"
  (let ((gen (make-gensym 'test)))
    (test "gen 0" "test0" (symbol->string (gen)))
    (test "gen 1" "testfoo1" (symbol->string (gen 'foo))) )
)

;;;

(test-end "Symbol Utils")

(test-exit)