suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add setup/matching-platform

Browse Source 
Put a function that was implemented in two places in one place.
This commit is contained in:
Matthew Flatt 2014-07-05 10:32:06 +01:00
parent 75310338dc
commit 739863099d
6 changed files with 103 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -4,7 +4,8 @@
"common.rkt"
(for-label pkg
(except-in racket/base remove)
setup/dirs))
setup/dirs
setup/matching-platform))
@(define @|Planet1| @|PLaneT|)
@ -813,7 +814,8 @@ The following @filepath{info.rkt} fields are used by the package manager:
@racket[(system-type)] when @racket[_platforms-spec] is
a symbol or @racket[(path->string
(system-library-subpath #f))] when
@racket[_platform-spec] is a regular expression. For
@racket[_platform-spec] is a string or regular expression.
See also @racket[matching-platform?]. For
example, platform-specific binaries can be placed into
their own packages, with one separate package and one
dependency for each supported platform.}

53
pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -12,6 +12,7 @@
setup/getinfo
setup/main-collects
setup/collection-name
setup/matching-platform
setup/path-to-relative
setup/xref scribble/xref
;; info -- no bindings from this are used
@ -599,18 +600,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by
@racket[copy-man-pages], but the original file is removed after it
is copied (which makes sense for precompiled packages).}
@item{@indexed-racket[install-platform] : @racket[(or/c regexp?
string? symbol?)] --- Determines whether files are copied or moved
@item{@indexed-racket[install-platform] : @racket[platform-spec?]
--- Determines whether files are copied or moved
for @racket[copy-foreign-libs], @racket[move-foreign-libs],
@racket[copy-shared-files], or @racket[move-shared-files]. If
@racket[install-platform] is defined as a regexp, then files are
copied/moved only if the regexp matches the result of
@racket[(system-library-subpath #f)]. If @racket[install-platform]
is defined as a string, then files are copied/moved only if the
@racket[(path->string (system-library-subpath #f))] produces the
same string. If @racket[install-platform] is defined as a symbol,
then files are copied/moved only if the @racket[(system-type)]
produces the same symbol.}
@racket[copy-shared-files], or @racket[move-shared-files].
See @racket[matching-platform?] for information on the way that the
specification is compared to @racket[(system-type)]
and @racket[(system-library-subpath #f)].}
@item{@indexed-racket[install-collection] : @racket[path-string?] --- A
library module relative to the collection that provides
@ -1518,6 +1514,41 @@ is not the ASCII value of a letter, digit, @litchar{-}, @litchar{+},
or @litchar{_}.}
@; ------------------------------------------------------------------------
@section[#:tag "matching-platform"]{API for Platform Specifications}
@defmodule[setup/matching-platform]
@history[#:added "6.0.1.13"]
@defproc[(platform-spec? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a symbol, string, or regexp value
(in the sense of @racket[regexp?]), @racket[#f] otherwise.}
@defproc[(matching-platform? [spec platform-spec?]
[#:system-type sys-type (or/c #f symbol?) (system-type)]
[#:system-library-subpath sys-lib-subpath (or/c #f path?)
(system-library-subpath #f)])
boolean?]{
Reports whether @racket[spec] matches @racket[sys-type] or
@racket[sys-lib-subpath], where @racket[#f] values for the latter are
replaced with the default values.
If @racket[spec] is a symbol, then the result is @racket[#t] if
@racket[sys-type] is the same symbol, @racket[#f] otherwise.
If @racket[spec] is a string, then the result is @racket[#t] if
@racket[(path->string sys-lib-subpath)] is the same string,
@racket[#f] otherwise.
If @racket[spec] is a regexp value, then the result is @racket[#t] if
the regexp matches @racket[(path->string sys-lib-subpath)],
@racket[#f] otherwise.}
@; ------------------------------------------------------------------------
@section[#:tag "xref"]{API for Cross-References for Installed Manuals}

25
pkgs/racket-pkgs/racket-test/tests/setup/matching-platform.rkt Normal file
View File

@ -0,0 +1,25 @@
#lang racket/base
(require setup/matching-platform
rackunit
racket/string)
(check-equal? #t (platform-spec? (system-type)))
(check-equal? #t (platform-spec? "string"))
(check-equal? #t (platform-spec? #rx"regexp"))
(check-equal? #f (platform-spec? #"bytes"))
(check-equal? #f (platform-spec? 11))
(check-equal? #t (matching-platform? (system-type)))
(check-equal? #f (matching-platform? 'no-such-system-type))
(check-equal? #t (matching-platform? 'unix #:system-type 'unix))
(check-equal? #t (matching-platform? 'windows #:system-type 'windows))
(check-equal? #t (matching-platform? (path->string (system-library-subpath #f))))
(check-equal? #f (matching-platform? "no-such-platform"))
(check-equal? #t (matching-platform? "no-such-platform" #:system-library-subpath (build-path "no-such-platform")))
(check-equal? #f (matching-platform? "no" #:system-library-subpath (build-path "no-such-platform")))
(check-equal? #t (matching-platform? #rx"."))
(check-equal? #t (matching-platform? (regexp-quote (path->string (system-library-subpath #f)))))
(check-equal? #f (matching-platform? #rx"^no-such-platform$"))
(check-equal? #t (matching-platform? #rx"^no-such-platform$" #:system-library-subpath (build-path "no-such-platform")))

10
racket/collects/pkg/lib.rkt
View File

@ -11,6 +11,7 @@
setup/unpack
setup/dirs
setup/collection-name
setup/matching-platform
racket/port
racket/list
racket/function
@ -336,14 +337,7 @@
(define (dependency-this-platform? dep)
(define p (dependency-lookup '#:platform dep))
(if p
(if (symbol? p)
(eq? p (system-type))
(let ([s (path->string (system-library-subpath #f))])
(if (regexp? p)
(regexp-match? p s)
(equal? p s))))
#t))
(or (not p) (matching-platform? p)))
(define pkg-lock-held (make-parameter #f))
(define pkg-lock-scope (make-parameter #f))

28
racket/collects/setup/matching-platform.rkt Normal file
View File

@ -0,0 +1,28 @@
#lang racket/base
(provide platform-spec?
matching-platform?)
(define (platform-spec? p)
(or (symbol? p) (string? p) (regexp? p)))
(define (matching-platform? p
#:system-type [sys-type #f]
#:system-library-subpath [sys-lib-subpath #f])
(unless (platform-spec? p)
(raise-argument-error 'matching-platform? "platform-spec?" p))
(unless (or (not sys-type) (symbol? sys-type))
(raise-argument-error 'matching-platform? "(or/c symbol? #f)" sys-type))
(unless (or (not sys-lib-subpath) (path? sys-lib-subpath))
(raise-argument-error 'matching-platform? "(or/c path? #f)" sys-lib-subpath))
(cond
[(symbol? p)
(eq? p (or sys-type (system-type)))]
[else
(define s (path->string (or sys-lib-subpath
(system-library-subpath #f))))
(cond
[(regexp? p)
(regexp-match? p s)]
[else
(equal? p s)])]))

6
racket/collects/setup/setup-core.rkt
View File

@ -25,6 +25,7 @@
"unpack.rkt"
"getinfo.rkt"
"dirs.rkt"
"matching-platform.rkt"
"main-collects.rkt"
"path-to-relative.rkt"
"path-relativize.rkt"
@ -838,10 +839,7 @@
(string? v)
(symbol? v))
(error "entry is not regexp, string, or symbol:" v)))))
(cond
[(regexp? sys) (regexp-match? sys (system-library-subpath #f))]
[(symbol? sys) (eq? sys (system-type))]
[else (equal? sys (path->string (system-library-subpath #f)))]))
(matching-platform? sys))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make zo ;;