diff --git a/pkgs/racket-doc/pkg/scribblings/strip.scrbl b/pkgs/racket-doc/pkg/scribblings/strip.scrbl index fcb10a1547..416f335ff7 100644 --- a/pkgs/racket-doc/pkg/scribblings/strip.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/strip.scrbl @@ -215,19 +215,21 @@ with the same file/directory omissions and updates as @command-ref{create}.} @defproc[(generate-stripped-directory [mode (or/c 'source 'binary 'binary-lib 'built)] - [src-dir path-string?] - [dest-dir path-string?]) + [src-dir (and/c path-string? directory-exists?)] + [dest-dir (and/c path-string? directory-exists?)]) void?]{ Copies @racket[src-dir] to @racket[dest-dir] with file/directory -omissions and updates corresponding the creation of a @tech{source +omissions and updates corresponding to the creation of a @tech{source package}, @tech{binary package}, @tech{binary library package}, or @tech{built package} as indicated -by @racket[mode].} +by @racket[mode].} Note, @racket[generate-stripped-directory] does not compile or render source files +found in the @racket[src-dir]. To perform precompilation or rendering before stripping the source directory, +use @command-ref{setup} or @command-ref{make}. @defproc[(check-strip-compatible [mode (or/c 'source 'binary 'binary-lib 'built)] [pkg-name string?] - [dir path-string?] + [dir (and/c path-string? directory-exists?)] [error (string? . -> . any)]) any]{ diff --git a/pkgs/racket-test/tests/pkg/test.rkt b/pkgs/racket-test/tests/pkg/test.rkt index 2a7590e599..78005d2af9 100644 --- a/pkgs/racket-test/tests/pkg/test.rkt +++ b/pkgs/racket-test/tests/pkg/test.rkt @@ -61,7 +61,9 @@ "raco" "binary" "catalogs" - "failure")) + "failure" + + "api")) (module+ test (module config info diff --git a/pkgs/racket-test/tests/pkg/tests-api.rkt b/pkgs/racket-test/tests/pkg/tests-api.rkt new file mode 100644 index 0000000000..acb96b8af8 --- /dev/null +++ b/pkgs/racket-test/tests/pkg/tests-api.rkt @@ -0,0 +1,50 @@ +#lang racket/base +(require rackunit + racket/file + pkg/strip + "util.rkt") + +(this-test-is-run-by-the-main-test) + +(pkg-tests + + (parameterize ([current-directory test-source-directory]) + (define tmp-dir (path->directory-path (make-temporary-file "tmp~a" 'directory))) + (define pkg-path (build-path "test-pkgs" "pkg-strip")) + (define pkg-dest-path (build-path tmp-dir "pkg-strip")) + (make-directory pkg-dest-path) + + ;; Giving path to nonexistent directory should raise a contract exception. + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (check-strip-compatible 'source "pkg-strip" "does not exist" error))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (check-strip-compatible 'binary "pkg-strip" "does not exist" error))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (check-strip-compatible 'binary-lib "pkg-strip" "does not exist" error))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (check-strip-compatible 'built "pkg-strip" "does not exist" error))) + + ;; Path to existing directory should succeed. + (check-not-exn (lambda () (check-strip-compatible 'source "pkg-strip" pkg-path error))) + + ;; Giving path to nonexistent src directory should raise a contract exception. + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'source 5 pkg-dest-path))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'binary "does not exist" pkg-dest-path))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'binary-lib "does not exist" pkg-dest-path))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'built "does not exist" pkg-dest-path))) + + ;; Giving path to nonexistent dest directory should raise a contract exception. + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'source pkg-path "does not exist"))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'binary pkg-path "does not exist"))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'binary-lib pkg-path "does not exist"))) + + (check-exn #rx"expected: \\(and/c path-string\\? directory-exists\\?\\)" (lambda () (generate-stripped-directory 'built pkg-path "does not exist"))) + + ;; Paths to existing src and dest directories should succeed. + (check-not-exn (lambda () (generate-stripped-directory 'source pkg-path pkg-dest-path))) + + )) diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt index 6a40c01fad..dd9eb583eb 100644 --- a/racket/collects/pkg/strip.rkt +++ b/racket/collects/pkg/strip.rkt @@ -21,6 +21,12 @@ (define strip-binary-compile-info (make-parameter #t)) (define (check-strip-compatible mode pkg dir error) + (unless (and (path-string? dir) (directory-exists? dir)) + (raise-argument-error + 'check-strip-compatible + "(and/c path-string? directory-exists?)" + dir)) + (define i (get-info/full dir)) (define raw-status (and i (i 'package-content-state (lambda () #f)))) @@ -58,6 +64,18 @@ (define (generate-stripped-directory mode dir dest-dir #:check-status? [check-status? #t]) + (unless (and (path-string? dir) (directory-exists? dir)) + (raise-argument-error + 'generate-stripped-directory + "(and/c path-string? directory-exists?)" + dir)) + + (unless (and (path-string? dest-dir) (directory-exists? dest-dir)) + (raise-argument-error + 'generate-stripped-directory + "(and/c path-string? directory-exists?)" + dest-dir)) + (define drop-keep-ns (make-base-namespace)) (define (add-drop+keeps dir base drops keeps) (define get-info (get-info/full dir #:namespace drop-keep-ns))