;;;; uuid-lib-test.scm  -*- Hen -*-

(use test)
(use uuid-lib)

(test-group "Common API"

  (test-assert "uuid? <null>" (uuid? (make-uuid)))
  (test-assert "uuid? V1" (uuid? (make-uuid 'V1)))
  (test-assert "uuid? V4" (uuid? (make-uuid 'V4)))
  (test-assert "uuid? time" (uuid? (make-uuid 'time)))
  (test-assert "uuid? random" (uuid? (make-uuid 'random)))

  (test-assert "uuid-null? 1" (not (uuid-null? (make-uuid 'V1))))
  (test-assert "uuid-null? 2" (uuid-null? (make-uuid)))

  (test-assert "uuid-clear!" (uuid-null? (uuid-clear! (make-uuid 'V4))))

  (let* ((tuuid (make-uuid 'V4))
	 (cuuid (uuid-copy tuuid)) )
    (test-assert "uuid-copy =" (uuid=? tuuid cuuid))
    (test-assert "uuid-copy !eq" (not (eq? tuuid cuuid))) )

  (test-assert "A uuid is = & <= & >= to itself"
    (let ((tuuid (make-uuid 'random)))
      (and (uuid=? tuuid tuuid) (uuid<=? tuuid tuuid) (uuid>=? tuuid tuuid))))

  (test-assert "A !null uuid is \"unique\"" (not (uuid=? (make-uuid 'V1) (make-uuid 'V1))))
  (test-assert "A null uuid is not \"unique\"" (uuid=? (make-uuid) (make-uuid)))

  (test-assert "External form of uuid"
    (let ((tuuid (make-uuid 'V1)))
      (uuid=? tuuid (string->uuid (uuid->string tuuid)))))
)

(test-group "Specific API"

  (test-assert "A uuid is unique" (not (uuid=? (uuid-generate) (uuid-generate))))

  (test-assert "External form of uuid (1)"
    (let ((tuuid (uuid-generate)))
      (uuid=? tuuid (uuid-parse (uuid-unparse tuuid 'lower)))))

  (test "Error in generate caught correctly"
    "bad argument type - invalid variant"
    (condition-case (uuid-generate 2)
      (v () ((condition-property-accessor 'exn 'message) v))))

  (test "Error in unparse caught correctly"
    "bad argument type - invalid case"
    (condition-case (uuid-unparse (uuid-generate) 2)
      (v () ((condition-property-accessor 'exn 'message) v))))

  (test "Finalizer"
    #t
    (condition-case (number? (gc))
      (v () ((condition-property-accessor 'exn 'message) v))))
)

(unless (zero? (test-failure-count)) (exit 1))