diff --git a/pkgs/compiler-test/tests/compiler/embed/embed-me35.rkt b/pkgs/compiler-test/tests/compiler/embed/embed-me35.rkt new file mode 100644 index 0000000000..0392a569be --- /dev/null +++ b/pkgs/compiler-test/tests/compiler/embed/embed-me35.rkt @@ -0,0 +1,19 @@ +#lang racket/base +(require setup/dirs) + +(define (check-path-or-false p) + (unless (or (not p) (path? p)) + (error 'embed-me35 "no good: ~s" p))) + +(define (check-list-of-paths ps) + (unless (and (list? ps) (andmap path? ps)) + (error 'embed-me35 "no good: ~s" ps))) + +;; These directories are not available in a created distibution, but +;; they shouldn't crash: +(check-path-or-false (find-apps-dir)) +(check-path-or-false (find-pkgs-dir)) +(check-list-of-paths (get-pkgs-search-dirs)) +(check-path-or-false (find-links-file)) + +'ok-35 diff --git a/pkgs/compiler-test/tests/compiler/embed/test.rkt b/pkgs/compiler-test/tests/compiler/embed/test.rkt index 6747acbadf..d36a4ca3d6 100644 --- a/pkgs/compiler-test/tests/compiler/embed/test.rkt +++ b/pkgs/compiler-test/tests/compiler/embed/test.rkt @@ -267,7 +267,8 @@ (one-mz-test "embed-me19.rkt" "This is 19.\n" #f) (one-mz-test "embed-me21.rkt" "This is 21.\n" #f) (one-mz-test "embed-me31.rkt" "This is 31.\n" #f) - (one-mz-test "embed-me34.rkt" "This is 34 in a second place.\n" #f)) + (one-mz-test "embed-me34.rkt" "This is 34 in a second place.\n" #f) + (one-mz-test "embed-me35.rkt" "'ok-35\n" #f)) ;; Try unicode expr and cmdline: (prepare dest "unicode") diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index 03adb03461..6380d2e242 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -1333,10 +1333,11 @@ current-system paths while @racket[get-cross-lib-search-dirs] and A @racket[#f] result indicates that no configuration directory is available.} -@defproc[(find-links-file) path?]{ +@defproc[(find-links-file) (or/c path? #f)]{ Returns a path to the installation's @tech[#:doc reference-doc]{collection links file}. The file indicated by the - returned path may or may not exist. + returned path may or may not exist. A @racket[#f] result indicates + that no links file is available. @see-config[links-file]} @@ -1345,7 +1346,7 @@ current-system paths while @racket[get-cross-lib-search-dirs] and links file}. The file indicated by the returned path may or may not exist.} -@defproc[(get-links-search-files) path?]{ +@defproc[(get-links-search-files) (listof path?)]{ Returns a list of paths to installation @tech[#:doc reference-doc]{collection links files} to search in order. (Normally, the result includes the result of @@ -1355,10 +1356,11 @@ current-system paths while @racket[get-cross-lib-search-dirs] and @see-config[links-search-files]} -@defproc[(find-pkgs-dir) path?]{ +@defproc[(find-pkgs-dir) (or/c path? #f)]{ Returns a path to the directory containing packages with installation scope; the directory indicated by the returned path may - or may not exist. + or may not exist. A @racket[#f] result indicates that no package-installation + directory is available. @see-config[pkgs-dir]} diff --git a/racket/collects/launcher/launcher.rkt b/racket/collects/launcher/launcher.rkt index ca91fbd49f..7ef1fac965 100644 --- a/racket/collects/launcher/launcher.rkt +++ b/racket/collects/launcher/launcher.rkt @@ -534,7 +534,9 @@ dest)) (define dir (if user? (find-user-apps-dir) - (find-apps-dir))) + (or (find-apps-dir) + (error 'installed-executable-path->desktop-path + "no installation directory is available")))) (path-replace-extension (build-path dir (file-name-from-path dest)) #".desktop")) diff --git a/racket/collects/pkg/path.rkt b/racket/collects/pkg/path.rkt index 48b334f3ba..53074a35fb 100644 --- a/racket/collects/pkg/path.rkt +++ b/racket/collects/pkg/path.rkt @@ -36,7 +36,8 @@ (if (path? scope) scope (case scope - [(installation) (find-pkgs-dir)] + [(installation) (or (find-pkgs-dir) + (error 'get-pkgs-dir "no installation-scope packages directory is available"))] [(user) (find-user-pkgs-dir user-version)] [else (error "unknown package scope")]))) diff --git a/racket/collects/setup/link.rkt b/racket/collects/setup/link.rkt index 1ea3294348..17518bd75f 100644 --- a/racket/collects/setup/link.rkt +++ b/racket/collects/setup/link.rkt @@ -31,7 +31,8 @@ (define file (or in-file (if user? (build-path (find-system-path 'addon-dir) user-version "links.rktd") - (find-links-file)))) + (or (find-links-file) + (error 'links "no installation links file is available"))))) (define need-repair? #f) diff --git a/racket/collects/setup/private/dirs.rkt b/racket/collects/setup/private/dirs.rkt index 25b8b4ae61..07e8eac71c 100644 --- a/racket/collects/setup/private/dirs.rkt +++ b/racket/collects/setup/private/dirs.rkt @@ -265,7 +265,8 @@ config:apps-dir find-apps-dir find-user-apps-dir #:default (build-path "share" "applications") - (chain-to (lambda () (build-path (find-share-dir) "applications")))) + (chain-to (lambda () (let ([p (find-share-dir)]) + (and p (build-path p "applications")))))) ;; ---------------------------------------- ;; "man" @@ -302,10 +303,14 @@ (define (find-links-file) (or (force config:links-file) - (build-path (find-share-dir) "links.rktd"))) + (let ([p (find-share-dir)]) + (and p (build-path p "links.rktd"))))) (define (get-links-search-files) (combine-search (force config:links-search-files) - (list (find-links-file)))) + (let ([p (find-links-file)]) + (if p + (list p) + null)))) (define (find-user-links-file [vers (get-installation-name)]) (build-path (find-system-path 'addon-dir) @@ -321,7 +326,8 @@ get-false config:pkgs-search-dirs get-pkgs-search-dirs - (chain-to (lambda () (build-path (find-share-dir) "pkgs")))) + (chain-to (lambda () (let ([p (find-share-dir)]) + (and p (build-path p "pkgs")))))) (provide find-user-pkgs-dir) (define (find-user-pkgs-dir [vers (get-installation-name)])