From b94e77a062dc7e286105614c14a256b0addfe916 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 17 Mar 2016 15:16:05 -0600
Subject: [PATCH] raco pkg migrate: fix cross-version locking

---
 racket/collects/pkg/private/lock.rkt    | 11 ++++++++++-
 racket/collects/pkg/private/migrate.rkt | 13 +++++++++----
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/racket/collects/pkg/private/lock.rkt b/racket/collects/pkg/private/lock.rkt
index 20e0f75462..0024b363a9 100644
--- a/racket/collects/pkg/private/lock.rkt
+++ b/racket/collects/pkg/private/lock.rkt
@@ -10,7 +10,9 @@
          with-pkg-lock
          with-pkg-lock/read-only
          ;; Checks that the lock is held:
-         write-file-hash!)
+         write-file-hash!
+         ;; For migrate:
+         call-with-separate-lock)
 
 (define pkg-lock-held (make-parameter #f))
 (define pkg-lock-scope (make-parameter #f))
@@ -62,6 +64,13 @@
 (define-syntax-rule (with-pkg-lock/read-only e ...)
   (with-pkg-lock* #t (λ () e ...)))
 
+;; Intended for use with `pkg-migrate`, which needs to
+;; read a different version than it writes to:
+(define (call-with-separate-lock f)
+  (parameterize ([pkg-lock-held #f]
+                 [pkg-lock-scope #f])
+    (f)))
+
 (define (write-file-hash! file new-db)
   (unless (eq? (pkg-lock-held) 'exclusive)
     (pkg-error "attempt to write package database without write lock"))
diff --git a/racket/collects/pkg/private/migrate.rkt b/racket/collects/pkg/private/migrate.rkt
index e9befec449..97f5764f75 100644
--- a/racket/collects/pkg/private/migrate.rkt
+++ b/racket/collects/pkg/private/migrate.rkt
@@ -9,7 +9,8 @@
          "params.rkt"
          "install.rkt"
          "repo-path.rkt"
-         "dirs.rkt")
+         "dirs.rkt"
+         "print.rkt")
 
 (provide pkg-migrate)
 
@@ -26,8 +27,12 @@
                      #:force-strip? [force-strip? #f]
                      #:dry-run? [dry-run? #f])
   (define from-db
-    (parameterize ([current-pkg-scope-version from-version])
-      (installed-pkg-table #:scope 'user)))
+    ((if (equal? (current-pkg-scope-version) from-version)
+         (lambda (f) (f))
+         call-with-separate-lock)
+     (lambda ()
+       (parameterize ([current-pkg-scope-version from-version])
+         (installed-pkg-table #:scope 'user)))))
   (define installed-dir
     (parameterize ([current-pkg-scope 'user])
       (pkg-installed-dir)))
@@ -81,4 +86,4 @@
                     #:force-strip? force-strip?
                     #:dry-run? dry-run?)
        (unless quiet?
-         (printf "Packages migrated\n")))))
+         (printf "Packages migrated~a\n" (dry-run-explain dry-run?))))))