diff --git a/collects/planet2/lib.rkt b/collects/planet2/lib.rkt index 61fe82e5e6..f997eaab53 100644 --- a/collects/planet2/lib.rkt +++ b/collects/planet2/lib.rkt @@ -279,11 +279,61 @@ [(not fail?) #f] [else - (pkg-error (~a "package not currently installed\n" + (pkg-not-installed pkg-name db)])) + +;; return the current scope as a string +;; -> (or/c "user" "shared" "installation") +(define (current-scope->string) + (cond [(current-install-system-wide?) + "installation"] + [(current-install-version-specific?) + "user"] + [else + "shared"])) + +;; prints an error for packages that are not installed +;; pkg-name db -> void +(define (pkg-not-installed pkg-name db) + (define installation-db + (parameterize ([current-install-system-wide? #t]) + (read-pkg-db))) + (define user-db + (parameterize ([current-install-system-wide? #f] + [current-install-version-specific? #t]) + (read-pkg-db))) + (define version-db + (parameterize ([current-install-system-wide? #f] + [current-install-version-specific? #f]) + (read-pkg-db))) + + ;; see if the package is installed in any scope + (define-values (in-install? in-user? in-shared?) + (values + (and (hash-ref installation-db pkg-name #f) + "--installation") + (and (hash-ref user-db pkg-name #f) + "--user") + (and (hash-ref version-db pkg-name #f) + "--shared"))) + + (define not-installed-msg + (cond [(or in-user? in-install? in-shared?) + => + (λ (scope-str) + (~a "could not remove package\n" + " package installed in a different scope: " + (substring scope-str 2) "\n" + " consider using the " scope-str " flag\n"))] + [else (~a "could not remove package\n" + " package not currently installed\n")])) + + (pkg-error (~a not-installed-msg + " current scope: ~a\n" " package: ~a\n" " currently installed:~a") + (current-scope->string) pkg-name - (format-list (hash-keys db)))])) + (format-list (hash-keys db)))) (define (update-pkg-db! pkg-name info) (write-file-hash! diff --git a/collects/tests/planet2/tests-remove.rkt b/collects/tests/planet2/tests-remove.rkt index f6bf6e477f..e4c1cc29b6 100644 --- a/collects/tests/planet2/tests-remove.rkt +++ b/collects/tests/planet2/tests-remove.rkt @@ -69,4 +69,11 @@ $ "raco pkg remove --auto" $ "raco pkg show -u" =stdout> " [none]\n" $ "racket -e '(require planet2-test1)'" =exit> 1 - $ "racket -e '(require planet2-test2)'" =exit> 1))))) + $ "racket -e '(require planet2-test2)'" =exit> 1)) + (with-fake-root + (shelly-case + "different scope error" + $ "raco pkg install --shared test-pkgs/planet2-test1.zip" =exit> 0 + $ "raco pkg remove planet2-test1" =exit> 1 + =stderr> #rx"package installed in a different scope: shared" + $ "raco pkg remove --shared planet2-test1")))))