(let ((database (find-database database :errorp (and database error))))
(when database
(if (conn-pool database)
- (when (release-to-pool database)
- (setf *connected-databases* (delete database *connected-databases*))
- (when (eq database *default-database*)
- (setf *default-database* (car *connected-databases*)))
- t)
+ (with-process-lock ((conn-pool-lock (conn-pool database)) "Delete from pool")
+ (when (release-to-pool database)
+ (setf *connected-databases* (delete database *connected-databases*))
+ (when (eq database *default-database*)
+ (setf *default-database* (car *connected-databases*)))
+ t))
(when (database-disconnect database)
(setf *connected-databases* (delete database *connected-databases*))
(when (eq database *default-database*)