dardoria / uuid

Common Lisp implementation of UUIDs according to RFC4122
47 stars 12 forks source link

Use Ironclad to generate a node part of v4 UUID #7

Closed fukamachi closed 4 years ago

fukamachi commented 4 years ago

To prevent from the conflict in a multithread environment.

How to reproduce

This is an easy script to run 32 threads that generate UUIDv4.

(ql:quickload '(:legion :uuid) :silent t)

(defpackage #:uuid-conflict-test
  (:use #:cl
        #:legion
        #:uuid)
  (:import-from #:uuid
                #:make-v4-uuid*))
(in-package #:uuid-conflict-test)

(defun new-uuid ()
  (string-downcase (princ-to-string (make-v4-uuid))))

(defun make-uuid-cluster (db parallel)
  (make-cluster parallel
                (lambda (job)
                  (declare (ignore job))
                  (let ((uuid (new-uuid)))
                    (when (gethash uuid db)
                      (error "CONFLICT!!! => ~A (count=~A)" uuid (hash-table-count db)))
                    (setf (gethash uuid db) t)))))

(defun make-db ()
  (make-hash-table :synchronized t :test 'equal))

(defun run (&optional (parallel 32))
  (let* ((db (make-db))
         (cluster (make-uuid-cluster db parallel)))
    (start cluster)

    (unwind-protect
        (dotimes (i 40)
          (dotimes (j 100)
            (dotimes (k parallel)
              (add-job cluster t))
            (sleep 0.01))
          (format t "~&~A~%" (hash-table-count db)))
      (stop cluster)
      (format t "~&Done. Run ~D times.~%" (hash-table-count db)))))