(import (scheme base)
        (only (csc sort) sort)
        (only (csc testing)
              define-test
              errorf
              subtest)
        (csc hash-map))


(define (hash-symbol s)
  (hash-bytevector (string->utf8 (symbol->string s))))


(define (symbol<? s1 s2)
  (string<? (symbol->string s1) (symbol->string s2)))


(define-test (test-hash-map->alist t)
  (define-record-type <test-case>
    (test-case desc vals)
    test-case?
    (desc desc)
    (vals vals))
  (let ((tests (list
                 (test-case
                   "singleton"
                   '((a . 1)))
                 (test-case
                   "two"
                   '((a . 1) (b . 2)))
                 (test-case
                   "longer"
                   '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))))))
    (for-each
      (lambda (tc)
        (subtest t (desc tc)
                 (let* ((m (alist->hash-map hash-symbol symbol<? (vals tc)))
                        (got (hash-map->alist m)))
                   (unless (equal?
                             (sort
                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
                               got)
                             (sort
                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
                               (vals tc)))
                     (errorf t "(hash-map->alist {}) = {}, want {}." m got (vals tc))))))
      tests)))


(define-test (test-alist->hash-map t)
  (define-record-type <test-case>
    (test-case desc vals want)
    test-case?
    (desc desc)
    (vals vals)
    (want want))
  (let ((tests (list
                 (test-case
                   "singleton"
                   '((a . 1))
                   '((a . 1)))
                 (test-case
                   "two"
                   '((a . 1) (b . 2))
                   '((a . 1) (b . 2)))
                 (test-case
                   "larger"
                   '((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))
                   '((f . 5) (m . 1) (n . 7) (q . 3) (x . 8)))
                 (test-case
                   "in-order"
                   '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))
                   '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
                 (test-case
                   "reversed"
                   '((h . ()) (g . ()) (f . ()) (e . ()) (d . ()) (c . ()) (b . ()) (a . ()))
                   '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
                 (test-case
                   "overwrite"
                   '((a . 1) (a . 2))
                   '((a . 2)))
                 (test-case
                   "alternating"
                   '((h . ()) (g . ()) (i . ()) (f . ()) (j . ()) (e . ()) (k . ()) (d . ()) (l . ()) (c . ()))
                   '((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))))))
    (for-each
      (lambda (tc)
        (subtest t (desc tc)
                 (let ((got (alist->hash-map hash-symbol symbol<? (vals tc))))
                   (unless (equal?
                             (sort
                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
                               (hash-map->alist got))
                             (sort
                               (lambda (x1 x2) (symbol<? (car x1) (car x2)))
                               (want tc)))
                     (errorf t "(alist->hash-map {}) = {}, want {}." (vals tc) (hash-map->alist got) (want tc))))))
      tests)))