Compare commits
7 Commits
master
...
not-rebase
| Author | SHA1 | Date | |
|---|---|---|---|
|
c850778f7a | ||
|
|
829917f8ad | ||
|
|
37beaf7813 | ||
|
|
cd3e069d37 | ||
|
|
5d721f745a | ||
|
|
6983325abe | ||
|
|
464001351c |
|
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "6.4.0.15")
|
||||
(define version "6.4.0.4")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
|||
|
|
@ -48,19 +48,6 @@ exec racket -qu "$0" ${1+"$@"}
|
|||
(compile-file name
|
||||
"compiled/current-bm_rkt.zo"))))
|
||||
|
||||
(define (mk-errortrace bm)
|
||||
(unless (directory-exists? "compiled")
|
||||
(make-directory "compiled"))
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
[read-accept-reader #t]
|
||||
[current-compile (current-compile)]
|
||||
[error-display-handler (error-display-handler)]
|
||||
[use-compiled-file-paths (use-compiled-file-paths)])
|
||||
(dynamic-require 'errortrace #f)
|
||||
(let ([name (format "~a.rkt" bm)])
|
||||
(compile-file name
|
||||
"compiled/current-bm_rkt.zo"))))
|
||||
|
||||
(define (compiled-path bm)
|
||||
"current-bm.rkt")
|
||||
|
||||
|
|
@ -408,14 +395,6 @@ exec racket -qu "$0" ${1+"$@"}
|
|||
extract-racket-times
|
||||
clean-up-zo
|
||||
racket-skip-progs)
|
||||
(make-impl 'errortrace
|
||||
void
|
||||
mk-errortrace
|
||||
(lambda (bm)
|
||||
(system (format "racket -l errortrace -u ~a" (compiled-path bm))))
|
||||
extract-racket-times
|
||||
clean-up-zo
|
||||
racket-skip-progs)
|
||||
(make-impl 'plt-r5rs
|
||||
void
|
||||
mk-plt-r5rs
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ information about packages:
|
|||
@exec{version=}@nonterm{version} query (where @nonterm{version}
|
||||
is a Racket version number) in the case of a remote URL.
|
||||
|
||||
This URL/path form is used to obtain information about
|
||||
This URL/path form is use to obtain information about
|
||||
@nonterm{package}. An HTTP request for a remote URL should
|
||||
respond with a @racket[read]-able hash table, as described
|
||||
below. A path in a local directory formed by adding
|
||||
|
|
@ -130,8 +130,7 @@ information about packages:
|
|||
|
||||
Note that a local directory served as files through an HTTP server
|
||||
works as a remote URL, as long as the @filepath{pkgs} and
|
||||
@filepath{pkgs-all} files are present (since those are optional for
|
||||
local but required for HTTP).
|
||||
@filepath{pkgs-all} files are present.
|
||||
|
||||
The source for the PLT-hosted @tech{package catalog} is in the
|
||||
@racket[(collection-file-path "pkg-catalog" "meta")]
|
||||
|
|
|
|||
|
|
@ -385,9 +385,7 @@ is:
|
|||
|
||||
If you want the package to be @nonterm{branch} or @nonterm{tag}
|
||||
instead of @exec{master}, then add @filepath{#@nonterm{branch}} or
|
||||
@filepath{#@nonterm{tag}} to the end of the package source. If your
|
||||
package is a subdirectory @nonterm{path} within the repository, add
|
||||
@filepath{?path=@nonterm{path}} to the end of the package source.
|
||||
@filepath{#@nonterm{tag}} to the end of the package source.
|
||||
|
||||
Whenever you
|
||||
|
||||
|
|
@ -397,10 +395,9 @@ your changes will automatically be discovered by those who use
|
|||
@command-ref{update} after installing from your
|
||||
GitHub-based @tech{package source}.
|
||||
|
||||
Other Git repository services@margin-note*{Support for services other
|
||||
than GitHub requires Racket version 6.1.1.1 or later.} can work
|
||||
As of Racket version 6.1.1.1, other Git repository services can work
|
||||
just as well as GitHub---including Gitorious or BitBucket---as long as
|
||||
the server supports either the HTTP(S) protocol or the
|
||||
the server supports either the ``smart'' HTTP(S) protocol or the
|
||||
native Git protocol (but use a @exec{git://} path for the latter).
|
||||
|
||||
The Racket package manager provides more support for Git-based
|
||||
|
|
|
|||
|
|
@ -265,8 +265,7 @@ is true, error messages may suggest specific command-line flags for
|
|||
[#:force-strip? force-string? boolean? #f]
|
||||
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
|
||||
[#:pull-mode pull-mode (or/c 'ff-only 'try 'rebase) 'ff-only]
|
||||
[#:link-dirs? link-dirs? boolean? #f]
|
||||
[#:dry-run? dry-run? boolean? #f])
|
||||
[#:link-dirs? link-dirs? boolean? #f])
|
||||
(or/c 'skip
|
||||
#f
|
||||
(listof (or/c path-string?
|
||||
|
|
@ -300,8 +299,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
|||
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
|
||||
and @racket[#:infer-clone-from-dir?] arguments.}
|
||||
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
|
||||
#:changed "6.1.1.8" @elem{Added the @racket[#:pull-mode] argument.}
|
||||
#:changed "6.4.0.14" @elem{Added the @racket[#:dry-run] argument.}]}
|
||||
#:changed "6.1.1.8" @elem{Added the @racket[#:pull-mode] argument.}]}
|
||||
|
||||
|
||||
@defproc[(pkg-update [sources (listof (or/c string? pkg-desc?))]
|
||||
|
|
@ -316,7 +314,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
|||
[#:use-cache? use-cache? boolean? #t]
|
||||
[#:skip-uninstalled? skip-uninstalled? boolean? #t]
|
||||
[#:quiet? quiet? boolean? #f]
|
||||
[#:use-trash? use-trash? boolean? #f]
|
||||
[#:use-trash? boolean? use-trash? #f]
|
||||
[#:from-command-line? from-command-line? boolean? #f]
|
||||
[#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
|
||||
[#:force-strip? force-string? boolean? #f]
|
||||
|
|
@ -324,8 +322,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
|||
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
|
||||
[#:pull-mode pull-mode (or/c 'ff-only 'try 'rebase) 'ff-only]
|
||||
[#:link-dirs? link-dirs? boolean? #f]
|
||||
[#:infer-clone-from-dir? infer-clone-from-dir? boolean? #f]
|
||||
[#:dry-run? dry-run? boolean? #f])
|
||||
[#:infer-clone-from-dir? infer-clone-from-dir? boolean? #f])
|
||||
(or/c 'skip
|
||||
#f
|
||||
(listof (or/c path-string?
|
||||
|
|
@ -360,8 +357,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
|||
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
|
||||
and @racket[#:infer-clone-from-dir?] arguments.}
|
||||
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
|
||||
#:changed "6.1.1.8" @elem{Added the @racket[#:skip-uninstalled?] and @racket[#:pull-mode] arguments.}
|
||||
#:changed "6.4.0.14" @elem{Added the @racket[#:dry-run] argument.}]}
|
||||
#:changed "6.1.1.8" @elem{Added the @racket[#:skip-uninstalled?] and @racket[#:pull-mode] arguments.}]}
|
||||
|
||||
|
||||
@defproc[(pkg-remove [names (listof string?)]
|
||||
|
|
@ -370,8 +366,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
|||
[#:force? force? boolean? #f]
|
||||
[#:quiet? quiet? boolean? #f]
|
||||
[#:use-trash? boolean? use-trash? #f]
|
||||
[#:from-command-line? from-command-line? boolean? #f]
|
||||
[#:dry-run? dry-run? boolean? #f])
|
||||
[#:from-command-line? from-command-line? boolean? #f])
|
||||
(or/c 'skip
|
||||
#f
|
||||
(listof (or/c path-string?
|
||||
|
|
@ -386,8 +381,7 @@ specific command-line flags for @command-ref{remove}.
|
|||
|
||||
The package lock must be held; see @racket[with-pkg-lock].
|
||||
|
||||
@history[#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
|
||||
#:changed "6.4.0.14" @elem{Added the @racket[#:dry-run] argument.}]}
|
||||
@history[#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}]}
|
||||
|
||||
|
||||
@defproc[(pkg-new [name path-string?])
|
||||
|
|
@ -425,8 +419,7 @@ The package lock must be held to allow reads; see
|
|||
[#:quiet? quiet? boolean? #f]
|
||||
[#:from-command-line? from-command-line? boolean? #f]
|
||||
[#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
|
||||
[#:force-strip? force-string? boolean? #f]
|
||||
[#:dry-run? dry-run? boolean? #f])
|
||||
[#:force-strip? force-string? boolean? #f])
|
||||
(or/c 'skip
|
||||
#f
|
||||
(listof (or/c path-string?
|
||||
|
|
@ -438,9 +431,7 @@ Implements @racket[pkg-migrate-command]. The result is the same as for
|
|||
If @racket[from-command-line?] is true, error messages may suggest
|
||||
specific command-line flags for @command-ref{migrate}.
|
||||
|
||||
The package lock must be held; see @racket[with-pkg-lock].
|
||||
|
||||
@history[#:changed "6.4.0.14" @elem{Added the @racket[#:dry-run] argument.}]}
|
||||
The package lock must be held; see @racket[with-pkg-lock].}
|
||||
|
||||
|
||||
@defproc[(pkg-catalog-show [names (listof string?)]
|
||||
|
|
|
|||
|
|
@ -173,8 +173,8 @@ For example,
|
|||
|
||||
A package source is inferred to refer
|
||||
to a directory only when it does not have a file-archive suffix, does
|
||||
not match the grammar of a package name, and either starts with
|
||||
@litchar{file://} or does not start
|
||||
not match the grammar of a package name, and either starts with starts
|
||||
with @litchar{file://} or does not start
|
||||
with alphabetic characters followed by @litchar{://}. In the
|
||||
case that the package source starts with @litchar{file://},
|
||||
it must be a URL without a @litchar{type} query or
|
||||
|
|
@ -596,9 +596,6 @@ sub-commands.
|
|||
]}
|
||||
|
||||
|
||||
@item{@DFlag{dry-run} --- Prevents changes to the current installation. All installation and update work is
|
||||
staged and checked, but the final installation step is skipped.}
|
||||
|
||||
@item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the
|
||||
environment variable @envvar{PLT_PKG_NOSETUP} is set to any non-empty value.}
|
||||
|
||||
|
|
@ -616,8 +613,7 @@ sub-commands.
|
|||
@DFlag{multi-clone} flags.}
|
||||
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
|
||||
the @DFlag{deps} default to depend only on interactive mode.}
|
||||
#:changed "6.1.1.8" @elem{Added the @DFlag{pull} flag.}
|
||||
#:changed "6.4.0.14" @elem{Added the @DFlag{dry-run} flag.}]}
|
||||
#:changed "6.1.1.8" @elem{Added the @DFlag{pull} flag.}]}
|
||||
|
||||
|
||||
@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ...
|
||||
|
|
@ -727,7 +723,6 @@ the given @nonterm{pkg-source}s.
|
|||
|
||||
@item{@DFlag{pull} @nonterm{mode} --- Same as for @command-ref{install}}
|
||||
|
||||
@item{@DFlag{dry-run} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{batch} --- Same as for @command-ref{install}.}
|
||||
|
|
@ -740,8 +735,7 @@ the given @nonterm{pkg-source}s.
|
|||
when no arguments are provided.}
|
||||
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
|
||||
the @DFlag{deps} default to depend only on interactive mode.}
|
||||
#:changed "6.1.1.8" @elem{Added the @DFlag{skip-uninstalled} and @DFlag{pull} flags.}]
|
||||
#:changed "6.4.0.14" @elem{Added the @DFlag{dry-run} flag.}}
|
||||
#:changed "6.1.1.8" @elem{Added the @DFlag{skip-uninstalled} and @DFlag{pull} flags.}]}
|
||||
|
||||
@subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ...
|
||||
--- Attempts to remove the given packages. By default, if a package is the dependency
|
||||
|
|
@ -767,7 +761,6 @@ the given @nonterm{pkg}s.
|
|||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@DFlag{dry-run} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{batch} --- Same as for @command-ref{install}.}
|
||||
|
|
@ -775,8 +768,7 @@ the given @nonterm{pkg}s.
|
|||
]
|
||||
|
||||
@history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch} flag.}
|
||||
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag.}
|
||||
#:changed "6.4.0.14" @elem{Added the @DFlag{dry-run} flag.}]}
|
||||
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag.}]}
|
||||
|
||||
|
||||
@subcommand{@command/toc{new} @nonterm{pkg} ---
|
||||
|
|
@ -856,12 +848,10 @@ package is created.
|
|||
@item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{strict-doc-conflicts} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-cache} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{dry-run} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||
]
|
||||
|
||||
@history[#:changed "6.4.0.14" @elem{Added the @DFlag{dry-run} flag.}]}
|
||||
}
|
||||
|
||||
@subcommand{@command/toc{create} @nonterm{option} ... @nonterm{directory-or-package}
|
||||
--- Bundles a package into an archive. Bundling
|
||||
|
|
|
|||
|
|
@ -11,17 +11,11 @@ computation in this sense is @emph{not} atomic with respect to other
|
|||
@tech[#:doc reference.scrbl]{places}, but only to other @tech[#:doc
|
||||
reference.scrbl]{threads} within a place.
|
||||
|
||||
@elemtag["atomic-unsafe"]{Atomic mode is @bold{unsafe}}, because the
|
||||
Racket scheduler is not able to operate while execution is in atomic
|
||||
mode; the scheduler cannot switch threads or poll certain kinds of
|
||||
events, which can lead to deadlock or starvation of other threads.
|
||||
Beware that many operations can involve such synchronization, such as
|
||||
writing to an output port. Even if an output target is known to be
|
||||
free of synchronization, beware that values can have arbitrary
|
||||
printing procedures attached through @racket[prop:custom-write].
|
||||
Successful use of atomic mode requires a detailed knowledge of any
|
||||
implementation that might be reached during atomic mode to ensure that
|
||||
it terminates and does not involve synchronization.
|
||||
Atomic mode is unsafe, because the Racket scheduler is not able to
|
||||
operate while execution is in atomic mode; the scheduler cannot switch
|
||||
threads or poll certain kinds of events, which can lead to deadlock or
|
||||
starvation of other threads. Beware that many operations can involve
|
||||
such synchronization, such as writing to an output port.
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(start-atomic) void?]
|
||||
|
|
@ -57,9 +51,7 @@ Using @racket[call-as-atomic] is somewhat safer than using
|
|||
exiting atomic mode, and it wraps any call to the error value
|
||||
conversion handler with @racket[call-as-nonatomic]. The latter is safe
|
||||
for a particular atomic region, however, only if the region can be
|
||||
safely interrupted by a non-atomic exception construction.
|
||||
|
||||
See also the caveat that @elemref["atomic-unsafe"]{atomic mode is unsafe}.}
|
||||
safely interrupted by a non-atomic exception construction.}
|
||||
|
||||
|
||||
@deftogether[(
|
||||
|
|
@ -90,7 +82,11 @@ re-raised after exiting atomic mode. Any call to the current
|
|||
@tech[#:doc reference.scrbl]{error value conversion handler} is
|
||||
effectively wrapped with @racket[call-as-nonatomic].
|
||||
|
||||
See also the caveat that @elemref["atomic-unsafe"]{atomic mode is unsafe}.}
|
||||
Besides obvious paths to unknown expressions that may not be safe for
|
||||
atomic mode, beware of printing an arbitrary value in any way other
|
||||
than the error value conversion handler, because values can have
|
||||
arbitrary printing procedures attached through
|
||||
@racket[prop:custom-write].}
|
||||
|
||||
|
||||
@defproc[(call-as-nonatomic [thunk (-> any)]) any]{
|
||||
|
|
|
|||
|
|
@ -26,16 +26,11 @@ internal representation of @racket[vec].}
|
|||
Returns a pointer to an array of @racket[_double] values, which is the
|
||||
internal representation of @racket[flvec].}
|
||||
|
||||
@defproc*[([(saved-errno) exact-integer?]
|
||||
[(saved-errno [new-value exact-integer?]) void?])]{
|
||||
@defproc[(saved-errno) exact-integer?]{
|
||||
|
||||
Returns or sets the error code saved for the current Racket
|
||||
thread. The saved error code is set after a foreign call with a
|
||||
non-@racket[#f] @racket[#:save-errno] option (see @racket[_fun] and
|
||||
@racket[_cprocedure]), but it can also be set explicitly (for example,
|
||||
to create mock foreign functions for testing).
|
||||
|
||||
@history[#:changed "6.4.0.9"]{Added the one-argument variant.}}
|
||||
Returns the value most recently saved (in the current thread) after a
|
||||
foreign call with a non-@racket[#f] @racket[#:save-errno] option (see
|
||||
@racket[_fun] and @racket[_cprocedure]).}
|
||||
|
||||
@defproc[(lookup-errno [sym (or/c 'EINTR 'EEXIST 'EAGAIN)])
|
||||
exact-integer?]{
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ see @|InsideRacket|.
|
|||
ctype?)
|
||||
@#,elem{absent}]
|
||||
[cptr cpointer? @#,elem{absent}]
|
||||
[mode (one-of/c 'raw 'atomic 'nonatomic 'tagged
|
||||
[mode (one-of/c 'raw 'atomic 'nonatomic
|
||||
'atomic-interior 'interior
|
||||
'stubborn 'uncollectable 'eternal)
|
||||
@#,elem{absent}]
|
||||
|
|
@ -266,8 +266,6 @@ specification is required at minimum:
|
|||
what allocation function to use. It should be one of
|
||||
@indexed-racket['nonatomic] (uses @cpp{scheme_malloc} from
|
||||
Racket's C API), @indexed-racket['atomic]
|
||||
(@cpp{scheme_malloc_atomic}), @indexed-racket['tagged]
|
||||
(@cpp{scheme_malloc_tagged}), @indexed-racket['atomic]
|
||||
(@cpp{scheme_malloc_atomic}), @indexed-racket['stubborn]
|
||||
(@cpp{scheme_malloc_stubborn}), @indexed-racket['uncollectable]
|
||||
(@cpp{scheme_malloc_uncollectable}), @indexed-racket['eternal]
|
||||
|
|
@ -284,9 +282,7 @@ specification is required at minimum:
|
|||
|
||||
If no mode is specified, then @racket['nonatomic] allocation is used
|
||||
when the type is a @racket[_gcpointer]- or @racket[_scheme]-based
|
||||
type, and @racket['atomic] allocation is used otherwise.
|
||||
|
||||
@history[#:changed "6.4.0.10" @elem{Added the @racket['tagged] allocation mode.}]}
|
||||
type, and @racket['atomic] allocation is used otherwise.}
|
||||
|
||||
|
||||
@defproc[(free [cptr cpointer?]) void]{
|
||||
|
|
|
|||
|
|
@ -1055,7 +1055,7 @@ members.}
|
|||
|
||||
@defproc[(_list-struct [#:alignment alignment (or/c #f 1 2 4 8 16) #f]
|
||||
[#:malloc-mode malloc-mode
|
||||
(one-of/c 'raw 'atomic 'nonatomic 'tagged
|
||||
(one-of/c 'raw 'atomic 'nonatomic
|
||||
'atomic-interior 'interior
|
||||
'stubborn 'uncollectable 'eternal)
|
||||
'atomic]
|
||||
|
|
@ -1085,7 +1085,7 @@ below for a more efficient approach.
|
|||
#:define-unsafe)]
|
||||
#:contracts ([offset-expr exact-integer?]
|
||||
[alignment-expr (or/c #f 1 2 4 8 16)]
|
||||
[malloc-mode-expr (one-of/c 'raw 'atomic 'nonatomic 'tagged
|
||||
[malloc-mode-expr (one-of/c 'raw 'atomic 'nonatomic
|
||||
'atomic-interior 'interior
|
||||
'stubborn 'uncollectable 'eternal)]
|
||||
[prop-expr struct-type-property?])]{
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#lang scribble/doc
|
||||
@(require scribble/manual scribble/eval "utils.rkt"
|
||||
(for-label racket/base
|
||||
racket/contract))
|
||||
(for-label racket/contract))
|
||||
|
||||
@title[#:tag "contract-boundaries"]{Contracts and Boundaries}
|
||||
|
||||
|
|
|
|||
|
|
@ -404,13 +404,10 @@ the contract so that error messages become intelligible:
|
|||
@interaction[#:eval
|
||||
contract-eval
|
||||
(module improved-bank-server racket
|
||||
(provide
|
||||
(contract-out
|
||||
[deposit (-> (flat-named-contract
|
||||
'amount
|
||||
(λ (x)
|
||||
(and (number? x) (integer? x) (>= x 0))))
|
||||
any)]))
|
||||
(define (amount? x) (and (number? x) (integer? x) (>= x 0)))
|
||||
(define amount (flat-named-contract 'amount amount?))
|
||||
|
||||
(provide (contract-out [deposit (amount . -> . any)]))
|
||||
|
||||
(define total 0)
|
||||
(define (deposit a) (set! total (+ a total))))]
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ popular among Racketeers as well.
|
|||
name @tt{geiser}.}
|
||||
|
||||
@item{Emacs ships with a major mode for Scheme, @tt{scheme-mode},
|
||||
that while not as featureful as the above options, but works
|
||||
that while not as featureful as the above options, works
|
||||
reasonably well for editing Racket code. However, this mode
|
||||
does not provide support for Racket-specific forms.}
|
||||
|
||||
|
|
|
|||
|
|
@ -387,7 +387,7 @@ definition
|
|||
|
||||
At the same time, @racket[define-cbr] needs to define @racket[do-f]
|
||||
using the body of @racket[f], this second part is slightly more
|
||||
complex, so we defer most of it to a @racket[define-for-cbr] helper
|
||||
complex, so we defer most it to a @racket[define-for-cbr] helper
|
||||
module, which lets us write @racket[define-cbr] easily enough:
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -67,8 +67,13 @@ to the same binding:
|
|||
(free-identifier=? #'car #'car)
|
||||
(require (only-in racket/base [car also-car]))
|
||||
(free-identifier=? #'car #'also-car)
|
||||
(free-identifier=? #'car (let ([car 8])
|
||||
#'car))
|
||||
]
|
||||
|
||||
The last example above, in particular, illustrates how syntax objects
|
||||
preserve lexical-context information.
|
||||
|
||||
To see the lists, symbols, numbers, @|etc| within a syntax object, use
|
||||
@racket[syntax->datum]:
|
||||
|
||||
|
|
|
|||
|
|
@ -5,8 +5,6 @@
|
|||
|
||||
@title[#:tag "hash-reader"]{Reader Extensions}
|
||||
|
||||
@refdetails["parse-reader"]{reader extensions}
|
||||
|
||||
The @tech{reader} layer of the Racket language can be extended through
|
||||
the @racketmetafont{#reader} form. A reader extension is implemented
|
||||
as a module that is named after @racketmetafont{#reader}. The module
|
||||
|
|
|
|||
|
|
@ -11,8 +11,7 @@
|
|||
The Racket run-time system can be embedded into a larger program. The
|
||||
embedding process for Racket CGC or Racket 3m (see @secref[cgc-v-3m])
|
||||
is essentially the same, but the process for Racket 3m is most easily
|
||||
understood as a variant of the process for Racket CGC (even though
|
||||
Racket 3m is the standard variant of Racket).
|
||||
understood as a variant of the process for Racket CGC.
|
||||
|
||||
@section{CGC Embedding}
|
||||
|
||||
|
|
@ -182,7 +181,6 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
{
|
||||
Scheme_Object *curout;
|
||||
int i;
|
||||
Scheme_Thread *th;
|
||||
mz_jmp_buf * volatile save, fresh;
|
||||
|
||||
/* Declare embedded modules in "base.c": */
|
||||
|
|
@ -193,13 +191,11 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
curout = scheme_get_param(scheme_current_config(),
|
||||
MZCONFIG_OUTPUT_PORT);
|
||||
|
||||
th = scheme_get_current_thread();
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
save = th->error_buf;
|
||||
th->error_buf = &fresh;
|
||||
if (scheme_setjmp(*th->error_buf)) {
|
||||
th->error_buf = save;
|
||||
save = scheme_current_thread->error_buf;
|
||||
scheme_current_thread->error_buf = &fresh;
|
||||
if (scheme_setjmp(scheme_error_buf)) {
|
||||
scheme_current_thread->error_buf = save;
|
||||
return -1; /* There was an error */
|
||||
} else {
|
||||
Scheme_Object *v, *a[2];
|
||||
|
|
@ -210,7 +206,7 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
a[0] = scheme_intern_symbol("racket/base");
|
||||
a[1] = scheme_intern_symbol("read-eval-print-loop");
|
||||
scheme_apply(scheme_dynamic_require(2, a), 0, NULL);
|
||||
th->error_buf = save;
|
||||
scheme_current_thread->error_buf = save;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
|
@ -311,17 +307,15 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
Scheme_Object *curout = NULL, *v = NULL, *a[2] = {NULL, NULL};
|
||||
Scheme_Config *config = NULL;
|
||||
int i;
|
||||
Scheme_Thread *th = NULL;
|
||||
mz_jmp_buf * volatile save = NULL, fresh;
|
||||
|
||||
MZ_GC_DECL_REG(9);
|
||||
MZ_GC_DECL_REG(8);
|
||||
MZ_GC_VAR_IN_REG(0, e);
|
||||
MZ_GC_VAR_IN_REG(1, curout);
|
||||
MZ_GC_VAR_IN_REG(2, save);
|
||||
MZ_GC_VAR_IN_REG(3, config);
|
||||
MZ_GC_VAR_IN_REG(4, v);
|
||||
MZ_GC_VAR_IN_REG(5, th);
|
||||
MZ_GC_ARRAY_VAR_IN_REG(6, a, 2);
|
||||
MZ_GC_ARRAY_VAR_IN_REG(5, a, 2);
|
||||
|
||||
MZ_GC_REG();
|
||||
|
||||
|
|
@ -333,13 +327,11 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
config = scheme_current_config();
|
||||
curout = scheme_get_param(config, MZCONFIG_OUTPUT_PORT);
|
||||
|
||||
th = scheme_get_current_thread();
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
save = th->error_buf;
|
||||
th->error_buf = &fresh;
|
||||
if (scheme_setjmp(*th->error_buf)) {
|
||||
th->error_buf = save;
|
||||
save = scheme_current_thread->error_buf;
|
||||
scheme_current_thread->error_buf = &fresh;
|
||||
if (scheme_setjmp(scheme_error_buf)) {
|
||||
scheme_current_thread->error_buf = save;
|
||||
return -1; /* There was an error */
|
||||
} else {
|
||||
v = scheme_eval_string(argv[i], e);
|
||||
|
|
@ -351,7 +343,7 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
a[1] = scheme_intern_symbol("read-eval-print-loop");
|
||||
v = scheme_dynamic_require(2, a);
|
||||
scheme_apply(v, 0, NULL);
|
||||
th->error_buf = save;
|
||||
scheme_current_thread->error_buf = save;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -206,7 +206,7 @@ which case the @DFlag{xform} step should be skipped.
|
|||
|
||||
To create an extension that behaves as a module, return a symbol from
|
||||
@cpp{scheme_module_name}, and have @cpp{scheme_initialize} and
|
||||
@cpp{scheme_reload} declare a module using @cpp{scheme_primitive_module}.
|
||||
@cpp{scheme_rename} declare a module using @cpp{scheme_primitive_module}.
|
||||
|
||||
For example, the following extension implements a module named
|
||||
@racket[hello] that exports a binding @racket[greeting]:
|
||||
|
|
|
|||
|
|
@ -1130,49 +1130,6 @@ moved before it is fixed. With other implementations, an object might
|
|||
be moved after the fixup process, and the result is the location that
|
||||
the object will have after garbage collection finished.}
|
||||
|
||||
|
||||
@function[(void scheme_register_type_gc_shape [short type]
|
||||
[intptr_t* shape])]{
|
||||
|
||||
Like @cpp{GC_register_traversers}, but using a set of predefined
|
||||
functions that interpret @var{shape} to traverse a value. The
|
||||
@var{shape} array is a sequence of commands terminated with
|
||||
@cpp{SCHEME_GC_SHAPE_TERM}, where each command has a single argument.
|
||||
|
||||
Commands:
|
||||
|
||||
@itemlist[
|
||||
|
||||
@item{@tt{#define @cppdef{SCHEME_GC_SHAPE_TERM} 0} --- the terminator
|
||||
command, which has no argument.}
|
||||
|
||||
@item{@tt{#define @cppdef{SCHEME_GC_SHAPE_PTR_OFFSET} 1} ---
|
||||
specifies that a object tagged with @var{type} has a pointer
|
||||
to be made visible to the garbage collector, where the command
|
||||
argument is the offset from the beginning of the object.}
|
||||
|
||||
@item{@tt{#define @cppdef{SCHEME_GC_SHAPE_ADD_SIZE} 2} --- specifies
|
||||
the allocated size of an object tagged with @var{type},
|
||||
where the command argument is an amount to add to an
|
||||
accumulated size; currently, size information is not used, but
|
||||
it may be needed with future implementations of the garbage
|
||||
collector.}
|
||||
|
||||
]
|
||||
|
||||
To improve forward compatibility, any other command is assumed to take
|
||||
a single argument and is ignored.
|
||||
|
||||
A GC-shape registration is place-specific, even though
|
||||
@cpp{scheme_make_type} creates a type tag that spans places. If a
|
||||
traversal is already installed for @cpp{type} in the current place,
|
||||
the old traversal specification is replaced. The
|
||||
@cpp{scheme_register_type_gc_shape} function keeps its own copy of the
|
||||
array @var{shape}, so the array need not be retained.
|
||||
|
||||
@history[#:added "6.4.0.10"]}
|
||||
|
||||
|
||||
@function[(Scheme_Object* scheme_add_gc_callback [Scheme_Object* pre_desc]
|
||||
[Scheme_Object* post_desc])]{
|
||||
|
||||
|
|
|
|||
|
|
@ -364,12 +364,10 @@ any place.}
|
|||
[void* val])]{
|
||||
|
||||
Gets or sets a value in a process-global table (i.e., shared across
|
||||
multiple places, if any). If @var{val} is @cpp{NULL}, the current mapping
|
||||
for @var{key} is given. If @var{val} is not @cpp{NULL}, and no value has been
|
||||
installed for that @var{key}, then the value is installed and @cpp{NULL} is returned. If a
|
||||
value has already been installed, then no new value is installed and the old
|
||||
value is returned. The given @var{val} must not refer to garbage-collected
|
||||
memory.
|
||||
multiple places, if any). If @var{val} is NULL, the current mapping
|
||||
for @var{key} is given, otherwise @var{val} is installed as the value
|
||||
for @var{key} and @cpp{NULL} is returned. The given @var{val} must not
|
||||
refer to garbage-collected memory.
|
||||
|
||||
This function is intended for infrequent use with a small number of
|
||||
keys.}
|
||||
|
|
|
|||
|
|
@ -9,8 +9,7 @@ Racket thread; all other threads are created through calls to
|
|||
|
||||
Information about each internal Racket thread is kept in a
|
||||
@cppi{Scheme_Thread} structure. A pointer to the current thread's
|
||||
structure is available as @cppdef{scheme_current_thread} or
|
||||
from @cppi{scheme_get_current_thread}. A
|
||||
structure is available as @cppi{scheme_current_thread}. A
|
||||
@cpp{Scheme_Thread} structure includes the following fields:
|
||||
|
||||
@itemize[
|
||||
|
|
@ -379,12 +378,6 @@ The following function @cpp{mzsleep} is an appropriate
|
|||
|
||||
@section{Thread Functions}
|
||||
|
||||
@function[(Scheme_Thread* scheme_get_current_thread)]{
|
||||
|
||||
Returns the currently executing thread. The result is equivalent to
|
||||
@cppi{scheme_current_thread}, but the function form must be used in
|
||||
some embedding contexts.}
|
||||
|
||||
@function[(Scheme_Object* scheme_thread
|
||||
[Scheme_Object* thunk])]{
|
||||
|
||||
|
|
|
|||
|
|
@ -296,9 +296,6 @@ There are six global constants:
|
|||
|
||||
]
|
||||
|
||||
In some embedding contexts, the function forms
|
||||
@cppi{scheme_make_null}, etc., must be used, instead.
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@section[#:tag "im:strings"]{Strings}
|
||||
|
|
@ -328,31 +325,6 @@ For more fine-grained control over UTF-8 encoding, use the
|
|||
|
||||
@section{Value Functions}
|
||||
|
||||
@function[(Scheme_Object* scheme_make_null)]{
|
||||
|
||||
Returns @cppi{scheme_null}.
|
||||
}
|
||||
|
||||
@function[(Scheme_Object* scheme_make_eof)]{
|
||||
|
||||
Returns @cppi{scheme_eof}.
|
||||
}
|
||||
|
||||
@function[(Scheme_Object* scheme_make_true)]{
|
||||
|
||||
Returns @cppi{scheme_true}.
|
||||
}
|
||||
|
||||
@function[(Scheme_Object* scheme_make_false)]{
|
||||
|
||||
Returns @cppi{scheme_false}.
|
||||
}
|
||||
|
||||
@function[(Scheme_Object* scheme_make_void)]{
|
||||
|
||||
Returns @cppi{scheme_void}.
|
||||
}
|
||||
|
||||
@function[(Scheme_Object* scheme_make_char
|
||||
[mzchar ch])]{
|
||||
|
||||
|
|
|
|||
|
|
@ -24,31 +24,3 @@ Normally, @nonterm{dir} is a relative path, and files are found at run
|
|||
time in @nonterm{dir} relative to the executable, but a separate path
|
||||
(usually relative) for run time can be specified with
|
||||
@DFlag{runtime-access}.
|
||||
|
||||
|
||||
Typically, @exec{raco ctool --c-mods} is used with @DPFlag{lib} to
|
||||
specify a collection-based module path. For example,
|
||||
|
||||
@commandline{raco ctool --c-mods base.c ++lib racket/base}
|
||||
|
||||
generates a @filepath{base.c} whose @tt{declare_modules} function
|
||||
makes @racketmodname[racket/base] available for use via the
|
||||
@tt{scheme_namespace_require} or @tt{scheme_dynamic_require} functions
|
||||
within the embedding application.
|
||||
|
||||
When a module file is provided to @exec{raco ctool --c-mods}, then
|
||||
@tt{declare_modules} declares a module with the symbolic name of the
|
||||
module file. For example,
|
||||
|
||||
@commandline{raco ctool --c-mods base.c hello.rkt}
|
||||
|
||||
creates a @tt{declare_modules} that defines the module
|
||||
@racket['hello], which could be required into the current namespace
|
||||
with @racket[(namespace-require ''hello)] or similarly at the C level:
|
||||
|
||||
@verbatim[#:indent 2]{
|
||||
p = scheme_make_pair(scheme_intern_symbol("quote"),
|
||||
scheme_make_pair(scheme_intern_symbol("hello"),
|
||||
scheme_make_null()));
|
||||
scheme_namespace_require(p);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,11 +11,10 @@
|
|||
|
||||
@title[#:tag "exe"]{@exec{raco exe}: Creating Stand-Alone Executables}
|
||||
|
||||
@margin-note{To achieve a faster startup time, instead of trying
|
||||
@exec{raco exe}, use a smaller base language---such as
|
||||
@racketmodfont{#lang} @racketmodname[racket/base] instead of
|
||||
@racketmodfont{#lang} @racketmodname[racket]. Also, ensure that
|
||||
bytecode files are compiled by using @seclink["make"]{@exec{raco make}}.}
|
||||
@margin-note{Use a smaller base language to achieve a faster startup time such
|
||||
as @racketmodfont{#lang} @racketmodname[racket/base] instead of
|
||||
@racketmodfont{#lang} @racketmodname[racket] rather than relying on @exec{raco
|
||||
exe}.}
|
||||
|
||||
Compiled code produced by @exec{raco make} relies on Racket
|
||||
executables to provide run-time support to the compiled code. However,
|
||||
|
|
@ -89,11 +88,8 @@ The @exec{raco exe} command accepts the following command-line flags:
|
|||
|
||||
@item{@Flag{l} or @DFlag{launcher} --- create a @tech{launcher} (see
|
||||
@secref["launcher"]), instead of a stand-alone executable. Flags
|
||||
such as @DFlag{config-path}, @DFlag{collects-path}, and @DFlag{lib}
|
||||
have no effect on launchers. Beware that the default command-line
|
||||
flags to build into the launcher prevent access to packages that
|
||||
are installed in user scope; use @exec{--exf -U} to enable access
|
||||
to user-scope packages from the launcher.}
|
||||
such as @DFlag{config-path}, @DFlag{collects-path}, and
|
||||
@DFlag{lib} have no effect on launchers.}
|
||||
|
||||
@item{@DFlag{config-path} @nonterm{path} --- set @nonterm{path}
|
||||
within the executable as the path to the @tech{configuration
|
||||
|
|
@ -157,19 +153,19 @@ The @exec{raco exe} command accepts the following command-line flags:
|
|||
in the executable, even if it is not referenced by the main program,
|
||||
so that it is available via @racket[dynamic-require].}
|
||||
|
||||
@item{@DPFlag{exf} @nonterm{flag} --- provide the @nonterm{flag}
|
||||
@item{@DPFlag{exfl} @nonterm{flag} --- provide the @nonterm{flag}
|
||||
command-line argument on startup to the embedded @exec{racket} or
|
||||
@exec{gracket}.}
|
||||
|
||||
@item{@DFlag{exf} @nonterm{flag} --- remove @nonterm{flag} from the
|
||||
@item{@DFlag{exfl} @nonterm{flag} --- remove @nonterm{flag} from the
|
||||
command-line arguments to be provided on startup to the embedded
|
||||
@exec{racket} or @exec{gracket}.}
|
||||
|
||||
@item{@DFlag{exf-clear} --- remove all command-line arguments to be
|
||||
@item{@DFlag{exfl-clear} --- remove all command-line arguments to be
|
||||
provided on startup to the embedded @exec{racket} or
|
||||
@exec{gracket}.}
|
||||
|
||||
@item{@DFlag{exf-show} --- show (without changing) the command-line
|
||||
@item{@DFlag{exfl-show} --- show (without changing) the command-line
|
||||
arguments to be provided on startup to the embedded
|
||||
@exec{racket} or @exec{gracket}.}
|
||||
|
||||
|
|
|
|||
|
|
@ -8,8 +8,7 @@
|
|||
racket/file
|
||||
compiler/cm
|
||||
compiler/cm-accomplice
|
||||
setup/parallel-build
|
||||
compiler/compilation-path))
|
||||
setup/parallel-build))
|
||||
|
||||
|
||||
@(define cm-eval (make-base-eval))
|
||||
|
|
@ -391,29 +390,6 @@ A parameter whose value is called for each file that is loaded and
|
|||
@racket[#f], then the file is compiled as usual. The default is
|
||||
@racket[(lambda (x) #f)].}
|
||||
|
||||
|
||||
@defparam[current-path->mode path->mode
|
||||
(or/c #f (-> path? (and/c path? relative-path?)))
|
||||
#:value #f]{
|
||||
Used by @racket[make-compilation-manager-load/use-compiled-handler] and
|
||||
@racket[make-caching-managed-compile-zo] to override @racket[use-compiled-file-paths]
|
||||
for deciding where to write compiled @filepath{.zo} files. If it is @racket[#f],
|
||||
then the first element of @racket[use-compiled-file-paths] is used. If it isn't
|
||||
@racket[#f], then it is called with the original source file's location and its
|
||||
result is treated the same as if it had been the first element of
|
||||
@racket[use-compiled-file-paths].
|
||||
|
||||
Note that this parameter is not used by @racket[current-load/use-compiled]. So if
|
||||
the parameter causes @filepath{.zo} files to be placed in different directories, then
|
||||
the correct @filepath{.zo} file must still be communicated via @racket[use-compiled-file-paths],
|
||||
and one way to do that is to override @racket[current-load/use-compiled] to delete
|
||||
@filepath{.zo} files that would cause the wrong one to be chosen right before they are
|
||||
loaded.
|
||||
|
||||
@history[#:added "6.4.0.14"]
|
||||
}
|
||||
|
||||
|
||||
@defproc[(file-stamp-in-collection [p path?]) (or/c (cons/c number? promise?) #f)]{
|
||||
Calls @racket[file-stamp-in-paths] with @racket[p] and
|
||||
@racket[(current-library-collection-paths)].}
|
||||
|
|
@ -732,14 +708,14 @@ of @racket[modes] and @racket[roots].}
|
|||
[#:roots roots (non-empty-listof (or/c path-string? 'same)) (current-compiled-file-roots)])
|
||||
path?]{
|
||||
|
||||
The same as @racket[get-compilation-dir+name], but returning only the first result.}
|
||||
The same as @racket[get-compilation-dir+home], but returning only the first result.}
|
||||
|
||||
@defproc[(get-compilation-bytecode-file [path path-string?]
|
||||
[#:modes modes (non-empty-listof (and/c path-string? relative-path?)) (use-compiled-file-paths)]
|
||||
[#:roots roots (non-empty-listof (or/c path-string? 'same)) (current-compiled-file-roots)])
|
||||
path?]{
|
||||
|
||||
The same as @racket[get-compilation-dir+name], but combines the
|
||||
The same as @racket[get-compilation-dir+home], but combines the
|
||||
results and adds a @filepath{.zo} suffix to arrive at a bytecode file
|
||||
path.}
|
||||
|
||||
|
|
|
|||
|
|
@ -80,8 +80,8 @@ failed, and anything else to indicate it passed.}
|
|||
|
||||
Contracts in Racket are subdivided into three different categories:
|
||||
@;
|
||||
@itemlist[@item{@deftech{Flat @tech{contracts}} can be fully checked immediately for
|
||||
a given value. These kinds of @tech{contracts} are essentially
|
||||
@itemlist[@item{@deftech{Flat contract}s can be fully checked immediately for
|
||||
a given value. These kinds of contracts are essentially
|
||||
predicate functions. Using @racket[flat-contract-predicate],
|
||||
you can extract the predicate from an arbitrary flat contract; some
|
||||
flat contracts can be applied like functions, in which case
|
||||
|
|
@ -93,7 +93,7 @@ Contracts in Racket are subdivided into three different categories:
|
|||
cannot.
|
||||
|
||||
The function @racket[flat-contract?] recognizes a flat contract.}
|
||||
@item{@deftech{Chaperone @tech{contracts}} are not always immediately
|
||||
@item{@deftech{Chaperone contracts} are not always immediately
|
||||
checkable, but are guaranteed to not change any properties
|
||||
of any values that they check. That is, they may wrap
|
||||
a value in such a way that it signals contract violations
|
||||
|
|
@ -103,18 +103,18 @@ Contracts in Racket are subdivided into three different categories:
|
|||
that the value had before being wrapped by the contract
|
||||
are preserved by the contract wrapper.
|
||||
|
||||
All @tech{flat contracts} are also @tech{chaperone contracts} (but
|
||||
All flat contracts are also chaperone contracts (but
|
||||
not vice-versa).}
|
||||
@item{@deftech{Impersonator @tech{contracts}} do not provide any
|
||||
@item{@deftech{Impersonator contracts} do not provide any
|
||||
guarantees about values they check. Impersonator contracts
|
||||
may hide properties of values, or even make them completely
|
||||
opaque (e.g, @racket[new-∀/c]).
|
||||
|
||||
All @tech{contracts} are impersonator contracts.}]
|
||||
All contracts are impersonator contracts.}]
|
||||
|
||||
For more about this hierarchy, see the section ``@secref["chaperones"]''
|
||||
as well as a research paper @cite{Strickland12} on chaperones, impersonators,
|
||||
and how they can be used to implement contracts.
|
||||
For more about this hierarchy, see @tech{chaperones} and
|
||||
a research paper on chaperones, impersonators, and how they can be used to
|
||||
implement contracts @cite{Strickland12}.
|
||||
|
||||
@history[#:changed "6.1.1.8" @list{Changed @racket[+nan.0] and @racket[+nan.f] to
|
||||
be @racket[equal?]-based contracts.}]
|
||||
|
|
@ -130,7 +130,7 @@ and how they can be used to implement contracts.
|
|||
[flat-contract flat-contract?]
|
||||
[generator (or/c #f (-> contract (-> int? any))) #f])
|
||||
flat-contract?]{
|
||||
Produces a @tech{flat contract} like @racket[flat-contract], but with the name @racket[name].
|
||||
Produces a contract like @racket[flat-contract], but with the name @racket[name].
|
||||
|
||||
For example,
|
||||
@racketblock[(define/contract i
|
||||
|
|
@ -145,7 +145,7 @@ The generator argument adds a generator for the flat-named-contract. See
|
|||
|
||||
@defthing[any/c flat-contract?]{
|
||||
|
||||
A @tech{flat contract} that accepts any value.
|
||||
A flat contract that accepts any value.
|
||||
|
||||
When using this contract as the result portion of a function contract,
|
||||
consider using @racket[any] instead; using @racket[any] leads to
|
||||
|
|
@ -160,8 +160,8 @@ A @tech{flat contract} that accepts no values.}
|
|||
@defproc[(or/c [contract contract?] ...)
|
||||
contract?]{
|
||||
|
||||
Takes any number of @tech{contracts} and returns
|
||||
a @tech{contract} that accepts any value that any one of the contracts
|
||||
Takes any number of contracts and returns
|
||||
a contract that accepts any value that any one of the contracts
|
||||
accepts individually.
|
||||
|
||||
The @racket[or/c] result tests any value by applying the contracts in
|
||||
|
|
@ -202,7 +202,7 @@ returns a @racket[list-contract?].
|
|||
@defproc[(first-or/c [contract contract?] ...)
|
||||
contract?]{
|
||||
|
||||
Takes any number of @tech{contracts} and returns a @tech{contract} that
|
||||
Takes any number of contracts and returns a contract that
|
||||
accepts any value that any one of the contracts accepts
|
||||
individually.
|
||||
|
||||
|
|
@ -243,7 +243,7 @@ returns a @racket[list-contract?].
|
|||
|
||||
@defproc[(and/c [contract contract?] ...) contract?]{
|
||||
|
||||
Takes any number of @tech{contracts} and returns a @tech{contract} that
|
||||
Takes any number of contracts and returns a contract that
|
||||
accepts any value that satisfies all of the contracts simultaneously.
|
||||
|
||||
If all of the arguments are procedures or @tech{flat contracts},
|
||||
|
|
@ -255,19 +255,19 @@ the contracts in order, from left to right.}
|
|||
|
||||
@defproc[(not/c [flat-contract flat-contract?]) flat-contract?]{
|
||||
|
||||
Accepts a @tech{flat contract} or a predicate and returns a @tech{flat contract}
|
||||
Accepts a flat contract or a predicate and returns a flat contract
|
||||
that checks the inverse of the argument.}
|
||||
|
||||
|
||||
@defproc[(=/c [z real?]) flat-contract?]{
|
||||
|
||||
Returns a @tech{flat contract} that requires the input to be a number and
|
||||
Returns a flat contract that requires the input to be a number and
|
||||
@racket[=] to @racket[z].}
|
||||
|
||||
|
||||
@defproc[(</c [n real?]) flat-contract?]{
|
||||
|
||||
Returns a @tech{flat contract} that requires the input to be a number and
|
||||
Returns a flat contract that requires the input to be a number and
|
||||
@racket[<] than @racket[n].}
|
||||
|
||||
|
||||
|
|
@ -283,7 +283,7 @@ Like @racket[</c], but for @racket[<=].}
|
|||
Like @racket[</c], but for @racket[>=].}
|
||||
|
||||
@defproc[(between/c [n real?] [m real?])
|
||||
flat-contract?]{ Returns a @tech{flat contract} that requires the
|
||||
flat-contract?]{ Returns a flat contract that requires the
|
||||
input to be a real number between @racket[n] and @racket[m] or equal to
|
||||
one of them.}
|
||||
|
||||
|
|
@ -292,41 +292,41 @@ An alias for @racket[between/c].}
|
|||
|
||||
@defproc[(integer-in [j exact-integer?] [k exact-integer?]) flat-contract?]{
|
||||
|
||||
Returns a @tech{flat contract} that requires the input to be an exact integer
|
||||
Returns a flat contract that requires the input to be an exact integer
|
||||
between @racket[j] and @racket[k], inclusive.}
|
||||
|
||||
@defproc[(char-in [a char?] [b char?]) flat-contract?]{
|
||||
|
||||
Returns a @tech{flat contract} that requires the input to be a character whose
|
||||
Returns a flat contract that requires the input to be a character whose
|
||||
code point number is between the code point numbers of @racket[a] and
|
||||
@racket[b], inclusive.}
|
||||
|
||||
|
||||
@defthing[natural-number/c flat-contract?]{
|
||||
|
||||
A @tech{flat contract} that requires the input to be an exact non-negative integer.}
|
||||
A flat contract that requires the input to be an exact non-negative integer.}
|
||||
|
||||
|
||||
@defproc[(string-len/c [len real?]) flat-contract?]{
|
||||
|
||||
Returns a @tech{flat contract} that recognizes strings that have fewer than
|
||||
Returns a flat contract that recognizes strings that have fewer than
|
||||
@racket[len] characters.}
|
||||
|
||||
|
||||
@defthing[false/c flat-contract?]{
|
||||
|
||||
An alias for @racket[#f] for backwards compatibility.}
|
||||
An alias @racket[#f] for backwards compatibility.}
|
||||
|
||||
|
||||
@defthing[printable/c flat-contract?]{
|
||||
|
||||
A @tech{flat contract} that recognizes values that can be written out and
|
||||
A flat contract that recognizes values that can be written out and
|
||||
read back in with @racket[write] and @racket[read].}
|
||||
|
||||
|
||||
@defproc[(one-of/c [v any/c] ...+) flat-contract?]{
|
||||
|
||||
Accepts any number of atomic values and returns a @tech{flat contract} that
|
||||
Accepts any number of atomic values and returns a flat contract that
|
||||
recognizes those values, using @racket[eqv?] as the comparison
|
||||
predicate. For the purposes of @racket[one-of/c], atomic values are
|
||||
defined to be: @tech{characters}, @tech{symbols}, @tech{booleans},
|
||||
|
|
@ -341,7 +341,7 @@ it simply passes its arguments to @racket[or/c].
|
|||
|
||||
@defproc[(symbols [sym symbol?] ...+) flat-contract?]{
|
||||
|
||||
Accepts any number of symbols and returns a @tech{flat contract} that
|
||||
Accepts any number of symbols and returns a flat contract that
|
||||
recognizes those symbols.
|
||||
|
||||
This is a backwards compatibility constructor; it merely
|
||||
|
|
@ -352,22 +352,22 @@ passes its arguments to @racket[or/c].
|
|||
[#:immutable immutable (or/c #t #f 'dont-care) 'dont-care]
|
||||
[#:flat? flat? boolean? #f])
|
||||
contract?]{
|
||||
Returns a @tech{contract} that recognizes vectors. The elements of the vector must
|
||||
Returns a contract that recognizes vectors. The elements of the vector must
|
||||
match @racket[c].
|
||||
|
||||
If the @racket[flat?] argument is @racket[#t], then the resulting contract is
|
||||
a @tech{flat contract}, and the @racket[c] argument must also be a @tech{flat contract}. Such
|
||||
@tech{flat contracts} will be unsound if applied to mutable vectors, as they will not
|
||||
a flat contract, and the @racket[c] argument must also be a flat contract. Such
|
||||
flat contracts will be unsound if applied to mutable vectors, as they will not
|
||||
check future operations on the vector.
|
||||
|
||||
If the @racket[immutable] argument is @racket[#t] and the @racket[c] argument is
|
||||
a @tech{flat contract}, the result will be a @tech{flat contract}. If the @racket[c] argument
|
||||
is a @tech{chaperone contract}, then the result will be a @tech{chaperone contract}.
|
||||
a flat contract, the result will be a flat contract. If the @racket[c] argument
|
||||
is a chaperone contract, then the result will be a chaperone contract.
|
||||
|
||||
When a higher-order @racket[vectorof] contract is applied to a vector, the result
|
||||
is not @racket[eq?] to the input. The result will be a copy for immutable vectors
|
||||
and a @tech{chaperone} or @tech{impersonator} of the input for mutable vectors,
|
||||
unless the @racket[c] argument is a @tech{flat contract} and the vector is immutable,
|
||||
unless the @racket[c] argument is a flat contract and the vector is immutable,
|
||||
in which case the result is the original vector.
|
||||
|
||||
@history[#:changed "6.3.0.5" @list{Changed flat vector contracts to not copy
|
||||
|
|
@ -376,24 +376,24 @@ in which case the result is the original vector.
|
|||
|
||||
@defproc[(vector-immutableof [c contract?]) contract?]{
|
||||
|
||||
Returns the same @tech{contract} as @racket[(vectorof c #:immutable #t)]. This form exists for
|
||||
Returns the same contract as @racket[(vectorof c #:immutable #t)]. This form exists for
|
||||
backwards compatibility.}
|
||||
|
||||
@defproc[(vector/c [c contract?] ...
|
||||
[#:immutable immutable (or/c #t #f 'dont-care) 'dont-care]
|
||||
[#:flat? flat? boolean? #f])
|
||||
contract?]{
|
||||
Returns a @tech{contract} that recognizes vectors whose lengths match the number of
|
||||
Returns a contract that recognizes vectors whose lengths match the number of
|
||||
contracts given. Each element of the vector must match its corresponding contract.
|
||||
|
||||
If the @racket[flat?] argument is @racket[#t], then the resulting contract is
|
||||
a @tech{flat contract}, and the @racket[c] arguments must also be @tech{flat contracts}. Such
|
||||
@tech{flat contracts} will be unsound if applied to mutable vectors, as they will not
|
||||
a flat contract, and the @racket[c] arguments must also be flat contracts. Such
|
||||
flat contracts will be unsound if applied to mutable vectors, as they will not
|
||||
check future operations on the vector.
|
||||
|
||||
If the @racket[immutable] argument is @racket[#t] and the @racket[c] arguments are
|
||||
@tech{flat contracts}, the result will be a @tech{flat contract}. If the @racket[c] arguments
|
||||
are @tech{chaperone contracts}, then the result will be a @tech{chaperone contract}.
|
||||
flat contracts, the result will be a flat contract. If the @racket[c] arguments
|
||||
are chaperone contracts, then the result will be a chaperone contract.
|
||||
|
||||
When a higher-order @racket[vector/c] contract is applied to a vector, the result
|
||||
is not @racket[eq?] to the input. The result will be a copy for immutable vectors
|
||||
|
|
@ -415,13 +415,13 @@ Returns a contract that recognizes boxes. The content of the box must match @rac
|
|||
and mutations on mutable boxes must match @racket[in-c].
|
||||
|
||||
If the @racket[flat?] argument is @racket[#t], then the resulting contract is
|
||||
a @tech{flat contract}, and the @racket[out] argument must also be a @tech{flat contract}. Such
|
||||
@tech{flat contracts} will be unsound if applied to mutable boxes, as they will not check
|
||||
a flat contract, and the @racket[out] argument must also be a flat contract. Such
|
||||
flat contracts will be unsound if applied to mutable boxes, as they will not check
|
||||
future operations on the box.
|
||||
|
||||
If the @racket[immutable] argument is @racket[#t] and the @racket[c] argument is
|
||||
a @tech{flat contract}, the result will be a @tech{flat contract}. If the @racket[c] argument is
|
||||
a @tech{chaperone contract}, then the result will be a @tech{chaperone contract}.
|
||||
a flat contract, the result will be a flat contract. If the @racket[c] argument is
|
||||
a chaperone contract, then the result will be a chaperone contract.
|
||||
|
||||
When a higher-order @racket[box/c] contract is applied to a box, the result
|
||||
is not @racket[eq?] to the input. The result will be a copy for immutable boxes
|
||||
|
|
@ -469,14 +469,13 @@ a value, the result is not necessarily @racket[eq?] to the input.
|
|||
(list)))]
|
||||
}
|
||||
|
||||
@defproc[(list*of [ele-c contract?] [last-c contract? ele-c]) contract?]{
|
||||
@defproc[(list*of [c contract?]) contract?]{
|
||||
|
||||
Returns a contract that recognizes improper lists whose elements match
|
||||
the contract @racket[ele-c] and whose last position matches @racket[last-c].
|
||||
If an improper list is created with @racket[cons],
|
||||
then its @racket[car] position is expected to match @racket[ele-c] and
|
||||
its @racket[cdr] position is expected to be @racket[(list*of ele-c list-c)]. Otherwise,
|
||||
it is expected to match @racket[last-c]. Beware that when this contract is applied to
|
||||
the contract @racket[c]. If an improper list is created with @racket[cons],
|
||||
then its @racket[car] position is expected to match @racket[c] and
|
||||
its @racket[cdr] position is expected to be @racket[(list*of c)]. Otherwise,
|
||||
it is expected to match @racket[c]. Beware that when this contract is applied to
|
||||
a value, the result is not necessarily @racket[eq?] to the input.
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
|
|
@ -489,8 +488,7 @@ a value, the result is not necessarily @racket[eq?] to the input.
|
|||
(list*of number?)
|
||||
(list 1 2 3)))]
|
||||
|
||||
@history[#:added "6.1.1.1"
|
||||
#:changed "6.4.0.4" @list{Added the @racket[last-c] argument.}]
|
||||
@history[#:added "6.1.1.1"]
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -552,33 +550,10 @@ each element of the list must match the corresponding contract. Beware
|
|||
that when this contract is applied to a value, the result is not
|
||||
necessarily @racket[eq?] to the input.}
|
||||
|
||||
@defproc[(*list/c [prefix contract?] [suffix contract?] ...) list-contract?]{
|
||||
|
||||
Produces a contract for a list. The number of elements in the list
|
||||
must be at least as long as the number of @racket[suffix] contracts
|
||||
and the tail of the list must match those contracts, one for each
|
||||
element. The beginning portion of the list can be arbitrarily long,
|
||||
and each element must match @racket[prefix].
|
||||
|
||||
Beware that when this contract is applied to a value, the result is not
|
||||
necessarily @racket[eq?] to the input.
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
(define/contract a-list-of-numbers-ending-with-two-integers
|
||||
(*list/c number? integer? integer?)
|
||||
(list 1/2 4/5 +1i -11 322))
|
||||
|
||||
(eval:error
|
||||
(define/contract not-enough-integers-at-the-end
|
||||
(*list/c number? integer? integer? integer?)
|
||||
(list 1/2 4/5 1/2 321 322)))]
|
||||
|
||||
}
|
||||
|
||||
|
||||
@defproc[(syntax/c [c flat-contract?]) flat-contract?]{
|
||||
|
||||
Produces a @tech{flat contract} that recognizes syntax objects whose
|
||||
Produces a flat contract that recognizes syntax objects whose
|
||||
@racket[syntax-e] content matches @racket[c].}
|
||||
|
||||
|
||||
|
|
@ -587,11 +562,11 @@ Produces a contract that recognizes instances of the structure
|
|||
type named by @racket[struct-id], and whose field values match the
|
||||
contracts produced by the @racket[contract-expr]s.
|
||||
|
||||
Contracts for immutable fields must be either flat or @tech{chaperone contracts}.
|
||||
Contracts for immutable fields must be either flat or chaperone contracts.
|
||||
Contracts for mutable fields may be impersonator contracts.
|
||||
If all fields are immutable and the @racket[contract-expr]s evaluate
|
||||
to @tech{flat contracts}, a @tech{flat contract} is produced. If all the
|
||||
@racket[contract-expr]s are @tech{chaperone contracts}, a @tech{chaperone contract} is
|
||||
to flat contracts, a flat contract is produced. If all the
|
||||
@racket[contract-expr]s are chaperone contracts, a chaperone contract is
|
||||
produced. Otherwise, an impersonator contract is produced.
|
||||
}
|
||||
|
||||
|
|
@ -622,8 +597,8 @@ for the fields based on the values of the @racket[dep-field-name] fields (the
|
|||
@racket[dep-field-name] syntax is the same as the @racket[field-name] syntax).
|
||||
If the field is a dependent field and no @racket[contract-type] annotation
|
||||
appears, then it is assumed that the contract is
|
||||
a chaperone, but not always a @tech{flat contract} (and thus the entire @racket[struct/dc]
|
||||
contract is not a @tech{flat contract}).
|
||||
a chaperone, but not always a flat contract (and thus the entire @racket[struct/dc]
|
||||
contract is not a flat contract).
|
||||
If this is not the case, and the contract is
|
||||
always flat then the field must be annotated with
|
||||
the @racket[#:flat], or the field must be annotated with
|
||||
|
|
@ -651,11 +626,11 @@ If the @racket[#:inv] clause appears, then the invariant expression is
|
|||
evaluated (and must return a non-@racket[#f] value) when the contract
|
||||
is applied to a struct.
|
||||
|
||||
Contracts for immutable fields must be either flat or @tech{chaperone contracts}.
|
||||
Contracts for immutable fields must be either flat or chaperone contracts.
|
||||
Contracts for mutable fields may be impersonator contracts.
|
||||
If all fields are immutable and the @racket[contract-expr]s evaluate
|
||||
to @tech{flat contracts}, a @tech{flat contract} is produced. If all the
|
||||
@racket[contract-expr]s are @tech{chaperone contracts}, a @tech{chaperone contract} is
|
||||
to flat contracts, a flat contract is produced. If all the
|
||||
@racket[contract-expr]s are chaperone contracts, a chaperone contract is
|
||||
produced. Otherwise, an impersonator contract is produced.
|
||||
|
||||
As an example, the function @racket[bst/c] below
|
||||
|
|
@ -731,15 +706,15 @@ There are a number of technicalities that control how @racket[hash/c] contracts
|
|||
behave.
|
||||
@itemlist[@item{
|
||||
If the @racket[flat?] argument is @racket[#t], then the resulting contract is
|
||||
a @tech{flat contract}, and the @racket[key] and @racket[val] arguments must also be
|
||||
@tech{flat contracts}.
|
||||
a flat contract, and the @racket[key] and @racket[val] arguments must also be flat
|
||||
contracts.
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
(flat-contract? (hash/c integer? boolean?))
|
||||
(flat-contract? (hash/c integer? boolean? #:flat? #t))
|
||||
(eval:error (hash/c integer? (-> integer? integer?) #:flat? #t))]
|
||||
|
||||
Such @tech{flat contracts} will be unsound if applied to mutable hash tables,
|
||||
Such flat contracts will be unsound if applied to mutable hash tables,
|
||||
as they will not check future mutations to the hash table.
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
|
|
@ -823,8 +798,8 @@ for mutable hash tables.
|
|||
Produces a contract that recognizes @tech{channel}s that communicate
|
||||
values as specified by the @racket[val] argument.
|
||||
|
||||
If the @racket[val] argument is a @tech{chaperone contract}, then the resulting contract
|
||||
is a @tech{chaperone contract}. Otherwise, the resulting contract is an impersonator
|
||||
If the @racket[val] argument is a chaperone contract, then the resulting contract
|
||||
is a chaperone contract. Otherwise, the resulting contract is an impersonator
|
||||
contract. When a channel contract is applied to a channel, the resulting channel
|
||||
is not @racket[eq?] to the input.
|
||||
|
||||
|
|
@ -851,7 +826,7 @@ Each @racket[contract] will check the corresponding value passed to
|
|||
an @racket[abort-current-continuation] and handled by the handler of a
|
||||
call to @racket[call-with-continuation-prompt].
|
||||
|
||||
If all of the @racket[contract]s are @tech{chaperone contracts}, the resulting
|
||||
If all of the @racket[contract]s are chaperone contracts, the resulting
|
||||
contract will also be a @tech{chaperone} contract. Otherwise, the contract is
|
||||
an @tech{impersonator} contract.
|
||||
|
||||
|
|
@ -882,7 +857,7 @@ Takes a single contract and returns a contract that recognizes
|
|||
continuation marks and will check any mappings of marks to values
|
||||
or any accesses of the mark value.
|
||||
|
||||
If the argument @racket[contract] is a @tech{chaperone contract}, the resulting
|
||||
If the argument @racket[contract] is a chaperone contract, the resulting
|
||||
contract will also be a @tech{chaperone} contract. Otherwise, the contract is
|
||||
an @tech{impersonator} contract.
|
||||
|
||||
|
|
@ -907,7 +882,7 @@ Returns a contract that recognizes @tech{synchronizable event}s whose
|
|||
@racket[contract]s.
|
||||
|
||||
The resulting contract is always a @tech{chaperone} contract and its
|
||||
arguments must all be @tech{chaperone contracts}.
|
||||
arguments must all be chaperone contracts.
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
(define/contract my-evt
|
||||
|
|
@ -937,7 +912,7 @@ For example, the contract
|
|||
symbol?)
|
||||
]
|
||||
|
||||
is a @tech{flat contract} that checks for (a limited form of)
|
||||
is a flat contract that checks for (a limited form of)
|
||||
S-expressions. It says that a @racket[sexp] is either two
|
||||
@racket[sexp]s combined with @racket[cons], or a number, or a symbol.
|
||||
|
||||
|
|
@ -948,7 +923,7 @@ checking will not terminate.}
|
|||
@defform[(flat-murec-contract ([id flat-contract-expr ...] ...) body ...+)]{
|
||||
|
||||
A generalization of @racket[flat-rec-contract] for defining several
|
||||
mutually recursive @tech{flat contracts} simultaneously. Each @racket[id] is
|
||||
mutually recursive flat contracts simultaneously. Each @racket[id] is
|
||||
visible in the entire @racket[flat-murec-contract] form, and the
|
||||
result of the final @racket[body] is the result of the entire form.}
|
||||
|
||||
|
|
@ -971,38 +946,19 @@ Constructs a @tech{flat contract} from @racket[predicate]. A value
|
|||
satisfies the contract if the predicate returns a true value.
|
||||
|
||||
This function is a holdover from before predicates could be used
|
||||
directly as @tech{flat contracts}. It exists today for backwards compatibility.
|
||||
directly as flat contracts. It exists today for backwards compatibility.
|
||||
}
|
||||
|
||||
|
||||
@defproc[(flat-contract-predicate [v flat-contract?])
|
||||
(-> any/c any/c)]{
|
||||
|
||||
Extracts the predicate from a @tech{flat contract}.
|
||||
Extracts the predicate from a flat contract.
|
||||
|
||||
This function is a holdover from before @tech{flat contracts} could be used
|
||||
This function is a holdover from before flat contracts could be used
|
||||
directly as predicates. It exists today for backwards compatibility.
|
||||
}
|
||||
|
||||
@defproc[(suggest/c [c contract?]
|
||||
[field string?]
|
||||
[message string?]) contract?]{
|
||||
Returns a contract that behaves like @racket[c], except
|
||||
that it adds an extra line to the error message on a contract
|
||||
violation.
|
||||
|
||||
The @racket[field] and @racket[message] strings are added
|
||||
following the guidelines in
|
||||
@secref["err-msg-conventions"].
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
(define allow-calls? #f)
|
||||
(define/contract (f)
|
||||
(suggest/c (->* () #:pre allow-calls? any)
|
||||
"suggestion" "maybe you should set! allow-calls? to #t")
|
||||
5)
|
||||
(eval:error (f))]
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -1030,18 +986,13 @@ designed to match @racket[case-lambda] and
|
|||
without requiring that the domain have any particular shape
|
||||
(see below for an example use).
|
||||
|
||||
@(define lit-ellipsis (racket ...))
|
||||
|
||||
@defform*/subs[#:literals (any values)
|
||||
[(-> dom ... range)
|
||||
(-> dom ... ellipsis dom-expr ... range)]
|
||||
[(-> dom ... range)]
|
||||
([dom dom-expr (code:line keyword dom-expr)]
|
||||
[range range-expr (values range-expr ...) any]
|
||||
[ellipsis #,lit-ellipsis])]{
|
||||
[range range-expr (values range-expr ...) any])]{
|
||||
|
||||
Produces a contract for a function that accepts the argument
|
||||
specified by the @racket[dom-expr] contracts and returns
|
||||
either a fixed number of
|
||||
Produces a contract for a function that accepts a fixed
|
||||
number of arguments and returns either a fixed number of
|
||||
results or completely unspecified results (the latter when
|
||||
@racket[any] is specified).
|
||||
|
||||
|
|
@ -1049,13 +1000,6 @@ Each @racket[dom-expr] is a contract on an argument to a
|
|||
function, and each @racket[range-expr] is a contract on a
|
||||
result of the function.
|
||||
|
||||
If the domain contain @racket[...]
|
||||
then the function accepts as many arguments as the rest of
|
||||
the contracts in the domain portion specify, as well as
|
||||
arbitrarily many more that match the contract just before the
|
||||
@racket[...]. Otherwise, the contract accepts exactly the
|
||||
argument specified.
|
||||
|
||||
@margin-note{Using a @racket[->] between two whitespace-delimited
|
||||
@racketparenfont{.}s is the same as putting the @racket[->] right
|
||||
after the enclosing opening parenthesis. See
|
||||
|
|
@ -1063,7 +1007,9 @@ after the enclosing opening parenthesis. See
|
|||
information.}
|
||||
|
||||
For example,
|
||||
|
||||
@racketblock[(integer? boolean? . -> . integer?)]
|
||||
|
||||
produces a contract on functions of two arguments. The first argument
|
||||
must be an integer, and the second argument must be a boolean. The
|
||||
function must produce an integer.
|
||||
|
|
@ -1072,16 +1018,12 @@ A domain specification may include a keyword. If so, the function must
|
|||
accept corresponding (mandatory) keyword arguments, and the values for
|
||||
the keyword arguments must match the corresponding contracts. For
|
||||
example:
|
||||
|
||||
@racketblock[(integer? #:x boolean? . -> . integer?)]
|
||||
|
||||
is a contract on a function that accepts a by-position argument that
|
||||
is an integer and a @racket[#:x] argument that is a boolean.
|
||||
|
||||
As an example that uses an @racket[...], this contract:
|
||||
@racketblock[(integer? string? ... integer? . -> . any)]
|
||||
on a function insists that the first and last arguments to
|
||||
the function must be integers (and there must be at least
|
||||
two arguments) and any other arguments must be strings.
|
||||
|
||||
If @racket[any] is used as the last sub-form for @racket[->], no
|
||||
contract checking is performed on the result of the function, and
|
||||
thus any number of values is legal (even different numbers on different
|
||||
|
|
@ -1089,10 +1031,7 @@ invocations of the function).
|
|||
|
||||
If @racket[(values range-expr ...)] is used as the last sub-form of
|
||||
@racket[->], the function must produce a result for each contract, and
|
||||
each value must match its respective contract.
|
||||
|
||||
@history[#:changed "6.4.0.5" @list{Added support for ellipses}]
|
||||
}
|
||||
each value must match its respective contract.}
|
||||
|
||||
|
||||
@defform*/subs[#:literals (any values)
|
||||
|
|
@ -1206,9 +1145,9 @@ In other words, @racket[->i] expresses dependencies among arguments and results.
|
|||
|
||||
The optional first keyword argument to @racket[->i] indicates if the result
|
||||
contract will be a chaperone. If it is @racket[#:chaperone], all of the contract for the arguments
|
||||
and results must be @tech{chaperone contracts} and the result of @racket[->i] will be
|
||||
a @tech{chaperone contract}. If it is not present, then the result
|
||||
contract will not be a @tech{chaperone contract}.
|
||||
and results must be chaperone contracts and the result of @racket[->i] will be
|
||||
a chaperone contract. If it is not present, then the result
|
||||
contract will not be a chaperone contract.
|
||||
|
||||
The first sub-form of a @racket[->i] contract covers the mandatory and the
|
||||
second sub-form covers the optional arguments. Following that is an optional
|
||||
|
|
@ -2025,15 +1964,15 @@ accepted by the third argument to @racket[datum->syntax].
|
|||
flat-contract?]
|
||||
)]{
|
||||
|
||||
These functions build simple higher-order contracts, @tech{chaperone contracts}, and @tech{flat contracts},
|
||||
These functions build simple higher-order contracts, chaperone contracts, and flat contracts,
|
||||
respectively. They both take the same set of three optional arguments: a name,
|
||||
a first-order predicate, and a blame-tracking projection.
|
||||
|
||||
The @racket[name] argument is any value to be rendered using @racket[display] to
|
||||
describe the contract when a violation occurs. The default name for simple
|
||||
higher-order contracts is @racketresult[anonymous-contract], for
|
||||
@tech{chaperone contracts} is @racketresult[anonymous-chaperone-contract], and for
|
||||
@tech{flat contracts} is @racketresult[anonymous-flat-contract].
|
||||
higher-order contracts is @racketresult[anonymous-contract], for chaperone
|
||||
contracts is @racketresult[anonymous-chaperone-contract], and for flat
|
||||
contracts is @racketresult[anonymous-flat-contract].
|
||||
|
||||
The first-order predicate @racket[test] can be used to determine which values
|
||||
the contract applies to; this must be the set of values for which the
|
||||
|
|
@ -2073,14 +2012,14 @@ The projection arguments (@racket[late-neg-proj], @racket[proj], and
|
|||
In particular, if the test argument returns @racket[#f] for some value,
|
||||
then the projections must raise a blame error for that value.
|
||||
|
||||
Projections for @tech{chaperone contracts} must produce a value that passes
|
||||
Projections for chaperone contracts must produce a value that passes
|
||||
@racket[chaperone-of?] when compared with the original, uncontracted value.
|
||||
Projections for @tech{flat contracts} must fail precisely when the first-order test
|
||||
does, and must produce the input value unchanged otherwise. Applying a
|
||||
@tech{flat contract} may result in either an application of the predicate, or the
|
||||
Projections for flat contracts must fail precisely when the first-order test
|
||||
does, and must produce the input value unchanged otherwise. Applying a flat
|
||||
contract may result in either an application of the predicate, or the
|
||||
projection, or both; therefore, the two must be consistent. The existence of a
|
||||
separate projection only serves to provide more specific error messages. Most
|
||||
@tech{flat contracts} do not need to supply an explicit projection.
|
||||
flat contracts do not need to supply an explicit projection.
|
||||
|
||||
The @racket[stronger] argument is used to implement @racket[contract-stronger?]. The
|
||||
first argument is always the contract itself and the second argument is whatever
|
||||
|
|
@ -2151,23 +2090,23 @@ contracts. The error messages assume that the function named by
|
|||
|
||||
@defproc[(coerce-chaperone-contract [id symbol?] [x any/c]) chaperone-contract?]{
|
||||
Like @racket[coerce-contract], but requires the result
|
||||
to be a @tech{chaperone contract}, not an arbitrary contract.
|
||||
to be a chaperone contract, not an arbitrary contract.
|
||||
}
|
||||
|
||||
@defproc[(coerce-chaperone-contracts [id symbol?] [x (listof any/c)])
|
||||
(listof chaperone-contract?)]{
|
||||
Like @racket[coerce-contracts], but requires the results
|
||||
to be @tech{chaperone contracts}, not arbitrary contracts.
|
||||
to be chaperone contracts, not arbitrary contracts.
|
||||
}
|
||||
|
||||
@defproc[(coerce-flat-contract [id symbol?] [x any/c]) flat-contract?]{
|
||||
Like @racket[coerce-contract], but requires the result
|
||||
to be a @tech{flat contract}, not an arbitrary contract.
|
||||
to be a flat contract, not an arbitrary contract.
|
||||
}
|
||||
|
||||
@defproc[(coerce-flat-contracts [id symbol?] [x (listof any/c)]) (listof flat-contract?)]{
|
||||
Like @racket[coerce-contracts], but requires the results
|
||||
to be @tech{flat contracts}, not arbitrary contracts.
|
||||
to be flat contracts, not arbitrary contracts.
|
||||
}
|
||||
|
||||
@defproc[(coerce-contract/f [x any/c]) (or/c contract? #f)]{
|
||||
|
|
@ -2208,24 +2147,6 @@ contracts. The error messages assume that the function named by
|
|||
functions, the wrapping (and thus the checks) are skipped.
|
||||
}
|
||||
|
||||
@defform*[[(with-contract-continuation-mark blame body ...)
|
||||
(with-contract-continuation-mark blame+neg-party body ...)]]{
|
||||
Inserts a continuation mark that informs the contract profiler (see
|
||||
@other-doc['(lib "contract-profile/scribblings/contract-profile")
|
||||
#:indirect "contract profiling"])
|
||||
that contract checking is happening.
|
||||
For the costs from checking your new combinator to be included, you should wrap
|
||||
any deferred, higher-order checks with this form. First-order checks are
|
||||
recognized automatically and do not require this form.
|
||||
|
||||
If your combinator's projections operate on complete blame objects (i.e., no
|
||||
missing blame parties), the blame object should be the first argument to this
|
||||
form. Otherwise (e.g., in the case of @racket[_late-neg] projections), a pair
|
||||
of the blame object and the negative party should be used instead.
|
||||
|
||||
@history[#:added "6.4.0.4"]
|
||||
}
|
||||
|
||||
@subsection{Blame Objects}
|
||||
|
||||
@defproc[(blame? [x any/c]) boolean?]{
|
||||
|
|
@ -2425,12 +2346,12 @@ the message that indicates the violation.
|
|||
@para{
|
||||
The property @racket[prop:contract] allows arbitrary structures to act as
|
||||
contracts. The property @racket[prop:chaperone-contract] allows arbitrary
|
||||
structures to act as @tech{chaperone contracts}; @racket[prop:chaperone-contract]
|
||||
inherits @racket[prop:contract], so @tech{chaperone contract} structures may also act
|
||||
structures to act as chaperone contracts; @racket[prop:chaperone-contract]
|
||||
inherits @racket[prop:contract], so chaperone contract structures may also act
|
||||
as general contracts. The property @racket[prop:flat-contract] allows arbitrary structures
|
||||
to act as @tech{flat contracts}; @racket[prop:flat-contract] inherits both
|
||||
@racket[prop:chaperone-contract] and @racket[prop:procedure], so @tech{flat contract} structures
|
||||
may also act as @tech{chaperone contracts}, as general contracts, and as predicate procedures.
|
||||
to act as flat contracts; @racket[prop:flat-contract] inherits both
|
||||
@racket[prop:chaperone-contract] and @racket[prop:procedure], so flat contract structures
|
||||
may also act as chaperone contracts, as general contracts, and as predicate procedures.
|
||||
}
|
||||
|
||||
@deftogether[(
|
||||
|
|
@ -2438,7 +2359,7 @@ may also act as @tech{chaperone contracts}, as general contracts, and as predica
|
|||
@defthing[prop:chaperone-contract struct-type-property?]
|
||||
@defthing[prop:flat-contract struct-type-property?]
|
||||
)]{
|
||||
These properties declare structures to be contracts or @tech{flat contracts},
|
||||
These properties declare structures to be contracts or flat contracts,
|
||||
respectively. The value for @racket[prop:contract] must be a @tech{contract
|
||||
property} constructed by @racket[build-contract-property]; likewise, the value
|
||||
for @racket[prop:chaperone-contract] must be a @tech{chaperone contract property}
|
||||
|
|
@ -2683,7 +2604,7 @@ projection accessor must return a value that passes @racket[chaperone-of?] when
|
|||
compared with the original, uncontracted value.
|
||||
|
||||
A @deftech{flat contract property} specifies the behavior of a structure when
|
||||
used as a @tech{flat contract}. It is specified using
|
||||
used as a flat contract. It is specified using
|
||||
@racket[build-flat-contract-property], and accepts exactly the same set of
|
||||
arguments as @racket[build-contract-property]. The only difference is that the
|
||||
projection accessor is expected not to wrap its argument in a higher-order
|
||||
|
|
@ -2854,22 +2775,20 @@ higher-order contracts.
|
|||
|
||||
@defproc[(contract? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if its argument is a @tech{contract} (i.e., constructed
|
||||
Returns @racket[#t] if its argument is a contract (i.e., constructed
|
||||
with one of the combinators described in this section or a value that
|
||||
can be used as a contract) and @racket[#f] otherwise.}
|
||||
|
||||
@defproc[(chaperone-contract? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if its argument is a @tech{chaperone contract},
|
||||
i.e., one that guarantees that
|
||||
Returns @racket[#t] if its argument is a contract that guarantees that
|
||||
it returns a value which passes @racket[chaperone-of?] when compared to
|
||||
the original, uncontracted value.}
|
||||
|
||||
@defproc[(impersonator-contract? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if its argument is an @tech{impersonator contract},
|
||||
i.e., a @tech{contract} that is neither a @tech{chaperone contract}
|
||||
nor a @tech{flat contract}.}
|
||||
Returns @racket[#t] if its argument is a contract that is not a chaperone
|
||||
contract nor a flat contract.}
|
||||
|
||||
@defproc[(flat-contract? [v any/c]) boolean?]{
|
||||
|
||||
|
|
@ -2877,10 +2796,10 @@ Returns @racket[#t] when its argument is a contract that can be
|
|||
checked immediately (unlike, say, a function contract).
|
||||
|
||||
For example,
|
||||
@racket[flat-contract] constructs @tech{flat contracts} from predicates, and
|
||||
@racket[flat-contract] constructs flat contracts from predicates, and
|
||||
symbols, booleans, numbers, and other ordinary Racket values
|
||||
(that are defined as @tech{contracts}) are also
|
||||
@tech{flat contracts}.}
|
||||
flat contracts.}
|
||||
|
||||
@defproc[(list-contract? [v any/c]) boolean?]{
|
||||
Recognizes certain @racket[contract?] values that accept @racket[list?]s.
|
||||
|
|
@ -3009,8 +2928,7 @@ the name @racket[opt/c].
|
|||
@defform[(define-opt/c (id id ...) expr)]{
|
||||
|
||||
This defines a recursive contract and simultaneously
|
||||
optimizes it. As long as the defined function terminates,
|
||||
@racket[define-opt/c] behaves just as if
|
||||
optimizes it. Semantically, it behaves just as if
|
||||
the @racket[-opt/c] were not present, defining a function on
|
||||
contracts (except that the body expression must return a
|
||||
contract). But, it also optimizes that contract definition,
|
||||
|
|
@ -3033,15 +2951,7 @@ For example,
|
|||
defines the @racket[bst/c] contract that checks the binary
|
||||
search tree invariant. Removing the @racket[-opt/c] also
|
||||
makes a binary search tree contract, but one that is
|
||||
(approximately) 20 times slower.
|
||||
|
||||
Note that in some cases, a call to a function defined by
|
||||
@racket[define-opt/c] may terminate, even if the corresponding
|
||||
@racket[define]-based function would not terminate. This is a
|
||||
shortcoming in @racket[define-opt/c] that we hope to understand
|
||||
and fix at some point, but have no concrete plans currently.
|
||||
|
||||
}
|
||||
(approximately) 20 times slower.}
|
||||
|
||||
@defthing[contract-continuation-mark-key continuation-mark-key?]{
|
||||
Key used by continuation marks that are present during contract checking.
|
||||
|
|
@ -3064,8 +2974,8 @@ currently being checked.
|
|||
Produces a contract that acts like @racket[contract] but with the name
|
||||
@racket[name].
|
||||
|
||||
The resulting contract is a @tech{flat contract} if @racket[contract] is a
|
||||
@tech{flat contract}.
|
||||
The resulting contract is a flat contract if @racket[contract] is a
|
||||
flat contract.
|
||||
|
||||
@history[#:added "6.3"]
|
||||
}
|
||||
|
|
@ -3106,9 +3016,9 @@ currently being checked.
|
|||
Produces a contract that, when applied to a value, first tests the
|
||||
value with @racket[predicate]; if @racket[predicate] returns true, the
|
||||
@racket[then-contract] is applied; otherwise, the
|
||||
@racket[else-contract] is applied. The resulting contract is a
|
||||
@tech{flat contract} if both @racket[then-contract] and @racket[else-contract] are
|
||||
@tech{flat contracts}.
|
||||
@racket[else-contract] is applied. The resulting contract is a flat
|
||||
contract if both @racket[then-contract] and @racket[else-contract] are
|
||||
flat contracts.
|
||||
|
||||
For example, the following contract enforces that if a value is a
|
||||
procedure, it is a thunk; otherwise it can be any (non-procedure)
|
||||
|
|
@ -3117,7 +3027,7 @@ currently being checked.
|
|||
Note that the following contract is @bold{not} equivalent:
|
||||
@racketblock[(or/c (-> any) any/c) (code:comment "wrong!")]
|
||||
The last contract is the same as @racket[any/c] because
|
||||
@racket[or/c] tries @tech{flat contracts} before higher-order contracts.
|
||||
@racket[or/c] tries flat contracts before higher-order contracts.
|
||||
|
||||
@history[#:added "6.3"]
|
||||
}
|
||||
|
|
@ -3231,10 +3141,6 @@ it is called with @racket[#t] when there is no generator for @racket[ctc]
|
|||
and called with @racket[#f] when there is a generator, but the generator
|
||||
ended up returning @racket[contract-random-generate-fail].
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
(for/list ([i (in-range 10)])
|
||||
(contract-random-generate (or/c integer? #f)))]
|
||||
|
||||
@history[#:changed "6.1.1.5" @list{Allow @racket[fail] to accept a boolean.}]
|
||||
|
||||
}
|
||||
|
|
@ -3246,20 +3152,6 @@ ended up returning @racket[contract-random-generate-fail].
|
|||
contract and, for those that do, uses information about the contract's shape
|
||||
to poke and prod at the value. For example, if the value is function, it will
|
||||
use the contract to tell it what arguments to supply to the value.
|
||||
|
||||
@examples[#:eval (contract-eval) #:once
|
||||
(define/contract (returns-false x)
|
||||
(-> integer? integer?)
|
||||
(code:comment "does not obey its contract")
|
||||
#f)
|
||||
(eval:error (contract-exercise returns-false))
|
||||
|
||||
(define/contract (calls-its-argument-with-eleven f)
|
||||
(-> (-> integer? integer?) boolean?)
|
||||
(code:comment "f returns an integer, but")
|
||||
(code:comment "we're supposed to return a boolean")
|
||||
(f 11))
|
||||
(eval:error (contract-exercise calls-its-argument-with-eleven))]
|
||||
}
|
||||
|
||||
@defproc[(contract-random-generate/choose [c contract?] [fuel exact-nonnegative-integer?])
|
||||
|
|
|
|||
|
|
@ -233,11 +233,6 @@ supplied, then the @racket[struct] form is equivalent to
|
|||
(eval:error ellipse-width)
|
||||
]
|
||||
|
||||
@margin-note{
|
||||
Expressions supplied to @racket[#:auto-value] are evaluated once and shared
|
||||
between every instance of the structure type. In particular, updates to
|
||||
a mutable @racket[#:auto-value] affect all current and future instances.
|
||||
}
|
||||
If @racket[#:auto] is supplied as a @racket[field-option], then the
|
||||
@tech{constructor} procedure for the structure type does not accept an
|
||||
argument corresponding to the field. Instead, the structure type's
|
||||
|
|
|
|||
|
|
@ -300,8 +300,7 @@ renamed successfully, the @exnraise[exn:fail:filesystem].
|
|||
This procedure can be used to move a file/directory to a different
|
||||
directory (on the same filesystem) as well as rename a file/directory within
|
||||
a directory. Unless @racket[exists-ok?] is provided as a true value,
|
||||
@racket[new] cannot refer to an existing file or directory, but the
|
||||
check is not atomic with the rename operation on Unix and Mac OS X. Even if
|
||||
@racket[new] cannot refer to an existing file or directory. Even if
|
||||
@racket[exists-ok?] is true, @racket[new] cannot refer to an existing
|
||||
file when @racket[old] is a directory, and vice versa.
|
||||
|
||||
|
|
|
|||
|
|
@ -27,7 +27,6 @@ shorter than @racket[format] (with format string),
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? ""]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
@ -69,8 +68,6 @@ If @racket[_s] is longer than @racket[max-width] characters, it is
|
|||
truncated and the end of the string is replaced with
|
||||
@racket[limit-marker]. If @racket[limit-marker] is longer than
|
||||
@racket[max-width], an exception is raised.
|
||||
If @racket[limit-prefix?] is @racket[#t], the beginning of the string
|
||||
is truncated instead of the end.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(~a "abcde" #:max-width 5)
|
||||
|
|
@ -79,7 +76,6 @@ is truncated instead of the end.
|
|||
(~a "abcde" #:max-width 4 #:limit-marker "...")
|
||||
(~a "The quick brown fox" #:max-width 15 #:limit-marker "")
|
||||
(~a "The quick brown fox" #:max-width 15 #:limit-marker "...")
|
||||
(~a "The quick brown fox" #:max-width 15 #:limit-marker "..." #:limit-prefix? #f)
|
||||
]
|
||||
|
||||
If @racket[_s] is shorter than @racket[min-width], it is padded to at
|
||||
|
|
@ -124,7 +120,6 @@ simultaneously, ensuring that the resulting string is exactly
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? "..."]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
@ -159,7 +154,6 @@ Use @racket[~v] to produce text that talks about Racket values.
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? "..."]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
@ -187,7 +181,6 @@ marker is @racket["..."].
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? "..."]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
@ -413,7 +406,6 @@ the resulting string is appended to the significand:
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? ""]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
@ -425,7 +417,6 @@ the resulting string is appended to the significand:
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? "..."]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
@ -437,7 +428,6 @@ the resulting string is appended to the significand:
|
|||
[#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
|
||||
[#:min-width min-width exact-nonnegative-integer? (or width 0)]
|
||||
[#:limit-marker limit-marker string? "..."]
|
||||
[#:limit-prefix? limit-prefix? boolean? #f]
|
||||
[#:align align (or/c 'left 'center 'right) 'left]
|
||||
[#:pad-string pad-string non-empty-string? " "]
|
||||
[#:left-pad-string left-pad-string non-empty-string? pad-string]
|
||||
|
|
|
|||
|
|
@ -485,26 +485,6 @@ Returns the value for the element in @racket[hash] at index
|
|||
@racket[pos]. If @racket[pos] is not a valid index for
|
||||
@racket[hash], the @exnraise[exn:fail:contract].}
|
||||
|
||||
@defproc[(hash-iterate-pair [hash hash?]
|
||||
[pos exact-nonnegative-integer?])
|
||||
(cons any any)]{
|
||||
|
||||
Returns a pair containing the key and value for the element
|
||||
in @racket[hash] at index
|
||||
@racket[pos]. If @racket[pos] is not a valid index for
|
||||
@racket[hash], the @exnraise[exn:fail:contract].}
|
||||
|
||||
@history[#:added "6.4.0.5"]
|
||||
|
||||
@defproc[(hash-iterate-key+value [hash hash?]
|
||||
[pos exact-nonnegative-integer?])
|
||||
(values any any)]{
|
||||
|
||||
Returns the key and value for the element in @racket[hash] at index
|
||||
@racket[pos]. If @racket[pos] is not a valid index for
|
||||
@racket[hash], the @exnraise[exn:fail:contract].}
|
||||
|
||||
@history[#:added "6.4.0.5"]
|
||||
|
||||
@defproc[(hash-copy [hash hash?])
|
||||
(and/c hash? (not/c immutable?))]{
|
||||
|
|
@ -532,16 +512,7 @@ the returned number is the same.}
|
|||
Returns a @tech{fixnum}; for any two calls with @racket[equal?] values,
|
||||
the returned number is the same. A hash code is computed even when
|
||||
@racket[v] contains a cycle through pairs, vectors, boxes, and/or
|
||||
inspectable structure fields. See also @racket[gen:equal+hash].
|
||||
|
||||
For any @racket[v] that could be produced by @racket[read], if
|
||||
@racket[v2] is produced by @racket[read] for the same input
|
||||
characters, the @racket[(equal-hash-code v)] is the same as
|
||||
@racket[(equal-hash-code v2)] --- even if @racket[v] and @racket[v2]
|
||||
do not exist at the same time (and therefore could not be compared by
|
||||
calling @racket[equal?]).
|
||||
|
||||
@history[#:changed "6.4.0.12" @elem{Strengthened guarantee for @racket[read]able values.}]}
|
||||
inspectable structure fields. See also @racket[gen:equal+hash].}
|
||||
|
||||
|
||||
@defproc[(equal-secondary-hash-code [v any/c]) fixnum?]{
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ Returns a @tech{resolved module path} that encapsulates @racket[path],
|
|||
where a list @racket[path] corresponds to a @tech{submodule} path.
|
||||
If @racket[path] is a path or starts with a path, the path normally should be
|
||||
@tech{cleanse}d (see @racket[cleanse-path]) and simplified (see
|
||||
@racket[simplify-path], including consulting the file system).
|
||||
@racket[simplify-path]).
|
||||
|
||||
A @tech{resolved module path} is interned. That is, if two
|
||||
@tech{resolved module path} values encapsulate paths that are
|
||||
|
|
|
|||
|
|
@ -437,7 +437,7 @@ Coerces @racket[q] to an exact number, finds the numerator of the
|
|||
|
||||
@defproc[(denominator [q rational?]) integer?]{
|
||||
|
||||
Coerces @racket[q] to an exact number, finds the denominator of the
|
||||
Coerces @racket[q] to an exact number, finds the numerator of the
|
||||
number expressed in its simplest fractional form, and returns this
|
||||
number coerced to the exactness of @racket[q].
|
||||
|
||||
|
|
|
|||
|
|
@ -534,10 +534,6 @@ either order), then the elements preserve their relative order from
|
|||
@racket[sort] with a strict comparison functions (e.g., @racket[<] or
|
||||
@racket[string<?]; not @racket[<=] or @racket[string<=?]).
|
||||
|
||||
@margin-note{Because of the peculiar fact that the IEEE-754 number system
|
||||
specifies that +nan.0 is neither greater nor less than nor equal to any other
|
||||
number, sorting lists containing this value may produce a surprising result.}
|
||||
|
||||
The @racket[#:key] argument @racket[extract-key] is used to extract a
|
||||
key value for comparison from each list element. That is, the full
|
||||
comparison procedure is essentially
|
||||
|
|
|
|||
|
|
@ -4,10 +4,10 @@
|
|||
@title[#:tag "port-ops"]{Managing Ports}
|
||||
|
||||
@defproc[(input-port? [v any/c]) boolean?]{
|
||||
Returns @racket[#t] if @racket[v] is an @tech{input port}, @racket[#f] otherwise.}
|
||||
Returns @racket[#t] if @racket[v] is an input port, @racket[#f] otherwise.}
|
||||
|
||||
@defproc[(output-port? [v any/c]) boolean?]{
|
||||
Returns @racket[#t] if @racket[v] is an @tech{output port}, @racket[#f] otherwise.}
|
||||
Returns @racket[#t] if @racket[v] is an output port, @racket[#f] otherwise.}
|
||||
|
||||
@defproc[(port? [v any/c]) boolean?]{
|
||||
Returns @racket[#t] if either @racket[(input-port? v)] or
|
||||
|
|
|
|||
|
|
@ -158,8 +158,8 @@ each element in the sequence.
|
|||
(sequence? "word")
|
||||
(sequence? #\x)]}
|
||||
|
||||
@defproc*[([(in-range [end real?]) stream?]
|
||||
[(in-range [start real?] [end real?] [step real? 1]) stream?])]{
|
||||
@defproc*[([(in-range [end number?]) stream?]
|
||||
[(in-range [start number?] [end number?] [step number? 1]) stream?])]{
|
||||
Returns a sequence (that is also a @tech{stream}) whose elements are
|
||||
numbers. The single-argument case @racket[(in-range end)] is
|
||||
equivalent to @racket[(in-range 0 end 1)]. The first number in the
|
||||
|
|
@ -232,21 +232,9 @@ each element in the sequence.
|
|||
greater or equal to @racket[end] if @racket[step] is non-negative,
|
||||
or less or equal to @racket[end] if @racket[step] is negative.
|
||||
|
||||
If @racket[start] is not a valid index, then the
|
||||
@exnraise[exn:fail:contract], except when @racket[start], @racket[stop], and
|
||||
@racket[(vector-length vec)] are equal, in which case the result is an
|
||||
empty sequence.
|
||||
|
||||
@examples[#:eval sequence-evaluator
|
||||
(for ([x (in-vector (vector 1) 1)]) x)
|
||||
(eval:error (for ([x (in-vector (vector 1) 2)]) x))
|
||||
(for ([x (in-vector (vector) 0 0)]) x)
|
||||
(for ([x (in-vector (vector 1) 1 1)]) x)]
|
||||
|
||||
If @racket[stop] is not in [-1, @racket[(vector-length vec)]],
|
||||
then the @exnraise[exn:fail:contract].
|
||||
|
||||
If @racket[start] is less than
|
||||
If @racket[start] is not a valid index, or @racket[stop] is not in
|
||||
[-1, @racket[(vector-length vec)]] then the
|
||||
@exnraise[exn:fail:contract]. If @racket[start] is less than
|
||||
@racket[stop] and @racket[step] is negative, then the
|
||||
@exnraise[exn:fail:contract:mismatch]. Similarly, if @racket[start]
|
||||
is more than @racket[stop] and @racket[step] is positive, then the
|
||||
|
|
@ -378,53 +366,6 @@ each element in the sequence.
|
|||
(printf "key and value: ~a\n" key+value))]
|
||||
}
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(in-mutable-hash
|
||||
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
|
||||
sequence?]
|
||||
@defproc[(in-mutable-hash-keys
|
||||
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
|
||||
sequence?]
|
||||
@defproc[(in-mutable-hash-values
|
||||
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
|
||||
sequence?]
|
||||
@defproc[(in-mutable-hash-pairs
|
||||
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
|
||||
sequence?]
|
||||
@defproc[(in-immutable-hash
|
||||
[hash (and/c hash? immutable?)])
|
||||
sequence?]
|
||||
@defproc[(in-immutable-hash-keys
|
||||
[hash (and/c hash? immutable?)])
|
||||
sequence?]
|
||||
@defproc[(in-immutable-hash-values
|
||||
[hash (and/c hash? immutable?)])
|
||||
sequence?]
|
||||
@defproc[(in-immutable-hash-pairs
|
||||
[hash (and/c hash? immutable?)])
|
||||
sequence?]
|
||||
@defproc[(in-weak-hash
|
||||
[hash (and/c hash? hash-weak?)])
|
||||
sequence?]
|
||||
@defproc[(in-weak-hash-keys
|
||||
[hash (and/c hash? hash-weak?)])
|
||||
sequence?]
|
||||
@defproc[(in-weak-hash-values
|
||||
[hash (and/c hash? hash-weak?)])
|
||||
sequence?]
|
||||
@defproc[(in-weak-hash-pairs
|
||||
[hash (and/c hash? hash-weak?)])
|
||||
sequence?]
|
||||
)]{
|
||||
Sequence constructors for specific kinds of hash tables.
|
||||
|
||||
These may be more performant than the analogous @racket[in-hash]
|
||||
forms. However, they may consume more space to help with iteration.
|
||||
|
||||
@history[#:added "6.4.0.6"]
|
||||
}
|
||||
|
||||
|
||||
@defproc[(in-directory [dir (or/c #f path-string?) #f]
|
||||
[use-dir? ((and/c path? complete-path?) . -> . any/c)
|
||||
(lambda (dir-path) #t)])
|
||||
|
|
@ -1077,26 +1018,6 @@ stream, but plain lists can be used as streams, and functions such as
|
|||
new stream is constructed lazily.
|
||||
}
|
||||
|
||||
@deftogether[(@defform[(for/stream (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/stream (for-clause ...) body-or-break ... body)])]{
|
||||
Iterates like @racket[for/list] and @racket[for*/list], respectively, but the
|
||||
results are lazily collected into a @tech{stream} instead of a list.
|
||||
|
||||
Unlike most @racket[for] forms, these forms are evaluated lazily, so each
|
||||
@racket[body] will not be evaluated until the resulting stream is forced. This
|
||||
allows @racket[for/stream] and @racket[for*/stream] to iterate over infinite
|
||||
sequences, unlike their finite counterparts.
|
||||
|
||||
@examples[#:eval sequence-evaluator
|
||||
(for/stream ([i '(1 2 3)]) (* i i))
|
||||
(stream->list (for/stream ([i '(1 2 3)]) (* i i)))
|
||||
(stream-ref (for/stream ([i '(1 2 3)]) (displayln i) (* i i)) 1)
|
||||
(stream-ref (for/stream ([i (in-naturals)]) (* i i)) 25)
|
||||
]
|
||||
|
||||
@history[#:added "6.3.0.9"]
|
||||
}
|
||||
|
||||
@defthing[gen:stream any/c]{
|
||||
Associates three methods to a structure type to implement the
|
||||
@tech{generic interface} (see @secref["struct-generics"]) for
|
||||
|
|
|
|||
|
|
@ -153,24 +153,6 @@ Analogous to @racket[for/list] and @racket[for*/list], but to
|
|||
construct a @tech{hash set} instead of a list.
|
||||
}
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(in-immutable-set [st set?]) sequence?]
|
||||
@defproc[(in-mutable-set [st set-mutable?]) sequence?]
|
||||
@defproc[(in-weak-set [st set-weak?]) sequence?]
|
||||
)]{
|
||||
|
||||
Explicitly converts a specific kind of @tech{hash set} to a sequence for
|
||||
use with @racket[for] forms.
|
||||
|
||||
As with @racket[in-list] and some other sequence constructors,
|
||||
@racket[in-immutable-set] is more performant when it appears directly in a
|
||||
@racket[for] clause.
|
||||
|
||||
These sequence constructors are compatible with
|
||||
@secref["Custom_Hash_Sets" #:doc '(lib "scribblings/reference/reference.scrbl")].
|
||||
|
||||
}
|
||||
|
||||
@section{Set Predicates and Contracts}
|
||||
|
||||
@defproc[(generic-set? [v any/c]) boolean?]{
|
||||
|
|
|
|||
|
|
@ -501,9 +501,8 @@ but with syntax errors potentially phrased in terms of
|
|||
|
||||
The @racket[...] transformer binding prohibits @racket[...] from
|
||||
being used as an expression. This binding is useful only in syntax
|
||||
patterns and templates (or other unrelated expression forms
|
||||
that treat it specially like @racket[->]), where it indicates repetitions
|
||||
of a pattern or template. See @racket[syntax-case] and @racket[syntax].}
|
||||
patterns and templates, where it indicates repetitions of a pattern or
|
||||
template. See @racket[syntax-case] and @racket[syntax].}
|
||||
|
||||
@defidform[_]{
|
||||
|
||||
|
|
|
|||
|
|
@ -5,12 +5,12 @@
|
|||
|
||||
Every syntax object has an associated @deftech{syntax property} list,
|
||||
which can be queried or extended with
|
||||
@racket[syntax-property]. A property is set as @tech{preserved} or not;
|
||||
a preserved property is maintained for a syntax object in a compiled form that is
|
||||
marshaled to a byte string or @filepath{.zo} file, and other properties
|
||||
are discarded when marshaling.
|
||||
@racket[syntax-property]. Properties are not preserved for a
|
||||
syntax object in a compiled form that is
|
||||
marshaled to a byte string or @filepath{.zo} file, except for a @racket['paren-shape]
|
||||
property value of @racket[#\[] or @racket[#\{].
|
||||
|
||||
In @racket[read-syntax], the reader attaches a preserved @racket['paren-shape]
|
||||
In @racket[read-syntax], the reader attaches a @racket['paren-shape]
|
||||
property to any pair or vector syntax object generated from parsing a
|
||||
pair @litchar{[} and @litchar{]} or @litchar["{"] and
|
||||
@litchar["}"]; the property value is @racket[#\[] in the former case,
|
||||
|
|
@ -23,8 +23,7 @@ transformer may have associated properties. The two sets of properties
|
|||
are merged by the syntax expander: each property in the original and
|
||||
not present in the result is copied to the result, and the values of
|
||||
properties present in both are combined with @racket[cons] (result
|
||||
value first, original value second) and the @racket[cons]ed value is
|
||||
@tech{preserved} if either of the values were preserved.
|
||||
value first, original value second).
|
||||
|
||||
Before performing the merge, however, the syntax expander
|
||||
automatically adds a property to the original syntax object using the
|
||||
|
|
@ -34,12 +33,11 @@ before the merge, the identifier that triggered the macro expansion
|
|||
(as syntax) is @racket[cons]ed onto the @racket['origin]
|
||||
property so far. The @racket['origin] property thus records (in
|
||||
reverse order) the sequence of macro expansions that produced an
|
||||
expanded expression. Usually, the @racket['origin] value is a
|
||||
list of identifiers. However, a transformer might return
|
||||
expanded expression. Usually, the @racket['origin] value is an
|
||||
immutable list of identifiers. However, a transformer might return
|
||||
syntax that has already been expanded, in which case an
|
||||
@racket['origin] list can contain other lists after a merge. The
|
||||
@racket[syntax-track-origin] procedure implements this tracking.
|
||||
The @racket['origin] property is added as non-@tech{preserved}.
|
||||
|
||||
Besides @racket['origin] tracking for general macro expansion,
|
||||
Racket adds properties to expanded syntax (often using
|
||||
|
|
@ -106,35 +104,17 @@ information on properties and byte codes.
|
|||
|
||||
@;------------------------------------------------------------------------
|
||||
|
||||
@defproc*[([(syntax-property [stx syntax?]
|
||||
[key (if preserved? (and/c symbol? symbol-interned?) any/c)]
|
||||
[v any/c]
|
||||
[preserved? any/c (eq? key 'paren-shape)])
|
||||
syntax?]
|
||||
@defproc*[([(syntax-property [stx syntax?] [key any/c] [v any/c]) syntax?]
|
||||
[(syntax-property [stx syntax?] [key any/c]) any])]{
|
||||
|
||||
The three- or four-argument form extends @racket[stx] by associating
|
||||
an arbitrary property value @racket[v] with the key @racket[key]; the
|
||||
The three-argument form extends @racket[stx] by associating an
|
||||
arbitrary property value @racket[v] with the key @racket[key]; the
|
||||
result is a new syntax object with the association (while @racket[stx]
|
||||
itself is unchanged). The property is added as @tech{preserved} if
|
||||
@racket[preserved?] is true, in which case @racket[key] must be an
|
||||
@tech{interned} symbol, and @racket[v] should be a value can itself
|
||||
be saved in marshaled bytecode.
|
||||
itself is unchanged).
|
||||
|
||||
The two-argument form returns an arbitrary property value associated
|
||||
to @racket[stx] with the key @racket[key], or @racket[#f] if no value
|
||||
is associated to @racket[stx] for @racket[key].
|
||||
|
||||
@history[#:changed "6.4.0.14" @elem{Added the @racket[preserved?] argument.}]}
|
||||
|
||||
|
||||
@defproc[(syntax-property-preserved? [stx syntax?] [key (and/c symbol? symbol-interned?)])
|
||||
boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[stx] has a @tech{preserved} property
|
||||
value for @racket[key], @racket[#f] otherwise.
|
||||
|
||||
@history[#:added "6.4.0.14"]}
|
||||
is associated to @racket[stx] for @racket[key].}
|
||||
|
||||
|
||||
@defproc[(syntax-property-symbol-keys [stx syntax?]) list?]{
|
||||
|
|
|
|||
|
|
@ -695,7 +695,7 @@ enclosing module body or top-level sequence.
|
|||
|
||||
@transform-time[] If the current expression being transformed is not
|
||||
within a @racket[module] form or within a top-level expansion, then
|
||||
the @exnraise[exn:fail:contract]. If @racket[stx] form does not start with
|
||||
the @exnraise[exn:fail:contract]. If @racket[stx] form does start with
|
||||
@racket[module] or @racket[module*], or if it starts with @racket[module*]
|
||||
in a top-level context, the @exnraise[exn:fail:contract].
|
||||
|
||||
|
|
@ -1094,23 +1094,7 @@ former list).}
|
|||
require-transformer?]{
|
||||
|
||||
Creates a @tech{require transformer} using the given procedure as the
|
||||
transformer.
|
||||
Often used in combination with @racket[expand-import].
|
||||
|
||||
@examples[
|
||||
#:eval stx-eval
|
||||
(require (for-syntax racket/require-transform))
|
||||
|
||||
(define-syntax printing
|
||||
(make-require-transformer
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ path)
|
||||
(printf "Importing: ~a~n" #'path)
|
||||
(expand-import #'path)]))))
|
||||
|
||||
(require (printing racket/match))
|
||||
]}
|
||||
transformer.}
|
||||
|
||||
|
||||
@defthing[prop:require-transformer struct-type-property?]{
|
||||
|
|
|
|||
|
|
@ -165,9 +165,6 @@ result is the result of the last @racket[body].}
|
|||
@; ----------------------------------------------------------------------
|
||||
|
||||
@section[#:tag "date-string"]{Date Utilities}
|
||||
@margin-note{For more date & time operations, see
|
||||
@other-doc['(lib "gregor/scribblings/gregor.scrbl") #:indirect "Gregor: Date and Time"]
|
||||
or @link["../srfi/srfi-19.html"]{srfi/19}}
|
||||
|
||||
@note-lib-only[racket/date]
|
||||
|
||||
|
|
@ -224,16 +221,16 @@ local time by default or UTC if @racket[local-time?] is
|
|||
error is signaled, otherwise an integer is returned.}
|
||||
|
||||
|
||||
@defproc[(date->julian/scaliger [date date?]) exact-integer?]{
|
||||
@defproc[(date->julian/scalinger [date date?]) exact-integer?]{
|
||||
|
||||
Converts a date structure (up to 2099 BCE Gregorian) into a Julian
|
||||
date number. The returned value is not a strict Julian number, but
|
||||
rather Scaliger's version, which is off by one for easier
|
||||
rather Scalinger's version, which is off by one for easier
|
||||
calculations.}
|
||||
|
||||
|
||||
@defproc[(julian/scaliger->string [date-number exact-integer?])
|
||||
@defproc[(julian/scalinger->string [date-number exact-integer?])
|
||||
string?]{
|
||||
|
||||
Converts a Julian number (Scaliger's off-by-one version) into a
|
||||
Converts a Julian number (Scalinger's off-by-one version) into a
|
||||
string.}
|
||||
|
|
|
|||
|
|
@ -347,94 +347,6 @@ The index @racket[k] must be between @racket[0] (inclusive) and
|
|||
the number of fields in the structure (exclusive). In the case of
|
||||
@racket[unsafe-struct-set!], the field must be mutable.}
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(unsafe-mutable-hash-iterate-first
|
||||
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))])
|
||||
(or/c #f any/c)]
|
||||
@defproc[(unsafe-mutable-hash-iterate-next
|
||||
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
|
||||
[i any/c])
|
||||
(or/c #f any/c)]
|
||||
@defproc[(unsafe-mutable-hash-iterate-key
|
||||
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
|
||||
[i any/c])
|
||||
any/c]
|
||||
@defproc[(unsafe-mutable-hash-iterate-value
|
||||
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
|
||||
[i any/c])
|
||||
any/c]
|
||||
@defproc[(unsafe-mutable-hash-iterate-key+value
|
||||
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
|
||||
[i any/c])
|
||||
(values any/c any/c)]
|
||||
@defproc[(unsafe-mutable-hash-iterate-pair
|
||||
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
|
||||
[i any/c])
|
||||
pair?]
|
||||
@defproc[(unsafe-immutable-hash-iterate-first
|
||||
[h (and/c hash? immutable?)])
|
||||
(or/c #f any/c)]
|
||||
@defproc[(unsafe-immutable-hash-iterate-next
|
||||
[h (and/c hash? immutable?)]
|
||||
[i any/c])
|
||||
(or/c #f any/c)]
|
||||
@defproc[(unsafe-immutable-hash-iterate-key
|
||||
[h (and/c hash? immutable?)]
|
||||
[i any/c])
|
||||
any/c]
|
||||
@defproc[(unsafe-immutable-hash-iterate-value
|
||||
[h (and/c hash? immutable?)]
|
||||
[i any/c])
|
||||
any/c]
|
||||
@defproc[(unsafe-immutable-hash-iterate-key+value
|
||||
[h (and/c hash? immutable?)]
|
||||
[i any/c])
|
||||
(values any/c any/c)]
|
||||
@defproc[(unsafe-immutable-hash-iterate-pair
|
||||
[h (and/c hash? immutable?)]
|
||||
[i any/c])
|
||||
pair?]
|
||||
@defproc[(unsafe-weak-hash-iterate-first
|
||||
[h (and/c hash? hash-weak?)])
|
||||
(or/c #f any/c)]
|
||||
@defproc[(unsafe-weak-hash-iterate-next
|
||||
[h (and/c hash? hash-weak?)]
|
||||
[i any/c])
|
||||
(or/c #f any/c)]
|
||||
@defproc[(unsafe-weak-hash-iterate-key
|
||||
[h (and/c hash? hash-weak?)]
|
||||
[i any/c])
|
||||
any/c]
|
||||
@defproc[(unsafe-weak-hash-iterate-value
|
||||
[h (and/c hash? hash-weak?)]
|
||||
[i any/c])
|
||||
any/c]
|
||||
@defproc[(unsafe-weak-hash-iterate-key+value
|
||||
[h (and/c hash? hash-weak?)]
|
||||
[i any/c])
|
||||
(values any/c any/c)]
|
||||
@defproc[(unsafe-weak-hash-iterate-pair
|
||||
[h (and/c hash? hash-weak?)]
|
||||
[i any/c])
|
||||
pair?]
|
||||
)]{
|
||||
Unsafe versions of @racket[hash-iterate-key] and similar ops. These operations
|
||||
support @tech{chaperones} and @tech{impersonators}.
|
||||
|
||||
Each unsafe @code{-first} and @code{-next} operation may not return a number
|
||||
index but rather an internal representation of a view into the hash structure,
|
||||
enabling faster iteration.
|
||||
|
||||
The result of these @code{-first} and @code{-next}] functions should be given
|
||||
to the corresponding unsafe accessor functions.
|
||||
|
||||
If the key or value at the position returned by the @code{-first} and
|
||||
@code{-next} ops becomes invalid (e.g., because of mutation or garbage
|
||||
collection), then the operations @exnraise[exn:fail:contract].
|
||||
|
||||
@history[#:added "6.4.0.6"]
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------------------
|
||||
|
||||
@section[#:tag "unsafeextfl"]{Unsafe Extflonum Operations}
|
||||
|
|
@ -529,36 +441,20 @@ fixnum).}
|
|||
[prop impersonator-property?]
|
||||
[prop-val any] ... ...)
|
||||
(and/c procedure? impersonator?)]{
|
||||
Like @racket[impersonate-procedure], except it assumes that @racket[replacement-proc]
|
||||
is already properly wrapping @racket[proc] and so when the procedure that
|
||||
@racket[unsafe-impersonate-procedure] produces is invoked, the
|
||||
@racket[replacement-proc] is invoked directly, ignoring @racket[proc].
|
||||
|
||||
Like @racket[impersonate-procedure], but assumes that
|
||||
@racket[replacement-proc] calls @racket[proc] itself. When the result
|
||||
of @racket[unsafe-impersonate-procedure] is applied to arguments, the
|
||||
arguments are passed on to @racket[replacement-proc] directly,
|
||||
ignoring @racket[proc]. At the same time, @racket[impersonator-of?]
|
||||
reports @racket[#t] when given the result of
|
||||
@racket[unsafe-impersonate-procedure] and @racket[proc].
|
||||
In addition, it does not specially handle @racket[impersonator-prop:application-mark],
|
||||
instead just treating it as an ordinary property if it is supplied as one of the
|
||||
@racket[prop] arguments.
|
||||
|
||||
If @racket[proc] is itself an impersonator that is derived from
|
||||
@racket[impersonate-procedure*] or @racket[chaperone-procedure*],
|
||||
beware that @racket[replacement-proc] will not be able to call it
|
||||
correctly. Specifically, the impersonator produced by
|
||||
@racket[unsafe-impersonate-procedure] will not get passed to a
|
||||
wrapper procedure that was supplied to
|
||||
@racket[impersonate-procedure*] or @racket[chaperone-procedure*] to
|
||||
generate @racket[proc].
|
||||
This procedure is unsafe only in how it assumes @racket[replacement-proc] is
|
||||
a proper wrapper for @racket[proc]. It otherwise does all of the checking
|
||||
that @racket[impersonate-procedure] does.
|
||||
|
||||
Finally, unlike @racket[impersonate-procedure],
|
||||
@racket[unsafe-impersonate-procedure] does not specially handle
|
||||
@racket[impersonator-prop:application-mark] as a @racket[prop].
|
||||
|
||||
The unsafety of @racket[unsafe-impersonate-procedure] is limited to
|
||||
the above differences from @racket[impersonate-procedure]. The
|
||||
contracts on the arguments of @racket[unsafe-impersonate-procedure] are
|
||||
checked when the arguments are supplied.
|
||||
|
||||
As an example, assuming that @racket[f] accepts a single argument and
|
||||
is not derived from @racket[impersonate-procedure*] or
|
||||
@racket[chaperone-procedure*], then
|
||||
As an example, this function:
|
||||
@racketblock[(λ (f)
|
||||
(unsafe-impersonate-procedure
|
||||
f
|
||||
|
|
@ -566,7 +462,7 @@ fixnum).}
|
|||
(if (number? x)
|
||||
(error 'no-numbers!)
|
||||
(f x)))))]
|
||||
is equivalent to
|
||||
is equivalent to this one:
|
||||
@racketblock[(λ (f)
|
||||
(impersonate-procedure
|
||||
f
|
||||
|
|
@ -574,16 +470,17 @@ fixnum).}
|
|||
(if (number? x)
|
||||
(error 'no-numbers!)
|
||||
x))))]
|
||||
(except that some error messages start with @litchar{unsafe-impersonate-procedure}
|
||||
instead of @litchar{impersonate-procedure}).
|
||||
|
||||
Similarly, with the same assumptions about @racket[f], the following
|
||||
two procedures @racket[_wrap-f1] and
|
||||
Similarly the two procedures @racket[_wrap-f1] and
|
||||
@racket[_wrap-f2] are almost equivalent; they differ only
|
||||
in the error message produced when their arguments are
|
||||
functions that return multiple values (and that they update
|
||||
different global variables). The version using @racket[unsafe-impersonate-procedure]
|
||||
will signal an error in the @racket[let] expression about multiple
|
||||
return values, whereas the one using @racket[impersonate-procedure] signals
|
||||
an error from @racket[impersonate-procedure] about multiple return values.
|
||||
value return, whereas the one using @racket[impersonate-procedure] signals
|
||||
an error from @racket[impersonate-procedure] about multiple value return.
|
||||
@racketblock[(define log1-args '())
|
||||
(define log1-results '())
|
||||
(define wrap-f1
|
||||
|
|
@ -619,10 +516,6 @@ fixnum).}
|
|||
[prop-val any] ... ...)
|
||||
(and/c procedure? chaperone?)]{
|
||||
Like @racket[unsafe-impersonate-procedure], but creates a @tech{chaperone}.
|
||||
Since @racket[wrapper-proc] will be called in lieu of @racket[proc],
|
||||
@racket[wrapper-proc] is assumed to return a chaperone of the value that
|
||||
@racket[proc] would return.
|
||||
|
||||
@history[#:added "6.4.0.4"]
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -71,3 +71,30 @@ On occasion, you will find that you are spending a significant amount of
|
|||
code base. In some cases it is acceptable to delay such tests, e.g., when
|
||||
you will not know for a long time whether the performance implications
|
||||
allow a commit to the PLT repository.
|
||||
|
||||
@margin-note*{See
|
||||
@hyperlink["http://git.racket-lang.org/intro.html"]{the write-up} on
|
||||
using git in PLT for details.}
|
||||
|
||||
As a reminder, here are the essential elements of git for working on a
|
||||
fork:
|
||||
@itemlist[
|
||||
|
||||
@item{setup a fork:
|
||||
@verbatim{
|
||||
ssh pltgit fork plt eli/my-plt}}
|
||||
|
||||
@item{setup mail notifications:
|
||||
@verbatim{
|
||||
ssh pltgit config set eli/my-plt hooks.counter true
|
||||
ssh pltgit config set eli/my-plt hooks.mailinglist @eli,...}}
|
||||
|
||||
@item{allow someone else to push commits to my repository:
|
||||
@verbatim{
|
||||
ssh pltgit setperms eli/my-plt
|
||||
RW eli
|
||||
RW someone-else
|
||||
^D}}
|
||||
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -137,27 +137,3 @@ As you can see, the macro on the left calls a function with a list of the
|
|||
searchable values and a function that encapsulates the body. Every
|
||||
expansion is a single function call. In contrast, the macro on the right
|
||||
expands to many nested definitions and expressions every time it is used.
|
||||
|
||||
@; -----------------------------------------------------------------------------
|
||||
@section{Unsafe: Beware}
|
||||
|
||||
Racket provides a number of unsafe operations that behave
|
||||
like their related, safe variants but only when given valid inputs.
|
||||
They differ in that they eschew checking for performance reasons
|
||||
and thus behave unpredictably on invalid inputs.
|
||||
|
||||
As one example, consider @racket[fx+] and @racket[unsafe-fx+].
|
||||
When @racket[fx+] is applied to a non-@racket[fixnum?], it raises
|
||||
an error. In contrast, when @racket[unsafe-fx+] is applied to a non-@racket[fixnum?],
|
||||
it does not raise an error. Instead it either returns a strange result
|
||||
that may violate invariants of the run-time system and may cause
|
||||
later operations (such as printing out the value) to crash Racket itself.
|
||||
|
||||
Do not use unsafe operations in your programs unless you are writing
|
||||
software that builds proofs that the unsafe operations receive only
|
||||
valid inputs (e.g., a type system like Typed Racket) or you are building
|
||||
an abstraction that always inserts the right checks very close to
|
||||
the unsafe operation (e.g., a macro like @racket[for]). And even in these
|
||||
situations, avoid unsafe operations unless you have done a careful performance
|
||||
analysis to be sure that the performance improvement outweighs
|
||||
the risk of using the unsafe operations.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang info
|
||||
|
||||
(define scribblings '(("scribblings/syntax.scrbl" (multi-page) ("Syntax Extensions"))))
|
||||
(define scribblings '(("scribblings/syntax.scrbl" (multi-page))))
|
||||
|
||||
(define test-responsibles '((all mflatt)))
|
||||
|
|
|
|||
|
|
@ -926,11 +926,13 @@ times in the entire repetition.
|
|||
|
||||
If the pattern is matched too few times, then the ellipsis pattern
|
||||
fails with the message either @racket[too-few-message-expr] or
|
||||
@racketvalfont{"too few occurrences of @racket[name-expr]"}.
|
||||
@racketvalfont{"too few occurrences of @racket[name-expr]"}, when
|
||||
@racket[name-expr] is provided.
|
||||
|
||||
If the pattern is chosen too many times, then the ellipsis pattern
|
||||
fails with the message either @racket[too-many-message-expr] or
|
||||
@racketvalfont{"too few occurrences of @racket[name-expr]"}.
|
||||
@racketvalfont{"too many occurrences of @racket[name-expr]"}, when
|
||||
@racket[name-expr] is provided.
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -4,8 +4,7 @@
|
|||
(Section 'basic)
|
||||
|
||||
(require racket/flonum
|
||||
racket/function
|
||||
(only-in '#%kernel (list-pair? k:list-pair?)))
|
||||
racket/function)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -149,13 +148,6 @@
|
|||
(test #f pair? '#(a b))
|
||||
(arity-test pair? 1 1)
|
||||
|
||||
(test #f k:list-pair? '(a . b))
|
||||
(test #f k:list-pair? '(a . 1))
|
||||
(test #t k:list-pair? '(a b c))
|
||||
(test #f k:list-pair? '())
|
||||
(test #f k:list-pair? '#(a b))
|
||||
(arity-test k:list-pair? 1 1)
|
||||
|
||||
(test '(a) cons 'a '())
|
||||
(test '((a) b c d) cons '(a) '(b c d))
|
||||
(test '("a" b c) cons "a" '(b c))
|
||||
|
|
@ -2658,14 +2650,8 @@
|
|||
(set-a-y! an-a 8)
|
||||
(test v equal-hash-code an-a))
|
||||
|
||||
;; Check that `equal-hash-code` is consistent for interned symbols:
|
||||
(let ()
|
||||
(define v (random))
|
||||
(define k (equal-hash-code (string->symbol (format "sym:~a" v))))
|
||||
(collect-garbage 'minor)
|
||||
(test k equal-hash-code (string->symbol (format "sym:~a" v))))
|
||||
|
||||
;; Try to build a hash table whose indexes don't fit in 32 bits:
|
||||
;; Try to build a hash table whose indexes fonr't fit in 32 bits:
|
||||
(let ()
|
||||
(struct a (x)
|
||||
#:property
|
||||
|
|
@ -2694,48 +2680,6 @@
|
|||
(for ([(k v) (in-hash ht2)])
|
||||
v))
|
||||
|
||||
;; Check remove in the vicinity of a hash collision:
|
||||
(let ()
|
||||
(struct a (x y)
|
||||
#:property prop:equal+hash
|
||||
(list
|
||||
(lambda (a b eql?) (and (equal? (a-x a)
|
||||
(a-x b))
|
||||
(equal? (a-y a)
|
||||
(a-y b))))
|
||||
(lambda (a hc) (a-x a))
|
||||
(lambda (a hc) 1)))
|
||||
|
||||
(define k (+ (arithmetic-shift 1 10) 1))
|
||||
(define k2 (+ (arithmetic-shift 1 15) 1))
|
||||
|
||||
;; The second hash here is intended to provoke a
|
||||
;; collision in a subtable, and then remove an
|
||||
;; element that causes the subtable, in which
|
||||
;; case the collision should be moved up a layer.
|
||||
(equal? (hash (a 1 'a) 1
|
||||
(a 1 'b) 2
|
||||
(a 2 'c) 3)
|
||||
(hash-remove (hash (a 1 'a) 1
|
||||
(a 1 'b) 2
|
||||
(a 2 'c) 3
|
||||
(a k 'd) 4)
|
||||
(a k 'd)))
|
||||
|
||||
;; The second hash here is meanto to provoke
|
||||
;; a similar shape as above, but where the
|
||||
;; nested table is created to distinguish
|
||||
;; hash keys instead of handle a collision,
|
||||
;; and so it should not be moved up.
|
||||
(equal? (hash (a 1 'a) 1
|
||||
(a k2 'b) 2
|
||||
(a 2 'c) 3)
|
||||
(hash-remove (hash (a 1 'a) 1
|
||||
(a k2 'b) 2
|
||||
(a 2 'c) 3
|
||||
(a k 'd) 4)
|
||||
(a k 'd))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Misc
|
||||
|
||||
|
|
|
|||
|
|
@ -2386,39 +2386,6 @@
|
|||
(define cf (unsafe-chaperone-procedure pf (lambda (x) x)))
|
||||
(err/rt-test (cf) (λ (x) (regexp-match #rx"^pf:" (exn-message x)))))
|
||||
|
||||
;; Make sure `unsafe-chaperone-procedure` doesn't propagate a bogus
|
||||
;; identity to a `chaperone-procedure*` wrapper:
|
||||
(let ()
|
||||
(define found-prop? #f)
|
||||
|
||||
(define (f1 x) x)
|
||||
|
||||
(define-values (prop:p prop:p? prop:get-p)
|
||||
(make-impersonator-property 'p))
|
||||
|
||||
(define (mk*)
|
||||
(chaperone-procedure*
|
||||
f1
|
||||
(λ (f x)
|
||||
(when (prop:p? f)
|
||||
(set! found-prop? #t))
|
||||
x)))
|
||||
|
||||
(define f2 (mk*))
|
||||
(define f2x (mk*))
|
||||
|
||||
(define f3 (unsafe-chaperone-procedure f2 f2))
|
||||
(define f3x (unsafe-chaperone-procedure f2 (lambda (v)
|
||||
(f2x v)
|
||||
(f2 v))))
|
||||
|
||||
(define f4 (chaperone-procedure f3 #f prop:p 1234))
|
||||
|
||||
(test 1 f4 1)
|
||||
(test #f values found-prop?)
|
||||
(test 1 f3x 1)
|
||||
(test #f values found-prop?))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(let ()
|
||||
|
|
@ -2474,59 +2441,6 @@
|
|||
(test-wrapped wrapped-f)
|
||||
(test-wrapped wrapped2-f))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check that continuation-mark depth is handled
|
||||
;; properly when the JIT has to take a slow
|
||||
;; path for a tail call
|
||||
|
||||
(let ()
|
||||
(define (counter)
|
||||
(let ([c 0])
|
||||
(case-lambda
|
||||
[() c]
|
||||
[(x) (when (= c 1) (error 'fail)) (set! c (+ c 1)) #t])))
|
||||
|
||||
(for ([i 1000])
|
||||
(let ([c (counter)])
|
||||
(letrec ([f
|
||||
(contract (-> any/c c)
|
||||
(λ ([x #f]) (if (zero? x) x (f (- x 1))))
|
||||
'pos
|
||||
'neg)])
|
||||
(f 6)))))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check that property-only impersonator does not
|
||||
;; interfere with `chaperone-of?`
|
||||
;; (Test provided by Vincent)
|
||||
|
||||
(let ()
|
||||
(define-values (prop has-prop? get-prop)
|
||||
(make-impersonator-property 'prop))
|
||||
|
||||
(define add1* (impersonate-procedure add1 #f
|
||||
prop #f))
|
||||
|
||||
(test #t chaperone-of? (chaperone-procedure add1* #f)
|
||||
add1*)
|
||||
(test #t chaperone-of? (chaperone-procedure add1* (lambda (x) x))
|
||||
add1*)
|
||||
|
||||
(test #f chaperone-of? (chaperone-procedure add1* #f)
|
||||
add1)
|
||||
(test #f chaperone-of? (chaperone-procedure add1* (lambda (x) x))
|
||||
add1)
|
||||
|
||||
(test #t impersonator-of? (chaperone-procedure add1* #f)
|
||||
add1*)
|
||||
(test #t impersonator-of? (chaperone-procedure add1* (lambda (x) x))
|
||||
add1*)
|
||||
|
||||
(test #t impersonator-of? (chaperone-procedure add1* #f)
|
||||
add1)
|
||||
(test #t impersonator-of? (chaperone-procedure add1* (lambda (x) x))
|
||||
add1))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -26,8 +26,6 @@
|
|||
(test 0 find-seconds 0 0 0 1 1 1970 #f)
|
||||
(test 32416215 find-seconds 15 30 4 11 1 1971 #f)
|
||||
|
||||
(test 1969 date-year (seconds->date (- (* 24 60 60))))
|
||||
|
||||
(let* ([s (current-seconds)]
|
||||
[d1 (seconds->date s)]
|
||||
[d2 (seconds->date (+ s 1/100000000))])
|
||||
|
|
@ -73,12 +71,8 @@
|
|||
(test-string 'julian #f "JD 2 453 860")
|
||||
(test-string 'julian #t "JD 2 453 860, 03:02:01")
|
||||
|
||||
;; In the off chance that one of these changes and not the other,
|
||||
;; both are provided for tests.
|
||||
(test 2453860 date->julian/scalinger d)
|
||||
(test 2453860 date->julian/scaliger d)
|
||||
(test "JD 2 453 860" julian/scalinger->string 2453860)
|
||||
(test "JD 2 453 860" julian/scaliger->string 2453860))
|
||||
(test "JD 2 453 860" julian/scalinger->string 2453860))
|
||||
|
||||
;; Bad dates
|
||||
(err/rt-test (find-seconds 0 0 0 0 0 1990) exn:fail?)
|
||||
|
|
@ -110,14 +104,9 @@
|
|||
;; one of the two possible values, though:
|
||||
(test-find 0 30 1 7 11 2010))))
|
||||
|
||||
|
||||
;; In the off chance that one of these changes and not the other,
|
||||
;; both are provided for tests.
|
||||
;; bug fixes
|
||||
(test "JD 12" julian/scalinger->string 12)
|
||||
(test "JD 12" julian/scaliger->string 12)
|
||||
(test "JD 123" julian/scalinger->string 123)
|
||||
(test "JD 123" julian/scaliger->string 123)
|
||||
|
||||
;; make sure that date* has the correct parent info
|
||||
(test #t date*?
|
||||
|
|
@ -128,11 +117,4 @@
|
|||
(date* 56 34 12 22 08 2015 6 233 #f 0 789000000 "UTC")])
|
||||
(test 789/1000 - (date*->seconds d) (date->seconds d)))
|
||||
|
||||
;; Check some overflow handling on Windows:
|
||||
(when (eq? (system-type) 'windows)
|
||||
(let ([out-of-range (lambda (exn) (regexp-match? #rx"out-of-range" (exn-message exn)))])
|
||||
(err/rt-test (seconds->date (expt 2 40)) out-of-range)
|
||||
(err/rt-test (seconds->date (expt 2 50)) out-of-range)
|
||||
(err/rt-test (seconds->date (expt 2 60)) out-of-range)))
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -5,10 +5,6 @@
|
|||
|
||||
(define testing.rktl (build-path (current-load-relative-directory) "testing.rktl"))
|
||||
|
||||
(define original-dir (current-directory))
|
||||
(define work-dir (make-temporary-file "path~a" 'directory))
|
||||
(current-directory work-dir)
|
||||
|
||||
(test #t input-port? (current-input-port))
|
||||
(test #t output-port? (current-output-port))
|
||||
(test #t output-port? (current-error-port))
|
||||
|
|
@ -1619,9 +1615,6 @@
|
|||
;; Cleanup files created above
|
||||
(for ([f '("tmp1" "tmp2" "tmp3")] #:when (file-exists? f)) (delete-file f))
|
||||
|
||||
(current-directory original-dir)
|
||||
(delete-directory work-dir)
|
||||
|
||||
;; Network - - - - - - - - - - - - - - - - - - - - - -
|
||||
|
||||
(define (net-reject? who host port what)
|
||||
|
|
@ -1648,11 +1641,6 @@
|
|||
(err/rt-test (udp-connect! early-udp "localhost" 40000) (net-reject? 'udp-connect! "localhost" 40000 'client))
|
||||
(err/rt-test (udp-send-to early-udp "localhost" 40000 #"hi") (net-reject? 'udp-send-to "localhost" 40000 'client))))
|
||||
|
||||
;; Interaction with `system-type` - - - - - - - - - - - - - - - - - - -
|
||||
|
||||
(parameterize ([current-security-guard (make-file-sg '())])
|
||||
(test #f regexp-match? "unknown machine" (system-type 'machine)))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check `in-directory'
|
||||
|
||||
|
|
@ -1826,29 +1814,4 @@
|
|||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(let ([tf (make-temporary-file)])
|
||||
(test tf resolve-path (path->string tf))
|
||||
(unless (eq? 'windows (system-type))
|
||||
(delete-file tf)
|
||||
(make-file-or-directory-link "other.txt" tf)
|
||||
(test (string->path "other.txt") resolve-path tf))
|
||||
(delete-file tf)
|
||||
(case (system-path-convention-type)
|
||||
[(unix)
|
||||
(test (string->path "/testing-root/testing-dir/testing-file")
|
||||
resolve-path
|
||||
"//testing-root/testing-dir/testing-file")
|
||||
(test (string->path "/testing-root/testing-dir/testing-file")
|
||||
resolve-path
|
||||
"//testing-root////testing-dir//testing-file")]
|
||||
[(windows)
|
||||
(test (string->path "C:/testing-root/testing-dir/testing-file")
|
||||
resolve-path
|
||||
"C://testing-root/testing-dir/testing-file")
|
||||
(test (string->path "C:/testing-root/testing-dir\\testing-file")
|
||||
resolve-path
|
||||
"C://testing-root////testing-dir\\\\testing-file")]))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -7,8 +7,7 @@
|
|||
racket/system
|
||||
racket/list)
|
||||
|
||||
(define tmp-dir (make-temporary-file "filelib~a" 'directory))
|
||||
(define tmp-name (build-path tmp-dir "tmp0-filelib"))
|
||||
(define tmp-name "tmp0-filelib")
|
||||
(when (file-exists? tmp-name) (delete-file tmp-name))
|
||||
(display-lines-to-file '("a" "b" "c") tmp-name #:separator #"\r\n" #:mode 'binary)
|
||||
(test '(a b c) file->list tmp-name)
|
||||
|
|
@ -29,7 +28,6 @@
|
|||
(test #"\"\316\273\"" file->bytes tmp-name)
|
||||
(test "\u03BB" file->value tmp-name)
|
||||
(when (file-exists? tmp-name) (delete-file tmp-name))
|
||||
(delete-directory tmp-dir)
|
||||
|
||||
(define-syntax-rule (err/rt-chk-test (op arg ...))
|
||||
(err/rt-test (op arg ...) (check-msg 'op)))
|
||||
|
|
@ -89,79 +87,57 @@
|
|||
(test #t equal? (sort rel) (sort rel2))
|
||||
|
||||
(unless (eq? (system-type) 'windows)
|
||||
(define tmp-dir (make-temporary-file "filelib~a" 'directory))
|
||||
(define (touch . elems)
|
||||
(call-with-output-file
|
||||
(apply build-path elems)
|
||||
void))
|
||||
(make-file-or-directory-link "filelib.rktl" "filelib-link")
|
||||
(make-file-or-directory-link "." "loop-link")
|
||||
|
||||
(copy-file "filelib.rktl" (build-path tmp-dir "filelib.rktl"))
|
||||
(make-directory (build-path tmp-dir "sub"))
|
||||
(touch tmp-dir "a")
|
||||
(touch tmp-dir "b")
|
||||
(touch tmp-dir "sub" "x")
|
||||
(test (+ 2 (length rel2))
|
||||
fold-files
|
||||
(lambda (name kind accum)
|
||||
(test kind values (cond
|
||||
[(link-exists? name) 'link]
|
||||
[(file-exists? name) 'file]
|
||||
[(directory-exists? name) 'dir]
|
||||
[else '???]))
|
||||
(when (member name '("filelib-link" "loop-link"))
|
||||
(test kind name 'link))
|
||||
(add1 accum))
|
||||
0
|
||||
#f
|
||||
#f)
|
||||
|
||||
(parameterize ([current-directory tmp-dir])
|
||||
(define rel2 (fold-files (lambda (name kind accum)
|
||||
(test kind name (if (file-exists? name)
|
||||
'file
|
||||
'dir))
|
||||
(cons name accum))
|
||||
null))
|
||||
(test (+ 2 (length rel2))
|
||||
fold-files
|
||||
(lambda (name kind accum)
|
||||
(test kind values (cond
|
||||
[(link-exists? name) 'link]
|
||||
[(file-exists? name) 'file]
|
||||
[(directory-exists? name) 'dir]
|
||||
[else '???]))
|
||||
(when (member name '("filelib-link" "loop-link"))
|
||||
(test kind name 'link))
|
||||
(values (add1 accum) #t))
|
||||
0
|
||||
#f
|
||||
#f)
|
||||
|
||||
(make-file-or-directory-link "filelib.rktl" "filelib-link")
|
||||
(make-file-or-directory-link "." "loop-link")
|
||||
(delete-file "loop-link")
|
||||
|
||||
(test (+ 2 (length rel2))
|
||||
fold-files
|
||||
(lambda (name kind accum)
|
||||
(test kind values (cond
|
||||
[(link-exists? name) 'link]
|
||||
[(file-exists? name) 'file]
|
||||
[(directory-exists? name) 'dir]
|
||||
[else '???]))
|
||||
(when (member name '("filelib-link" "loop-link"))
|
||||
(test kind name 'link))
|
||||
(add1 accum))
|
||||
0
|
||||
#f
|
||||
#f)
|
||||
(test (+ 1 (length rel2))
|
||||
fold-files
|
||||
(lambda (name kind accum)
|
||||
(test kind values (cond
|
||||
[(file-exists? name) 'file]
|
||||
[else 'dir]))
|
||||
(when (member name '("filelib-link"))
|
||||
(test kind name 'file))
|
||||
(add1 accum))
|
||||
0
|
||||
#f
|
||||
#t)
|
||||
|
||||
(test (+ 2 (length rel2))
|
||||
fold-files
|
||||
(lambda (name kind accum)
|
||||
(test kind values (cond
|
||||
[(link-exists? name) 'link]
|
||||
[(file-exists? name) 'file]
|
||||
[(directory-exists? name) 'dir]
|
||||
[else '???]))
|
||||
(when (member name '("filelib-link" "loop-link"))
|
||||
(test kind name 'link))
|
||||
(values (add1 accum) #t))
|
||||
0
|
||||
#f
|
||||
#f)
|
||||
|
||||
(delete-file "loop-link")
|
||||
|
||||
(test (+ 1 (length rel2))
|
||||
fold-files
|
||||
(lambda (name kind accum)
|
||||
(test kind values (cond
|
||||
[(file-exists? name) 'file]
|
||||
[else 'dir]))
|
||||
(when (member name '("filelib-link"))
|
||||
(test kind name 'file))
|
||||
(add1 accum))
|
||||
0
|
||||
#f
|
||||
#t)
|
||||
|
||||
(delete-file "filelib-link")
|
||||
|
||||
'done)
|
||||
(delete-directory/files tmp-dir)))))
|
||||
(delete-file "filelib-link")
|
||||
|
||||
'done))))
|
||||
;; ----------------------------------------
|
||||
|
||||
;;----------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -75,15 +75,9 @@
|
|||
(= fx-result unsafe-result)))])
|
||||
(unless ans
|
||||
(newline)
|
||||
(error 'same-results (~a "better die now, rather than continue, what with unsafe ops around:\n"
|
||||
" fx-result ~s\n"
|
||||
" unsafe-result ~s\n"
|
||||
" op: ~s\n"
|
||||
" args: ~s")
|
||||
(error 'same-results "better die now, rather than continue, what with unsafe ops around:\n fx-result ~s\n unsafe-result ~s"
|
||||
fx-result
|
||||
unsafe-result
|
||||
fx
|
||||
args))
|
||||
unsafe-result))
|
||||
#t)))
|
||||
|
||||
(define (flonum? x) (inexact-real? x))
|
||||
|
|
|
|||
|
|
@ -369,7 +369,6 @@
|
|||
(test '() 'in-empty-vector (let ([v (in-vector '#())]) (for/list ([e v]) e)))
|
||||
(test '() 'in-empty-vector (let ([v (in-vector '#() 0)]) (for/list ([e v]) e)))
|
||||
(test '() 'in-empty-vector (let ([v (in-vector '#() 0 0)]) (for/list ([e v]) e)))
|
||||
(test '() 'in-empty-vector (let ([v (in-vector '#(1) 1)]) (for/list ([e v]) e)))
|
||||
(test '() 'in-empty-vector (let ([v (in-vector '#(1) 1 1)]) (for/list ([e v]) e)))
|
||||
(test '() 'in-empty-vector (let ([v (in-vector '#(1) 0 0)]) (for/list ([e v]) e)))
|
||||
(test '(1) 'in-empty-vector (let ([v (in-vector '#(1) 0 1)]) (for/list ([e v]) e)))
|
||||
|
|
@ -451,240 +450,7 @@
|
|||
#rx".*expected number of values not received.*")
|
||||
(test 1 'one (begin (for/fold () () (values)) 1))
|
||||
|
||||
;; iterator contract tests
|
||||
(err/rt-test (for ([x (in-range (sqrt -1))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: real\\?")
|
||||
(err/rt-test (for ([x (in-range 1 (sqrt -1))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: real\\?")
|
||||
(err/rt-test (for ([x (in-range 1 2 (sqrt -1))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: real\\?")
|
||||
(test (* 10 pi) 'in-range-with-reals
|
||||
(for/sum ([x (in-range 0 (+ (* 4 pi) .1) pi)]) x))
|
||||
(err/rt-test (for ([x (in-naturals 1.1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: exact-nonnegative-integer\\?")
|
||||
(err/rt-test (for ([x (in-naturals -1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: exact-nonnegative-integer\\?")
|
||||
(err/rt-test (for ([x (in-list 1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: list\\?")
|
||||
(err/rt-test (for ([x (in-list (vector 1 2 3))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: list\\?")
|
||||
(err/rt-test (for ([x (in-list (mcons 1 '()))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: list\\?")
|
||||
(err/rt-test (for ([x (in-mlist (list 1 2 3))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: mpair\\?")
|
||||
(err/rt-test (for ([x (in-vector '(1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: vector")
|
||||
(err/rt-test (for ([x (in-vector (vector 1 2) -1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index is out of range")
|
||||
(err/rt-test (for ([x (in-vector (vector 1 2) 10)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index is out of range")
|
||||
(err/rt-test (for ([x (in-vector (vector 1 2) 1.1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: exact-integer\\?")
|
||||
(err/rt-test (for ([x (in-vector (vector 1 2) 0 1.1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected\\: exact-integer\\?")
|
||||
(err/rt-test (for ([x (in-vector (vector 1 2) 0 2 1.1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*exact-integer\\?")
|
||||
(err/rt-test (for ([x (in-vector (vector 1 2) 0 2 0)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*not/c zero\\?")
|
||||
(err/rt-test (for ([x (in-port (vector 1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*procedure-arity-includes/c 1")
|
||||
(err/rt-test (for ([x (in-input-port-bytes (vector 1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected: input-port\\?")
|
||||
(err/rt-test (for ([x (in-hash (vector 1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected: hash\\?")
|
||||
(err/rt-test (for ([x (in-hash-pairs (vector 1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected: hash\\?")
|
||||
(err/rt-test (for ([x (in-hash-keys (vector 1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected: hash\\?")
|
||||
(err/rt-test (for ([x (in-hash-values (vector 1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"expected: hash\\?")
|
||||
(err/rt-test (for ([x (in-hash (hash 1 2))]) x)
|
||||
exn:fail:contract:arity?
|
||||
#rx"expected number of values not received")
|
||||
|
||||
(err/rt-test (for/sum ([x (in-vector (vector 1 2) 2 -1 -1)]) x) ; pr 15227
|
||||
exn:fail:contract?
|
||||
#rx"starting index is out of range")
|
||||
(err/rt-test (for/sum ([x (in-vector (vector) -1 -1 -1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index is out of range")
|
||||
(err/rt-test (for/sum ([x (in-vector (vector) 1 1 1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index is out of range")
|
||||
(err/rt-test (for/sum ([x (in-vector (vector 1) 1 2)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index is out of range")
|
||||
(err/rt-test (for/sum ([x (in-vector (vector 1) 0 2)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"stopping index is out of range")
|
||||
(err/rt-test (for/sum ([x (in-vector (vector 1) 0 -1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index more than stopping index, but given a positive step")
|
||||
(err/rt-test (for/sum ([x (in-vector (vector 1) 0 1 -1)]) x)
|
||||
exn:fail:contract?
|
||||
#rx"starting index less than stopping index, but given a negative step")
|
||||
|
||||
;; for/fold syntax checking
|
||||
(syntax-test #'(for/fold () bad 1) #rx".*bad sequence binding clauses.*")
|
||||
|
||||
;; specific hash set iterators
|
||||
(err/rt-test (for/sum ([x (in-immutable-set '(1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"not a hash set")
|
||||
(err/rt-test (for/sum ([x (in-mutable-set '(1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"not a hash set")
|
||||
(err/rt-test (for/sum ([x (in-weak-set '(1 2))]) x)
|
||||
exn:fail:contract?
|
||||
#rx"not a hash set")
|
||||
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (set 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (mutable-set 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-weak-set (weak-set 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (seteqv 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (mutable-seteqv 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-weak-set (weak-seteqv 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (seteq 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (mutable-seteq 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-weak-set (weak-seteq 1 2 3 4))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-immutable-set (list->set '(1 2 3 4)))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-mutable-set (list->mutable-set '(1 2 3 4)))]) x))
|
||||
(test 10 'in-hash-set (for/sum ([x (in-weak-set (list->weak-set '(1 2 3 4)))]) x))
|
||||
(test 30 'custom-in-hash-set
|
||||
(let ()
|
||||
(define-custom-set-types pos-set
|
||||
#:elem? positive?
|
||||
(λ (x y recur) (+ x y))
|
||||
(λ (x recur) x))
|
||||
(define imm
|
||||
(make-immutable-pos-set '(1 2 3 4)))
|
||||
(define m
|
||||
(make-mutable-pos-set '(1 2 3 4)))
|
||||
(define w
|
||||
(make-weak-pos-set '(1 2 3 4)))
|
||||
(+ (for/sum ([x (in-immutable-set imm)]) x)
|
||||
(for/sum ([x (in-mutable-set m)]) x)
|
||||
(for/sum ([x (in-weak-set w)]) x))))
|
||||
|
||||
(err/rt-test
|
||||
(for ([(k v) (in-immutable-hash (make-hash '((1 . 2))))]) (+ k v))
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([(k v) (in-immutable-hash (make-weak-hash '((1 . 2))))]) (+ k v))
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([(k v) (in-mutable-hash (make-immutable-hash '((1 . 2))))]) (+ k v))
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([(k v) (in-mutable-hash (make-weak-hash '((1 . 2))))]) (+ k v))
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([(k v) (in-weak-hash (make-immutable-hash '((1 . 2))))]) (+ k v))
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
(err/rt-test
|
||||
(for ([(k v) (in-weak-hash (make-hash '((1 . 2))))]) (+ k v))
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
;; keys
|
||||
(err/rt-test
|
||||
(for ([k (in-immutable-hash-keys (make-hash '((1 . 2))))]) k)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([k (in-immutable-hash-keys (make-weak-hash '((1 . 2))))]) k)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([k (in-mutable-hash-keys (make-immutable-hash '((1 . 2))))]) k)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([k (in-mutable-hash-keys (make-weak-hash '((1 . 2))))]) k)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([k (in-weak-hash-keys (make-immutable-hash '((1 . 2))))]) k)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
(err/rt-test
|
||||
(for ([k (in-weak-hash-keys (make-hash '((1 . 2))))]) k)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
;; values
|
||||
(err/rt-test
|
||||
(for ([v (in-immutable-hash-values (make-hash '((1 . 2))))]) v)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([v (in-immutable-hash-values (make-weak-hash '((1 . 2))))]) v)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([v (in-mutable-hash-values (make-immutable-hash '((1 . 2))))]) v)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([v (in-mutable-hash-values (make-weak-hash '((1 . 2))))]) v)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([v (in-weak-hash-values (make-immutable-hash '((1 . 2))))]) v)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
(err/rt-test
|
||||
(for ([v (in-weak-hash-values (make-hash '((1 . 2))))]) v)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
;; pairs
|
||||
(err/rt-test
|
||||
(for ([p (in-immutable-hash-pairs (make-hash '((1 . 2))))]) p)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([p (in-immutable-hash-pairs (make-weak-hash '((1 . 2))))]) p)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? immutable\\?")
|
||||
(err/rt-test
|
||||
(for ([p (in-mutable-hash-pairs (make-immutable-hash '((1 . 2))))]) p)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([p (in-mutable-hash-pairs (make-weak-hash '((1 . 2))))]) p)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? mutable\\?")
|
||||
(err/rt-test
|
||||
(for ([p (in-weak-hash-pairs (make-immutable-hash '((1 . 2))))]) p)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
(err/rt-test
|
||||
(for ([p (in-weak-hash-pairs (make-hash '((1 . 2))))]) p)
|
||||
exn:fail:contract?
|
||||
#rx"expected:.*and/c hash\\? hash-weak\\?")
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
#include <stdlib.h>
|
||||
#include <errno.h>
|
||||
#ifdef USE_THREAD_TEST
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
|
|
@ -257,15 +256,3 @@ X void* foreign_thread_callback(test_callback_t f,
|
|||
return r;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* This testing function doesn't work reliably on Windows, because it sometimes
|
||||
* writes to a different errno. */
|
||||
X int check_multiple_of_ten(int v) {
|
||||
int r = v % 10;
|
||||
if (r == 0) {
|
||||
return 0;
|
||||
} else {
|
||||
errno = r;
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,8 +7,7 @@
|
|||
ffi/unsafe/cvector
|
||||
ffi/vector
|
||||
racket/extflonum
|
||||
racket/place
|
||||
racket/file)
|
||||
racket/place)
|
||||
|
||||
(define test-async? (and (place-enabled?) (not (eq? 'windows (system-type)))))
|
||||
|
||||
|
|
@ -98,38 +97,34 @@
|
|||
|
||||
(require dynext/compile dynext/link racket/runtime-path)
|
||||
(define-runtime-path here ".")
|
||||
|
||||
(define test-tmp-dir
|
||||
(make-temporary-file "foreign~a" 'directory))
|
||||
(copy-file (build-path here "foreign-test.c")
|
||||
(build-path test-tmp-dir "foreign-test.c"))
|
||||
(define delete-test-files
|
||||
(parameterize ([current-directory test-tmp-dir])
|
||||
(let ([c (build-path (current-directory) "foreign-test.c")]
|
||||
[o (build-path (current-directory)
|
||||
(if (eq? 'windows (system-type))
|
||||
"foreign-test.obj" "foreign-test.o"))]
|
||||
[so (build-path (current-directory)
|
||||
(bytes->path (bytes-append #"foreign-test"
|
||||
(system-type 'so-suffix))))])
|
||||
(let ([c (build-path here "foreign-test.c")]
|
||||
[o (build-path (current-directory)
|
||||
(if (eq? 'windows (system-type))
|
||||
"foreign-test.obj" "foreign-test.o"))]
|
||||
[so (build-path (current-directory)
|
||||
(bytes->path (bytes-append #"foreign-test"
|
||||
(system-type 'so-suffix))))])
|
||||
(when (file-exists? o) (delete-file o))
|
||||
(when (file-exists? so) (delete-file so))
|
||||
(parameterize ([current-standard-link-libraries '()]
|
||||
[current-extension-compiler-flags
|
||||
(if test-async?
|
||||
(append '("-pthread" "-DUSE_THREAD_TEST") (current-extension-compiler-flags))
|
||||
(current-extension-compiler-flags))]
|
||||
[current-extension-linker-flags
|
||||
(if test-async?
|
||||
(append '("-pthread") (current-extension-linker-flags))
|
||||
(current-extension-linker-flags))])
|
||||
(compile-extension #t c o '())
|
||||
(link-extension #t (list o) so))
|
||||
(lambda ()
|
||||
(when (file-exists? o) (delete-file o))
|
||||
(when (file-exists? so) (delete-file so))
|
||||
(parameterize ([current-standard-link-libraries '()]
|
||||
[current-extension-compiler-flags
|
||||
(if test-async?
|
||||
(append '("-pthread" "-DUSE_THREAD_TEST") (current-extension-compiler-flags))
|
||||
(current-extension-compiler-flags))]
|
||||
[current-extension-linker-flags
|
||||
(if test-async?
|
||||
(append '("-pthread") (current-extension-linker-flags))
|
||||
(current-extension-linker-flags))])
|
||||
(compile-extension #t c o '())
|
||||
(link-extension #t (list o) so))
|
||||
(lambda ()
|
||||
(when (file-exists? so)
|
||||
(with-handlers ([exn:fail:filesystem?
|
||||
(lambda (e)
|
||||
(eprintf "warning: could not delete ~e\n" test-tmp-dir))])
|
||||
(delete-directory/files test-tmp-dir))))))
|
||||
(eprintf "warning: could not delete ~e\n" so))])
|
||||
(delete-file so))))))
|
||||
|
||||
;; Test arrays
|
||||
(define _c7_list (_array/list _byte 7))
|
||||
|
|
@ -184,7 +179,7 @@
|
|||
(define _borl (_union _byte _long))
|
||||
(define _ic7iorl (_union _ic7i _long))
|
||||
|
||||
(define test-lib (ffi-lib (build-path test-tmp-dir "foreign-test")))
|
||||
(define test-lib (ffi-lib "./foreign-test"))
|
||||
|
||||
(for ([n (in-range 5)])
|
||||
(define (ffi name type) (get-ffi-obj name test-lib type))
|
||||
|
|
@ -557,43 +552,6 @@
|
|||
(define a-bar (bar (malloc 16 'raw)))
|
||||
(free a-bar))
|
||||
|
||||
(unless (eq? (system-type) 'windows)
|
||||
;; saved-errno tests
|
||||
(define check-multiple-of-ten
|
||||
(get-ffi-obj 'check_multiple_of_ten test-lib (_fun #:save-errno 'posix _int -> _int)))
|
||||
(test 0 check-multiple-of-ten 40)
|
||||
(test -1 check-multiple-of-ten 42)
|
||||
(test 2 saved-errno)
|
||||
(saved-errno 5)
|
||||
(test 5 saved-errno)
|
||||
;; test saved-errno is thread-local
|
||||
(define errno-from-thread #f)
|
||||
(sync (thread (lambda () (check-multiple-of-ten 17) (set! errno-from-thread (saved-errno)))))
|
||||
(test 5 saved-errno) ;; same as before
|
||||
(test 7 (lambda () errno-from-thread)))
|
||||
|
||||
(when (eq? (system-type) 'windows)
|
||||
;; Use functions from msvcrt.dll that are documented to affect errno.
|
||||
;; (See note in /racket/src/foreign/foreign.rktc about Windows.)
|
||||
(define msvcrt (ffi-lib "msvcrt.dll"))
|
||||
(define ENOENT 2)
|
||||
(define ERANGE 34)
|
||||
(define _getcwd ;; sets errno = ERANGE if path longer than buffer
|
||||
(get-ffi-obj '_getcwd msvcrt (_fun #:save-errno 'posix _bytes _int -> _void)))
|
||||
(define _chdir ;; sets errno = ENOENT if path doesn't exist
|
||||
(get-ffi-obj '_chdir msvcrt (_fun #:save-errno 'posix _string -> _int)))
|
||||
(define (bad/ERANGE) (_getcwd (make-bytes 1) 1))
|
||||
(define (bad/ENOENT) (_chdir "no-such-directory"))
|
||||
(bad/ERANGE)
|
||||
(test ERANGE saved-errno)
|
||||
(test -1 bad/ENOENT)
|
||||
(test ENOENT saved-errno)
|
||||
;; test saved-errno is thread-local
|
||||
(define errno-from-thread #f)
|
||||
(sync (thread (lambda () (bad/ERANGE) (set! errno-from-thread (saved-errno)))))
|
||||
(test ENOENT saved-errno) ;; same as above
|
||||
(test ERANGE (lambda () errno-from-thread)))
|
||||
|
||||
(delete-test-files)
|
||||
|
||||
(let ()
|
||||
|
|
@ -1131,46 +1089,6 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define scheme_make_type
|
||||
(get-ffi-obj 'scheme_make_type #f (_fun _string -> _short)))
|
||||
(define scheme_register_type_gc_shape
|
||||
(get-ffi-obj 'scheme_register_type_gc_shape #f (_fun _short (_list i _intptr) -> _void)))
|
||||
|
||||
(define SHAPE_STR_TERM 0)
|
||||
(define SHAPE_STR_PTR_OFFSET 1)
|
||||
|
||||
(define-cstruct _tagged ([type-tag _short]
|
||||
[obj1 _racket]
|
||||
[non2 _intptr]
|
||||
[obj3 _racket]
|
||||
[non4 _intptr])
|
||||
#:define-unsafe
|
||||
#:malloc-mode 'tagged)
|
||||
|
||||
(define t (scheme_make_type "new-type"))
|
||||
(scheme_register_type_gc_shape t (list SHAPE_STR_PTR_OFFSET tagged-obj1-offset
|
||||
SHAPE_STR_PTR_OFFSET tagged-obj3-offset
|
||||
SHAPE_STR_TERM))
|
||||
|
||||
(define obj1 (make-string 10))
|
||||
(define obj2 (make-bytes 12))
|
||||
(define obj3 (make-bytes 14))
|
||||
(define obj4 (make-string 16))
|
||||
|
||||
(define obj2-addr (cast obj2 _racket _intptr))
|
||||
(define obj4-addr (cast obj4 _racket _intptr))
|
||||
|
||||
(define o (make-tagged t obj1 obj2-addr obj3 obj4-addr))
|
||||
|
||||
(collect-garbage)
|
||||
|
||||
(eq? (tagged-obj1 o) obj1)
|
||||
(eq? (tagged-obj3 o) obj3)
|
||||
(= (tagged-non2 o) obj2-addr)
|
||||
(= (tagged-non4 o) obj4-addr)
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
||||
#| --- ignore everything below ---
|
||||
|
|
|
|||
|
|
@ -110,9 +110,7 @@
|
|||
|
||||
(test 1 procedure-result-arity car)
|
||||
(test 1 procedure-result-arity list)
|
||||
(test 1 procedure-result-arity (procedure-reduce-arity car 1))
|
||||
(test (arity-at-least 0) procedure-result-arity values)
|
||||
(test (arity-at-least 0) procedure-result-arity (procedure-reduce-arity values 1))
|
||||
(test (arity-at-least 0) procedure-result-arity call/cc)
|
||||
(let ()
|
||||
(struct s (x))
|
||||
|
|
@ -126,13 +124,6 @@
|
|||
(if (= 0 (random 1))
|
||||
1
|
||||
(values 1 2))))
|
||||
(test #f procedure-result-arity
|
||||
(procedure-reduce-arity
|
||||
(λ ()
|
||||
(if (= 0 (random 1))
|
||||
1
|
||||
(values 1 2)))
|
||||
0))
|
||||
(err/rt-test (procedure-result-arity 1) exn:fail?)
|
||||
(test 1 procedure-result-arity (chaperone-procedure car values))
|
||||
(test 1 procedure-result-arity (impersonate-procedure car (λ (x) 1)))
|
||||
|
|
|
|||
|
|
@ -34,290 +34,3 @@
|
|||
(hash-copy
|
||||
#hash([one . 1] [two . 2] [three . 3] [four . 4]))
|
||||
h))
|
||||
|
||||
(let ()
|
||||
(define-syntax (define-hash-iterations-tester stx)
|
||||
(syntax-case stx ()
|
||||
[(_ tag -in-hash -in-pairs -in-keys -in-values)
|
||||
#'(define-hash-iterations-tester tag
|
||||
-in-hash -in-hash -in-hash
|
||||
-in-pairs -in-pairs -in-pairs
|
||||
-in-keys -in-keys -in-keys
|
||||
-in-values -in-values -in-values)]
|
||||
[(_ tag
|
||||
-in-immut-hash -in-mut-hash -in-weak-hash
|
||||
-in-immut-hash-pairs -in-mut-hash-pairs -in-weak-hash-pairs
|
||||
-in-immut-hash-keys -in-mut-hash-keys -in-weak-hash-keys
|
||||
-in-immut-hash-values -in-mut-hash-values -in-weak-hash-values)
|
||||
(with-syntax
|
||||
([name
|
||||
(datum->syntax #'tag
|
||||
(string->symbol
|
||||
(format "test-hash-iters-~a" (syntax->datum #'tag))))])
|
||||
#'(define (name lst1 lst2)
|
||||
(define ht/immut (make-immutable-hash (map cons lst1 lst2)))
|
||||
(define ht/mut (make-hash (map cons lst1 lst2)))
|
||||
(define ht/weak (make-weak-hash (map cons lst1 lst2)))
|
||||
|
||||
(define fake-ht/immut
|
||||
(chaperone-hash
|
||||
ht/immut
|
||||
(lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
|
||||
(lambda (h k v) values k v) ; set-proc
|
||||
(lambda (h k) k) ; remove-proc
|
||||
(lambda (h k) k))) ; key-proc
|
||||
(define fake-ht/mut
|
||||
(impersonate-hash
|
||||
ht/mut
|
||||
(lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
|
||||
(lambda (h k v) values k v) ; set-proc
|
||||
(lambda (h k) k) ; remove-proc
|
||||
(lambda (h k) k))) ; key-proc
|
||||
(define fake-ht/weak
|
||||
(impersonate-hash
|
||||
ht/weak
|
||||
(lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
|
||||
(lambda (h k v) values k v) ; set-proc
|
||||
(lambda (h k) k) ; remove-proc
|
||||
(lambda (h k) k))) ; key-proc
|
||||
|
||||
(define ht/immut/seq (-in-immut-hash ht/immut))
|
||||
(define ht/mut/seq (-in-mut-hash ht/mut))
|
||||
(define ht/weak/seq (-in-weak-hash ht/weak))
|
||||
(define ht/immut-pair/seq (-in-immut-hash-pairs ht/immut))
|
||||
(define ht/mut-pair/seq (-in-mut-hash-pairs ht/mut))
|
||||
(define ht/weak-pair/seq (-in-weak-hash-pairs ht/weak))
|
||||
(define ht/immut-keys/seq (-in-immut-hash-keys ht/immut))
|
||||
(define ht/mut-keys/seq (-in-mut-hash-keys ht/mut))
|
||||
(define ht/weak-keys/seq (-in-weak-hash-keys ht/weak))
|
||||
(define ht/immut-vals/seq (-in-immut-hash-values ht/immut))
|
||||
(define ht/mut-vals/seq (-in-mut-hash-values ht/mut))
|
||||
(define ht/weak-vals/seq (-in-weak-hash-values ht/weak))
|
||||
|
||||
(test #t =
|
||||
(for/sum ([(k v) (-in-immut-hash ht/immut)]) (+ k v))
|
||||
(for/sum ([(k v) (-in-mut-hash ht/mut)]) (+ k v))
|
||||
(for/sum ([(k v) (-in-weak-hash ht/weak)]) (+ k v))
|
||||
(for/sum ([(k v) (-in-immut-hash fake-ht/immut)]) (+ k v))
|
||||
(for/sum ([(k v) (-in-mut-hash fake-ht/mut)]) (+ k v))
|
||||
(for/sum ([(k v) (-in-weak-hash fake-ht/weak)]) (+ k v))
|
||||
(for/sum ([(k v) ht/immut/seq]) (+ k v))
|
||||
(for/sum ([(k v) ht/mut/seq]) (+ k v))
|
||||
(for/sum ([(k v) ht/weak/seq]) (+ k v))
|
||||
(for/sum ([k+v (-in-immut-hash-pairs ht/immut)])
|
||||
(+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v (-in-mut-hash-pairs ht/mut)])
|
||||
(+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v (-in-weak-hash-pairs ht/weak)])
|
||||
(+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v (-in-immut-hash-pairs fake-ht/immut)])
|
||||
(+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v (-in-mut-hash-pairs fake-ht/mut)])
|
||||
(+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v (-in-weak-hash-pairs fake-ht/weak)])
|
||||
(+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v ht/immut-pair/seq]) (+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v ht/mut-pair/seq]) (+ (car k+v) (cdr k+v)))
|
||||
(for/sum ([k+v ht/weak-pair/seq]) (+ (car k+v) (cdr k+v)))
|
||||
(+ (for/sum ([k (-in-immut-hash-keys ht/immut)]) k)
|
||||
(for/sum ([v (-in-immut-hash-values ht/immut)]) v))
|
||||
(+ (for/sum ([k (-in-mut-hash-keys ht/mut)]) k)
|
||||
(for/sum ([v (-in-mut-hash-values ht/mut)]) v))
|
||||
(+ (for/sum ([k (-in-weak-hash-keys ht/weak)]) k)
|
||||
(for/sum ([v (-in-weak-hash-values ht/weak)]) v))
|
||||
(+ (for/sum ([k (-in-immut-hash-keys fake-ht/immut)]) k)
|
||||
(for/sum ([v (-in-immut-hash-values fake-ht/immut)]) v))
|
||||
(+ (for/sum ([k (-in-mut-hash-keys fake-ht/mut)]) k)
|
||||
(for/sum ([v (-in-mut-hash-values fake-ht/mut)]) v))
|
||||
(+ (for/sum ([k (-in-weak-hash-keys fake-ht/weak)]) k)
|
||||
(for/sum ([v (-in-weak-hash-values fake-ht/weak)]) v))
|
||||
(+ (for/sum ([k ht/immut-keys/seq]) k)
|
||||
(for/sum ([v ht/immut-vals/seq]) v))
|
||||
(+ (for/sum ([k ht/mut-keys/seq]) k)
|
||||
(for/sum ([v ht/mut-vals/seq]) v))
|
||||
(+ (for/sum ([k ht/weak-keys/seq]) k)
|
||||
(for/sum ([v ht/weak-vals/seq]) v)))
|
||||
|
||||
(test #t =
|
||||
(for/sum ([(k v) (-in-immut-hash ht/immut)]) k)
|
||||
(for/sum ([(k v) (-in-mut-hash ht/mut)]) k)
|
||||
(for/sum ([(k v) (-in-weak-hash ht/weak)]) k)
|
||||
(for/sum ([(k v) (-in-immut-hash fake-ht/immut)]) k)
|
||||
(for/sum ([(k v) (-in-mut-hash fake-ht/mut)]) k)
|
||||
(for/sum ([(k v) (-in-weak-hash fake-ht/weak)]) k)
|
||||
(for/sum ([(k v) ht/immut/seq]) k)
|
||||
(for/sum ([(k v) ht/mut/seq]) k)
|
||||
(for/sum ([(k v) ht/weak/seq]) k)
|
||||
(for/sum ([k+v (-in-immut-hash-pairs ht/immut)]) (car k+v))
|
||||
(for/sum ([k+v (-in-mut-hash-pairs ht/mut)]) (car k+v))
|
||||
(for/sum ([k+v (-in-weak-hash-pairs ht/weak)]) (car k+v))
|
||||
(for/sum ([k+v (-in-immut-hash-pairs fake-ht/immut)]) (car k+v))
|
||||
(for/sum ([k+v (-in-mut-hash-pairs fake-ht/mut)]) (car k+v))
|
||||
(for/sum ([k+v (-in-weak-hash-pairs fake-ht/weak)]) (car k+v))
|
||||
(for/sum ([k+v ht/immut-pair/seq]) (car k+v))
|
||||
(for/sum ([k+v ht/mut-pair/seq]) (car k+v))
|
||||
(for/sum ([k+v ht/weak-pair/seq]) (car k+v))
|
||||
(for/sum ([k (-in-immut-hash-keys ht/immut)]) k)
|
||||
(for/sum ([k (-in-mut-hash-keys ht/mut)]) k)
|
||||
(for/sum ([k (-in-weak-hash-keys ht/weak)]) k)
|
||||
(for/sum ([k (-in-immut-hash-keys fake-ht/immut)]) k)
|
||||
(for/sum ([k (-in-mut-hash-keys fake-ht/mut)]) k)
|
||||
(for/sum ([k (-in-weak-hash-keys fake-ht/weak)]) k)
|
||||
(for/sum ([k ht/immut-keys/seq]) k)
|
||||
(for/sum ([k ht/mut-keys/seq]) k)
|
||||
(for/sum ([k ht/weak-keys/seq]) k))
|
||||
|
||||
(test #t =
|
||||
(for/sum ([(k v) (-in-immut-hash ht/immut)]) v)
|
||||
(for/sum ([(k v) (-in-mut-hash ht/mut)]) v)
|
||||
(for/sum ([(k v) (-in-weak-hash ht/weak)]) v)
|
||||
(for/sum ([(k v) (-in-immut-hash fake-ht/immut)]) v)
|
||||
(for/sum ([(k v) (-in-mut-hash fake-ht/mut)]) v)
|
||||
(for/sum ([(k v) (-in-weak-hash fake-ht/weak)]) v)
|
||||
(for/sum ([(k v) ht/immut/seq]) v)
|
||||
(for/sum ([(k v) ht/mut/seq]) v)
|
||||
(for/sum ([(k v) ht/weak/seq]) v)
|
||||
(for/sum ([k+v (-in-immut-hash-pairs ht/immut)]) (cdr k+v))
|
||||
(for/sum ([k+v (-in-mut-hash-pairs ht/mut)]) (cdr k+v))
|
||||
(for/sum ([k+v (-in-weak-hash-pairs ht/weak)]) (cdr k+v))
|
||||
(for/sum ([k+v (-in-immut-hash-pairs fake-ht/immut)]) (cdr k+v))
|
||||
(for/sum ([k+v (-in-mut-hash-pairs fake-ht/mut)]) (cdr k+v))
|
||||
(for/sum ([k+v (-in-weak-hash-pairs fake-ht/weak)]) (cdr k+v))
|
||||
(for/sum ([k+v ht/immut-pair/seq]) (cdr k+v))
|
||||
(for/sum ([k+v ht/mut-pair/seq]) (cdr k+v))
|
||||
(for/sum ([k+v ht/weak-pair/seq]) (cdr k+v))
|
||||
(for/sum ([v (-in-immut-hash-values ht/immut)]) v)
|
||||
(for/sum ([v (-in-mut-hash-values ht/mut)]) v)
|
||||
(for/sum ([v (-in-weak-hash-values ht/weak)]) v)
|
||||
(for/sum ([v (-in-immut-hash-values fake-ht/immut)]) v)
|
||||
(for/sum ([v (-in-mut-hash-values fake-ht/mut)]) v)
|
||||
(for/sum ([v (-in-weak-hash-values fake-ht/weak)]) v)
|
||||
(for/sum ([v ht/immut-vals/seq]) v)
|
||||
(for/sum ([v ht/mut-vals/seq]) v)
|
||||
(for/sum ([v ht/weak-vals/seq]) v))))]))
|
||||
(define-hash-iterations-tester generic
|
||||
in-hash in-hash-pairs in-hash-keys in-hash-values)
|
||||
(define-hash-iterations-tester specific
|
||||
in-immutable-hash in-mutable-hash in-weak-hash
|
||||
in-immutable-hash-pairs in-mutable-hash-pairs in-weak-hash-pairs
|
||||
in-immutable-hash-keys in-mutable-hash-keys in-weak-hash-keys
|
||||
in-immutable-hash-values in-mutable-hash-values in-weak-hash-values)
|
||||
|
||||
(define lst1 (build-list 10 values))
|
||||
(define lst2 (build-list 10 add1))
|
||||
(test-hash-iters-generic lst1 lst2)
|
||||
(test-hash-iters-specific lst1 lst2)
|
||||
(define lst3 (build-list 100000 values))
|
||||
(define lst4 (build-list 100000 add1))
|
||||
(test-hash-iters-generic lst3 lst4)
|
||||
(test-hash-iters-specific lst3 lst4))
|
||||
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; Use keys that are a multile of a power of 2 to
|
||||
; get "almost" collisions that force the hash table
|
||||
; to use a deeper tree.
|
||||
|
||||
(let ()
|
||||
(define vals (for/list ([j (in-range 100)]) (add1 j)))
|
||||
(define sum-vals (for/sum ([v (in-list vals)]) v))
|
||||
(for ([shift (in-range 150)])
|
||||
(define keys (for/list ([j (in-range 100)])
|
||||
(arithmetic-shift j shift)))
|
||||
; test first the weak table to ensure the keys are not collected
|
||||
(define ht/weak (make-weak-hash (map cons keys vals)))
|
||||
(define sum-ht/weak (for/sum ([v (in-weak-hash-values ht/weak)]) v))
|
||||
(define ht/mut (make-hash (map cons keys vals)))
|
||||
(define sum-ht/mut (for/sum ([v (in-mutable-hash-values ht/mut)]) v))
|
||||
(define ht/immut (make-immutable-hash (map cons keys vals)))
|
||||
(define sum-ht/immut (for/sum ([v (in-immutable-hash-values ht/immut)]) v))
|
||||
(test #t = sum-vals sum-ht/weak sum-ht/mut sum-ht/immut)))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(let ()
|
||||
(define err-msg "no element at index")
|
||||
|
||||
;; Check that unsafe-weak-hash-iterate- ops do not segfault
|
||||
;; when a key is collected before access; throw exception instead.
|
||||
;; They are used for safe iteration in in-weak-hash- sequence forms
|
||||
(let ()
|
||||
(define ht #f)
|
||||
|
||||
(let ([lst (build-list 10 add1)])
|
||||
(set! ht (make-weak-hash `((,lst . val)))))
|
||||
|
||||
(define i (hash-iterate-first ht))
|
||||
|
||||
;; everything ok
|
||||
(test #t number? i)
|
||||
(test #t list? (hash-iterate-key ht i))
|
||||
(test #t equal? (hash-iterate-value ht i) 'val)
|
||||
(test #t equal? (cdr (hash-iterate-pair ht i)) 'val)
|
||||
(test #t equal?
|
||||
(call-with-values (lambda () (hash-iterate-key+value ht i)) cons)
|
||||
'((1 2 3 4 5 6 7 8 9 10) . val))
|
||||
(test #t boolean? (hash-iterate-next ht i))
|
||||
|
||||
;; collect key, everything should error
|
||||
(collect-garbage)(collect-garbage)(collect-garbage)
|
||||
(test #t boolean? (hash-iterate-first ht))
|
||||
(err/rt-test (hash-iterate-key ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-pair ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-key+value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-next ht i) exn:fail:contract? err-msg))
|
||||
|
||||
;; Check that unsafe mutable hash table operations do not segfault
|
||||
;; after getting valid index from unsafe-mutable-hash-iterate-first and -next.
|
||||
;; Throw exception instead since they're used for safe iteration
|
||||
(let ()
|
||||
(define ht (make-hash '((a . b))))
|
||||
|
||||
(define i (hash-iterate-first ht))
|
||||
|
||||
;; everything ok
|
||||
(test #t number? i)
|
||||
(test #t equal? (hash-iterate-key ht i) 'a)
|
||||
(test #t equal? (hash-iterate-value ht i) 'b)
|
||||
(test #t equal? (hash-iterate-pair ht i) '(a . b))
|
||||
(test #t equal?
|
||||
(call-with-values (lambda () (hash-iterate-key+value ht i)) cons)
|
||||
'(a . b))
|
||||
(test #t boolean? (hash-iterate-next ht i))
|
||||
|
||||
;; remove element, everything should error
|
||||
(hash-remove! ht 'a)
|
||||
(test #t boolean? (hash-iterate-first ht))
|
||||
(err/rt-test (hash-iterate-key ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-pair ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-key+value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test (hash-iterate-next ht i) exn:fail:contract? err-msg))
|
||||
|
||||
|
||||
(let ()
|
||||
(define ht (make-weak-hash '((a . b))))
|
||||
|
||||
(define i (hash-iterate-first ht))
|
||||
|
||||
;; everything ok
|
||||
(test #t number? i)
|
||||
(test #t equal? (hash-iterate-key ht i) 'a)
|
||||
(test #t equal? (hash-iterate-value ht i) 'b)
|
||||
(test #t equal? (hash-iterate-pair ht i) '(a . b))
|
||||
(test #t equal? (call-with-values
|
||||
(lambda () (hash-iterate-key+value ht i)) cons)
|
||||
'(a . b))
|
||||
(test #t boolean? (hash-iterate-next ht i))
|
||||
|
||||
;; remove element, everything should error
|
||||
(hash-remove! ht 'a)
|
||||
(test #t boolean? (hash-iterate-first ht))
|
||||
(err/rt-test (hash-iterate-key ht i) exn:fail:contract?)
|
||||
(err/rt-test (hash-iterate-value ht i) exn:fail:contract?)
|
||||
(err/rt-test (hash-iterate-pair ht i) exn:fail:contract?)
|
||||
(err/rt-test (hash-iterate-key+value ht i) exn:fail:contract?)
|
||||
(err/rt-test (hash-iterate-next ht i) exn:fail:contract?)))
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -456,16 +456,7 @@
|
|||
(test '(()) sorted-combs '(4 1 2 5 3) 0)
|
||||
(test
|
||||
'((1 2) (1 3) (1 5) (2 3) (2 5) (4 1) (4 2) (4 3) (4 5) (5 3))
|
||||
sorted-combs '(4 1 2 5 3) 2)
|
||||
(test
|
||||
'((1 2 3) (1 2 5) (1 5 3) (2 5 3) (4 1 2) (4 1 3) (4 1 5) (4 2 3) (4 2 5) (4 5 3))
|
||||
sorted-combs '(4 1 2 5 3) 3)
|
||||
(test
|
||||
21
|
||||
(lambda (n k)
|
||||
(length (combinations n k)))
|
||||
'(1 2 3 4 5 6 7)
|
||||
5))
|
||||
sorted-combs '(4 1 2 5 3) 2))
|
||||
|
||||
;; ---------- permutations ----------
|
||||
(let ()
|
||||
|
|
|
|||
|
|
@ -1564,50 +1564,6 @@
|
|||
(regexp-match? #rx"cannot use identifier tainted by macro transformation"
|
||||
(exn-message exn))))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check that lifting works right at the top level:
|
||||
|
||||
(module macro-that-introduces-a-lifted-one racket
|
||||
(define-syntax (m stx)
|
||||
(syntax-local-lift-expression #'1))
|
||||
(m))
|
||||
(dynamic-require ''macro-that-introduces-a-lifted-one #f)
|
||||
|
||||
(test 1 values (parameterize ([current-namespace
|
||||
(module->namespace ''macro-that-introduces-a-lifted-one)])
|
||||
(eval '(values m))))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check that expanded references in submodule
|
||||
;; have the right binding info for 'origin
|
||||
|
||||
(let ()
|
||||
(define m
|
||||
'(module m racket/base
|
||||
(define-syntax-rule (m) 1)
|
||||
(module+ main
|
||||
(m))))
|
||||
|
||||
(define m-expanded
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(expand m)))
|
||||
|
||||
(define-values (bind-m ref-m)
|
||||
(syntax-case m-expanded ()
|
||||
[(module _ racket/base
|
||||
(#%module-begin
|
||||
_
|
||||
(define-syntaxes
|
||||
(m)
|
||||
_)
|
||||
(module* main #f
|
||||
(#%module-begin-2
|
||||
_
|
||||
(#%app1 call-with-values (lambda () ONE) print-values)))))
|
||||
(values #'m (car (syntax-property #'ONE 'origin)))]))
|
||||
|
||||
(test #t free-identifier=? bind-m ref-m))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -715,9 +715,9 @@
|
|||
(err/rt-test (inexact->exact -inf.0))
|
||||
(err/rt-test (inexact->exact +nan.0))
|
||||
|
||||
(err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-message exn))))
|
||||
(err/rt-test (inexact->exact -inf.f) (lambda (exn) (regexp-match? #rx"[-]inf[.]f" (exn-message exn))))
|
||||
(err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-message exn))))
|
||||
(err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-messgae exn))))
|
||||
(err/rt-test (inexact->exact -inf.f) (lambda (exn) (regexp-match? #rx"[-]inf[.]f" (exn-messgae exn))))
|
||||
(err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-messgae exn))))
|
||||
|
||||
(test 2.0f0 real->single-flonum 2)
|
||||
(test 2.25f0 real->single-flonum 2.25)
|
||||
|
|
@ -998,8 +998,6 @@
|
|||
(test 0.0 modulo -4.0 2)
|
||||
(test 0.0 modulo 4.0 -2)
|
||||
(test 0.0 modulo -4.0 -2)
|
||||
(test 1.0 modulo 21.0 2)
|
||||
(test 1.0 modulo -21.0 2)
|
||||
(test 0 remainder 4 2)
|
||||
(test 0 remainder -4 2)
|
||||
(test 0 remainder 4 -2)
|
||||
|
|
@ -1008,8 +1006,6 @@
|
|||
(test 0.0 remainder -4.0 2)
|
||||
(test 0.0 remainder 4.0 -2)
|
||||
(test 0.0 remainder -4.0 -2)
|
||||
(test 1.0 remainder 21.0 2)
|
||||
(test -1.0 remainder -21.0 2)
|
||||
(test 0 modulo 0 5.0)
|
||||
(test 0 modulo 0 -5.0)
|
||||
(test 0 remainder 0 5.0)
|
||||
|
|
@ -1114,15 +1110,6 @@
|
|||
(err/rt-test (remainder 2 1+2i))
|
||||
(err/rt-test (modulo 2 1+2i))
|
||||
|
||||
(test (- (expt 2 65) (expt 2 62))
|
||||
modulo (- (+ (expt 2 62) (expt 2 65))) (expt 2 65))
|
||||
(test (- (expt 2 33) (expt 2 30))
|
||||
modulo (- (+ (expt 2 30) (expt 2 33))) (expt 2 33))
|
||||
(test (- (expt 2 62))
|
||||
remainder (- (+ (expt 2 62) (expt 2 65))) (expt 2 65))
|
||||
(test (- (expt 2 30))
|
||||
remainder (- (+ (expt 2 30) (expt 2 33))) (expt 2 33))
|
||||
|
||||
(test 10 bitwise-ior 10)
|
||||
(test 10 bitwise-and 10)
|
||||
(test 10 bitwise-xor 10)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -71,10 +71,6 @@
|
|||
(arity-test complete-path? 1 1)
|
||||
(err/rt-test (complete-path? 'a))
|
||||
|
||||
(define original-dir (current-directory))
|
||||
(define work-dir (make-temporary-file "path~a" 'directory))
|
||||
(current-directory work-dir)
|
||||
|
||||
(call-with-output-file "tmp6" void #:exists 'replace)
|
||||
(define existant "tmp6")
|
||||
|
||||
|
|
@ -224,9 +220,6 @@
|
|||
(test #t delete-directory/tf "down")
|
||||
(test #f delete-directory/tf "down")
|
||||
|
||||
(current-directory original-dir)
|
||||
(delete-directory work-dir)
|
||||
|
||||
; Redefine these per-platform
|
||||
(define drives null)
|
||||
(define nondrive-roots (list "/"))
|
||||
|
|
@ -882,12 +875,12 @@
|
|||
(test (bytes->path #"/home/mflatt/././~") build-path (bytes->path #"/home/mflatt") (bytes->path #"././~"))
|
||||
(test (bytes->path #"./~") build-path (bytes->path #"./~"))
|
||||
(when use-fs?
|
||||
(let ([dir (make-temporary-file "tmp79~a" 'directory)])
|
||||
(let ([dir "tmp79"])
|
||||
(unless (directory-exists? dir)
|
||||
(make-directory dir))
|
||||
(close-output-port (open-output-file (build-path dir "~me") #:exists 'replace))
|
||||
(close-output-port (open-output-file "tmp79/~me" #:exists 'replace))
|
||||
(test (list (bytes->path #"~me")) directory-list dir)
|
||||
(delete-file (build-path dir (bytes->path #"~me")))
|
||||
(delete-file (build-path "tmp79" (bytes->path #"~me")))
|
||||
(delete-directory dir)))
|
||||
(void)))
|
||||
|
||||
|
|
|
|||
|
|
@ -3,15 +3,6 @@
|
|||
|
||||
(Section 'port)
|
||||
|
||||
(define (call-in-temporary-directory thunk)
|
||||
(define dir (make-temporary-file "tmp~a" 'directory))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(parameterize ([current-directory dir])
|
||||
(thunk)))
|
||||
(lambda () (delete-directory dir))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for progress events and commits
|
||||
|
||||
|
|
@ -66,15 +57,12 @@
|
|||
(test-pipe #t))
|
||||
(let ([test-file
|
||||
(lambda (commit-eof?)
|
||||
(call-in-temporary-directory
|
||||
(lambda ()
|
||||
(with-output-to-file "tmp8"
|
||||
#:exists 'truncate/replace
|
||||
(lambda () (write-string "hello")))
|
||||
(define p (open-input-file "tmp8"))
|
||||
(test-hello-port p commit-eof?)
|
||||
(close-input-port p)
|
||||
(delete-file "tmp8"))))])
|
||||
(with-output-to-file "tmp8" #:exists 'truncate/replace
|
||||
(lambda () (write-string "hello")))
|
||||
(define p (open-input-file "tmp8"))
|
||||
(test-hello-port p commit-eof?)
|
||||
(close-input-port p)
|
||||
(delete-file "tmp8"))])
|
||||
(test-file #f)
|
||||
(test-file #t))
|
||||
|
||||
|
|
@ -789,16 +777,14 @@
|
|||
(count-lines! in)
|
||||
(check in))
|
||||
(let ()
|
||||
(call-in-temporary-directory
|
||||
(lambda ()
|
||||
(with-output-to-file "tmp8"
|
||||
#:exists 'truncate/replace
|
||||
(lambda () (display "12345")))
|
||||
(define in (open-input-file "tmp8"))
|
||||
(count-lines! in)
|
||||
(check in)
|
||||
(close-input-port in)
|
||||
(delete-file "tmp8")))))
|
||||
(with-output-to-file "tmp8"
|
||||
#:exists 'truncate/replace
|
||||
(lambda () (display "12345")))
|
||||
(define in (open-input-file "tmp8"))
|
||||
(count-lines! in)
|
||||
(check in)
|
||||
(close-input-port in)
|
||||
(delete-file "tmp8")))
|
||||
(check-all void)
|
||||
(check-all port-count-lines!))
|
||||
|
||||
|
|
|
|||
|
|
@ -464,42 +464,6 @@
|
|||
;; let's check that 3/4 were collected:
|
||||
(test #t < (hash-count ht) (* 1/4 (length l)))))
|
||||
|
||||
;;----------------------------------------
|
||||
;; Check that it works to apply a continuation that shares with
|
||||
;; an enclosing continuation, where a runstack overflow happens
|
||||
;; between the continuations
|
||||
|
||||
(let ()
|
||||
(define N 100)
|
||||
(define N2 10)
|
||||
(define M 10)
|
||||
|
||||
(define p (make-continuation-prompt-tag))
|
||||
|
||||
(define (grab n m k-prev q)
|
||||
(cond
|
||||
[(positive? n)
|
||||
(let ([x (grab (sub1 n) m k-prev q)])
|
||||
(lambda () x))]
|
||||
[(positive? m)
|
||||
((call/cc
|
||||
(lambda (k)
|
||||
(grab N2 (sub1 m) k q))
|
||||
p))]
|
||||
[(positive? q)
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(k-prev
|
||||
(lambda ()
|
||||
(grab N M void (sub1 q)))))
|
||||
p)]
|
||||
[else void]))
|
||||
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(grab N M void 10))
|
||||
p))
|
||||
|
||||
;;----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -531,7 +531,7 @@
|
|||
(parameterize ([sandbox-output 'bytes]
|
||||
[sandbox-error-output current-output-port]
|
||||
[sandbox-memory-limit 2]
|
||||
[sandbox-eval-limits '(2.5 1)])
|
||||
[sandbox-eval-limits '(0.25 1)])
|
||||
(make-base-evaluator!))
|
||||
;; GCing is needed to allow these to happen (note: the memory limit is very
|
||||
;; tight here, this test usually fails if the sandbox library is not
|
||||
|
|
|
|||
|
|
@ -57,9 +57,4 @@
|
|||
(test '(1 3) stream->list (stream-filter odd? '(1 2 3)))
|
||||
(test '(1 a 2 a 3) stream->list (stream-add-between '(1 2 3) 'a))
|
||||
|
||||
(test 4 'for/stream (stream-ref (for/stream ([x '(1 2 3)]) (* x x)) 1))
|
||||
(test 6 'for*/stream (stream-ref (for*/stream ([x '(1 2 3)] [y '(1 2 3)]) (* x y)) 7))
|
||||
(test 1 'for/stream (stream-first (for*/stream ([x '(1 0)]) (/ x))))
|
||||
(test 625 'for/stream (stream-ref (for/stream ([x (in-naturals)]) (* x x)) 25))
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -2296,50 +2296,4 @@
|
|||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(let ([zo-bounce
|
||||
(lambda (stx)
|
||||
(define o (open-output-bytes))
|
||||
(write (compile #`(quote-syntax #,stx)) o)
|
||||
(eval
|
||||
(parameterize ([read-accept-compiled #t])
|
||||
(read (open-input-bytes (get-output-bytes o))))))])
|
||||
(test #\{ syntax-property (zo-bounce #'{0}) 'paren-shape)
|
||||
(test #\[ syntax-property (zo-bounce #'[0]) 'paren-shape)
|
||||
(test #f syntax-property (zo-bounce (syntax-property #'[0] 'something-else 1))
|
||||
'something-else)
|
||||
(test 1 syntax-property (zo-bounce (syntax-property #'[0] 'something-else 1 #t))
|
||||
'something-else)
|
||||
|
||||
(define s0 (syntax-property
|
||||
(syntax-property
|
||||
(syntax-property #'[0]
|
||||
'something-else 1 #t)
|
||||
'something-not-saved 2)
|
||||
'a-third-thing 3 #t))
|
||||
(define s (zo-bounce s0))
|
||||
(test #\[ syntax-property s 'paren-shape)
|
||||
(test #\[ syntax-property s0 'paren-shape)
|
||||
(test #t syntax-property-preserved? s 'paren-shape)
|
||||
(test #t syntax-property-preserved? s0 'paren-shape)
|
||||
|
||||
(test 1 syntax-property s 'something-else)
|
||||
(test 1 syntax-property s0 'something-else)
|
||||
(test #t syntax-property-preserved? s 'something-else)
|
||||
(test #t syntax-property-preserved? s0 'something-else)
|
||||
|
||||
(test #f syntax-property s 'something-not-saved)
|
||||
(test 2 syntax-property s0 'something-not-saved)
|
||||
(test #f syntax-property-preserved? s 'something-not-saved)
|
||||
(test #f syntax-property-preserved? s0 'something-not-saved)
|
||||
|
||||
(test 3 syntax-property s 'a-third-thing)
|
||||
(test 3 syntax-property s0 'a-third-thing)
|
||||
(test #t syntax-property-preserved? s 'a-third-thing)
|
||||
(test #t syntax-property-preserved? s0 'a-third-thing)
|
||||
|
||||
;; 'paren-shape has a special default:
|
||||
(test #t syntax-property-preserved? (syntax-property #'#f 'paren-shape #\() 'paren-shape))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -155,19 +155,5 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(let ()
|
||||
(define-syntax-rule (mac-zero) 0)
|
||||
(define-syntax-parameter x (make-rename-transformer #'mac-zero))
|
||||
(define-syntax-rule (mac-one) 1)
|
||||
(define-syntax y (make-rename-transformer #'x))
|
||||
(test #t = (mac-zero) 0)
|
||||
(test #t = (mac-one) 1)
|
||||
(test #t = (x) 0)
|
||||
(test #t = (y) 0)
|
||||
(test #t = (syntax-parameterize ([y (make-rename-transformer #'mac-one)]) (x)) 1)
|
||||
(test #t = (syntax-parameterize ([y (make-rename-transformer #'mac-one)]) (y)) 1))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
||||
|
|
|
|||
|
|
@ -234,16 +234,12 @@
|
|||
(wrap-evt
|
||||
(alarm-evt (+ (current-inexact-milliseconds) (* 1000 amt)))
|
||||
(lambda (v) amt)))))])
|
||||
(define fast SYNC-SLEEP-DELAY)
|
||||
(define slow1 (* 100 SYNC-SLEEP-DELAY))
|
||||
(define slow2 (* 99 SYNC-SLEEP-DELAY))
|
||||
(test #f sync/timeout fast (make-delay slow1) (make-delay slow1))
|
||||
(test fast sync/timeout slow1 (make-delay fast) (make-delay slow2))
|
||||
(test fast sync/timeout slow1 (make-delay slow2) (make-delay fast))
|
||||
(test fast sync/timeout slow2 (make-delay fast) (make-delay slow1))
|
||||
(test fast sync/timeout slow2 (make-delay slow1) (make-delay fast))
|
||||
(test fast sync/timeout slow2
|
||||
(choice-evt (make-delay slow1) (make-delay fast))))
|
||||
(test #f sync/timeout 0.1 (make-delay 0.15) (make-delay 0.2))
|
||||
(test 0.15 sync/timeout 18 (make-delay 0.15) (make-delay 0.2))
|
||||
(test 0.15 sync/timeout 18 (make-delay 0.2) (make-delay 0.15))
|
||||
(test 0.15 sync/timeout 0.18 (make-delay 0.15) (make-delay 0.2))
|
||||
(test 0.15 sync/timeout 18
|
||||
(choice-evt (make-delay 0.2) (make-delay 0.15))))
|
||||
|
||||
;;check flattening of choice evts returned by a guard:
|
||||
(let ()
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
|
||||
The test form has these two shapes:
|
||||
|
||||
(test <expected> <procedure> <argument1> <argument2> ...)
|
||||
(test <expected> <procdure> <argument1> <argument2> ...)
|
||||
|
||||
(test <expected> <symbolic-name> <expression>)
|
||||
|
||||
|
|
@ -217,6 +217,7 @@ transcript.
|
|||
(syntax
|
||||
(thunk-error-test (err:mz:lambda () e) (quote-syntax e) exn?))]
|
||||
[(_ e exn? msg-rx)
|
||||
(regexp? (syntax-e #'msg-rx))
|
||||
#'(thunk-error-test
|
||||
(err:mz:lambda () e)
|
||||
(quote-syntax e)
|
||||
|
|
|
|||
|
|
@ -579,104 +579,4 @@
|
|||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(let ()
|
||||
(define err-msg "no element at index")
|
||||
|
||||
;; Check that unsafe-weak-hash-iterate- ops do not segfault
|
||||
;; when a key is collected before access; throw exception instead.
|
||||
;; They are used for safe iteration in in-weak-hash- sequence forms
|
||||
(let ()
|
||||
(define ht #f)
|
||||
|
||||
(let ([lst (build-list 10 add1)])
|
||||
(set! ht (make-weak-hash `((,lst . val)))))
|
||||
|
||||
(define i (unsafe-weak-hash-iterate-first ht))
|
||||
|
||||
;; everything ok
|
||||
(test #t number? i)
|
||||
(test #t list? (unsafe-weak-hash-iterate-key ht i))
|
||||
(test #t equal? (unsafe-weak-hash-iterate-value ht i) 'val)
|
||||
(test #t equal? (cdr (unsafe-weak-hash-iterate-pair ht i)) 'val)
|
||||
(test #t equal?
|
||||
(call-with-values
|
||||
(lambda () (unsafe-weak-hash-iterate-key+value ht i)) cons)
|
||||
'((1 2 3 4 5 6 7 8 9 10) . val))
|
||||
(test #t boolean? (unsafe-weak-hash-iterate-next ht i))
|
||||
|
||||
;; collect key, everything should error (but not segfault)
|
||||
(collect-garbage)(collect-garbage)(collect-garbage)
|
||||
(test #t boolean? (unsafe-weak-hash-iterate-first ht))
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg))
|
||||
|
||||
;; Check that unsafe mutable hash table operations do not segfault
|
||||
;; after getting valid index from unsafe-mutable-hash-iterate-first and -next.
|
||||
;; Throw exception instead since they're used for safe iteration
|
||||
(let ()
|
||||
(define ht (make-hash '((a . b))))
|
||||
(define i (unsafe-mutable-hash-iterate-first ht))
|
||||
|
||||
;; everything ok
|
||||
(test #t number? i)
|
||||
(test #t equal? (unsafe-mutable-hash-iterate-key ht i) 'a)
|
||||
(test #t equal? (unsafe-mutable-hash-iterate-value ht i) 'b)
|
||||
(test #t equal? (unsafe-mutable-hash-iterate-pair ht i) '(a . b))
|
||||
(test #t equal?
|
||||
(call-with-values
|
||||
(lambda () (unsafe-mutable-hash-iterate-key+value ht i)) cons)
|
||||
'(a . b))
|
||||
(test #t boolean? (unsafe-mutable-hash-iterate-next ht i))
|
||||
|
||||
;; remove element, everything should error (but not segfault)
|
||||
(hash-remove! ht 'a)
|
||||
(test #t boolean? (unsafe-mutable-hash-iterate-first ht))
|
||||
(err/rt-test
|
||||
(unsafe-mutable-hash-iterate-key ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-mutable-hash-iterate-value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-mutable-hash-iterate-pair ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-mutable-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-mutable-hash-iterate-next ht i) exn:fail:contract? err-msg))
|
||||
|
||||
(let ()
|
||||
(define ht (make-weak-hash '((a . b))))
|
||||
(define i (unsafe-weak-hash-iterate-first ht))
|
||||
|
||||
;; everything ok
|
||||
(test #t number? i)
|
||||
(test #t equal? (unsafe-weak-hash-iterate-key ht i) 'a)
|
||||
(test #t equal? (unsafe-weak-hash-iterate-value ht i) 'b)
|
||||
(test #t equal? (unsafe-weak-hash-iterate-pair ht i) '(a . b))
|
||||
(test #t equal?
|
||||
(call-with-values
|
||||
(lambda () (unsafe-weak-hash-iterate-key+value ht i)) cons)
|
||||
'(a . b))
|
||||
(test #t boolean? (unsafe-weak-hash-iterate-next ht i))
|
||||
|
||||
;; remove element, everything should error (but not segfault)
|
||||
(hash-remove! ht 'a)
|
||||
(test #t boolean? (unsafe-weak-hash-iterate-first ht))
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
|
||||
(err/rt-test
|
||||
(unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg)))
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -22,9 +22,6 @@
|
|||
;; for `json` tests
|
||||
"at-exp-lib"
|
||||
|
||||
;; for contract tests
|
||||
"option-contract-lib"
|
||||
|
||||
;; used by the planet packages tested by the pkg tests
|
||||
"srfi-lib"
|
||||
|
||||
|
|
|
|||
|
|
@ -27,5 +27,5 @@
|
|||
;; ok if these don't raise unbound id errors
|
||||
(check-equal? (with-output-to-string (lambda () (write (tuple 5)))) "#0=#0#")
|
||||
(check-equal? (tuple 5) (tuple 5))
|
||||
(check-equal? (equal-hash-code (tuple 5)) 55)
|
||||
(check-equal? (equal-secondary-hash-code (tuple 5)) 46))
|
||||
(check-equal? (equal-hash-code (tuple 5)) 54)
|
||||
(check-equal? (equal-secondary-hash-code (tuple 5)) 45))
|
||||
|
|
|
|||
|
|
@ -16,5 +16,5 @@
|
|||
(check-false (equal? (kons 1 2) 2))
|
||||
(check-false (equal? 2 (kons 1 2)))
|
||||
(check-false (equal? (kons 1 2) (kons 3 4)))
|
||||
(check-equal? (equal-hash-code (kons 1 2)) 62)
|
||||
(check-equal? (equal-hash-code (kons 1 2)) 61)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,35 +1,22 @@
|
|||
-----BEGIN CERTIFICATE-----
|
||||
MIIGGDCCBACgAwIBAgIJAIoDto5pw5l0MA0GCSqGSIb3DQEBCwUAMIGXMQswCQYD
|
||||
VQQGEwJVUzEQMA4GA1UECAwHUmFja2V0YTEUMBIGA1UEBwwLUmFja2V0dmlsbGUx
|
||||
GTAXBgNVBAoMEFRlc3RpbmcgRXhhbXBsZXMxEDAOBgNVBAsMB1Rlc3RpbmcxFDAS
|
||||
BgNVBAMMC2V4YW1wbGUuY29tMR0wGwYJKoZIhvcNAQkBFg5jYUBleGFtcGxlLmNv
|
||||
bTAgFw0xNjAzMTEyMjAzMjdaGA8yMjE2MDEyMzIyMDMyN1owgZcxCzAJBgNVBAYT
|
||||
AlVTMRAwDgYDVQQIDAdSYWNrZXRhMRQwEgYDVQQHDAtSYWNrZXR2aWxsZTEZMBcG
|
||||
A1UECgwQVGVzdGluZyBFeGFtcGxlczEQMA4GA1UECwwHVGVzdGluZzEUMBIGA1UE
|
||||
AwwLZXhhbXBsZS5jb20xHTAbBgkqhkiG9w0BCQEWDmNhQGV4YW1wbGUuY29tMIIC
|
||||
IjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAqCb9pHvY/xnaKDT7DAHAdahs
|
||||
mxKEtUtcEGpytYWqJUQWGtahN7GwLgFJkkkNi/A7X/Nzz3gLrTn9AryTz1wYwnUI
|
||||
bNek3HsiMkHRKt+EptxHGCnbhVRP/bWkbV/kd+HYlQfES9wZk0P/uO/4U4Sheb0K
|
||||
c00Cyso64Bi4KjQFu6pDeaq9dD/8GBwqfCd5JD7+n7v3Q/LmkP4+n2FFVPb8eAJQ
|
||||
SjToRRt0zDT1RIYfjZVgw2BrRHLbVt+angWGqMr0/6SORt4Oy9WhB9ttGj/PJlxX
|
||||
H9FQCRbbx9iOzUwUX2RSvxhnv4r41nWugVdO2ngs/b9v2LhzMFSkKYH9m1doInRh
|
||||
rX3xxJir4mlr/mw28S3Ho4Y7VCbsvr6vtdSWpYL9dMdOYJSS7WZ+uFkLB7sZzkxG
|
||||
K03tG+rkpk0wt+3ZBvaNI9A2xQiACPQUa2rrks4u5ppgApcNTk4xgUrLOCFqxMC+
|
||||
fFyNjEYl7peggMOPW44q5n81c7UuP4RsQAqj3coAFhrs5I3UfgOjtTleEDzp9vq6
|
||||
q4p6i6dFBSqKJcXF01onKfEkMz0Mh/4i8exztwNzIrVuzcSnXKTLiOiPHFbcMdS2
|
||||
hvwyyiqLOnAvIeJ1Vu+o8gSnaXmY0au6iQz6I8n5Sptsh+vkJxZg4rVYonAOmqiW
|
||||
gHal923T9r//tB1MwOsCAwEAAaNjMGEwHQYDVR0OBBYEFMMkXbk8vqA3jSkCaqpz
|
||||
DvIx1NPOMB8GA1UdIwQYMBaAFMMkXbk8vqA3jSkCaqpzDvIx1NPOMA8GA1UdEwEB
|
||||
/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgGGMA0GCSqGSIb3DQEBCwUAA4ICAQAORfTD
|
||||
zPBdvURtSGqiXN/WPU4gw6MSbeB8cr4E4pEPrizA07XW4wj23/x59STyZNl6ed7F
|
||||
9pYSz9E4Op4BNGFa7EqTd6FzSBLW4w4j1S45+bOsGoJynSLaQ7EmtP31yMeEF4tM
|
||||
6pzWT35GIzhHK1EWSZHNglQPcD/Ype51AvUVRN/xf3icsc9scU+sLuZdd2G4sKkS
|
||||
JvJX+k2Kwe38KCR8ZzGXzJCs33eTYBCkjzaNxe9JOhp9R6m535YkOFlxVYxNSgLp
|
||||
mfQsRMTwpV1wyoPCn73cYN10WkrtN2JeddfyjtqzDSy+xQ8cglALokStIWEqP+Zm
|
||||
i7ovDxsuBc4Xs4433ek3xDnwquCwkq4TlG1fbSvjSBaDeWmGIOoF7Mxo5uv3v0gE
|
||||
YWNP8cHXuNE1V0peGwMPruUt9otpj4K9NrXTstkx3XBjgPMuVb3le1DRldd5Bwde
|
||||
FusziX44IonAn63h2wYNv1ii+zV4cmbiaB1Ugp1GOV11oLmwSbnYT2kQ8uhdU0OF
|
||||
1bLIe+tssAQzVKNUMgHKTsczdpzlRYiZ6hwoGyymYtV7l4pbwEb8ctBivzx4fe70
|
||||
PwP5qQAFZfDWnVlRZNOxKoxYl9/DORtMhZqGjQMm4DreV+vz1RbTyEzSl+1ncxKF
|
||||
UlW6PRzPhjJE8wt19KXLFZ+6oATODmh7sGuGhQ==
|
||||
MIIDnTCCAoWgAwIBAgIJAI1o0DxhqPigMA0GCSqGSIb3DQEBBAUAMIGEMRQwEgYD
|
||||
VQQDEwtva2NvbXBzLmNvbTELMAkGA1UECBMCT0gxCzAJBgNVBAYTAlVTMR8wHQYJ
|
||||
KoZIhvcNAQkBFhByb290QG9rY29tcHMuY29tMRkwFwYDVQQKExBPSyBDb21wdXRl
|
||||
cnMgTExDMRYwFAYDVQQLEw1JVCBEZXBhcnRtZW50MB4XDTExMDEyMTEzMTEwNloX
|
||||
DTE2MDEyMDEzMTEwNlowgYQxFDASBgNVBAMTC29rY29tcHMuY29tMQswCQYDVQQI
|
||||
EwJPSDELMAkGA1UEBhMCVVMxHzAdBgkqhkiG9w0BCQEWEHJvb3RAb2tjb21wcy5j
|
||||
b20xGTAXBgNVBAoTEE9LIENvbXB1dGVycyBMTEMxFjAUBgNVBAsTDUlUIERlcGFy
|
||||
dG1lbnQwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDTouNqzEoG/eof
|
||||
H75hyNEd7VFRjbBddbu1194eCzfqmiNYacTx8Xhphf9fRNkR5Bznz5dfIrzFqvBJ
|
||||
dv4H5BZrZ4cGqDLOdYQtxPdgq5DzfsjIxtck9XKEyZSfV/K2gm1mnqtJ/fYiL2Wm
|
||||
Oawrjgtvm3rS/3p0kk/vlS74VfuUX68/S+DgfUX3dvrKXqJn4skcxy1cEt+8GBsH
|
||||
CsfwZC3oh+Oi2HO9bmMatp0OgxvuEyc3cwTbdR9JWOs/7eQeGIp6zYwChJqpajSM
|
||||
WfwBfY+oQazZrZGbVY+MDPHGD7QTdHn8P0RPCqZpz3f7RnL3Emc1XXGuZBnRa7sv
|
||||
KWUsCiP9AgMBAAGjEDAOMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEEBQADggEB
|
||||
AF6ifcd9/uawOKBAvhMrAS7gTFHXSdc+KoVlPp4SM6+6rllrmxGoGrvXv2NQKjiG
|
||||
4Vz0AENCk5vd/i8U2+wkBXnDQFE2ckZwiao33Z4FBq1BYtOP3+mxcg9DDuz2fywn
|
||||
LCRBVVVeTXEdoAs3kzMjArPGCP4nXzyGD8zQDv9pcSHJfafPf45Sf1QHhPIm8DdL
|
||||
Z2uQQ9aZwMPQwWjVEhPIbB2eXLnRMEMH9JE9mKEhN+epKljyLDADXs+bSkg3QMaT
|
||||
d3Bqv9wjBrH2tztqVkq0os0tRFUlVPB6g0ave0Dgp99LolbQJbYlGas6CISS6ueD
|
||||
plEJK3Mrw7v832Wqnjx8vhE=
|
||||
-----END CERTIFICATE-----
|
||||
|
|
|
|||
|
|
@ -1,27 +1,67 @@
|
|||
Certificate:
|
||||
Data:
|
||||
Version: 3 (0x2)
|
||||
Serial Number: 4 (0x4)
|
||||
Signature Algorithm: md5WithRSAEncryption
|
||||
Issuer: CN=okcomps.com, ST=OH, C=US/emailAddress=root@okcomps.com, O=OK Computers LLC, OU=IT Department
|
||||
Validity
|
||||
Not Before: Jan 22 16:49:23 2011 GMT
|
||||
Not After : Jan 21 16:49:23 2016 GMT
|
||||
Subject: CN=testclient.okcomps.com, ST=OH, C=US/emailAddress=root@okcomps.com, O=OK Computers LLC, OU=IT
|
||||
Subject Public Key Info:
|
||||
Public Key Algorithm: rsaEncryption
|
||||
RSA Public Key: (1024 bit)
|
||||
Modulus (1024 bit):
|
||||
00:e3:a1:8c:40:df:26:a5:52:31:f2:65:94:fa:f3:
|
||||
32:1a:a1:d1:06:e3:32:f4:ae:17:27:38:49:c4:8f:
|
||||
f0:6a:61:4a:b1:12:a8:ff:22:5e:a8:b8:d2:be:24:
|
||||
83:1d:48:e4:62:8d:b8:a3:a0:b7:68:d2:dc:53:11:
|
||||
fd:cd:87:67:7e:30:76:41:18:d4:97:7d:4f:75:8c:
|
||||
b3:17:6a:d4:5f:e2:fa:4c:c3:e0:a5:2b:d5:b2:f0:
|
||||
9a:fc:8c:ec:fb:99:8c:51:b0:62:54:91:c2:64:d1:
|
||||
79:41:da:8f:88:40:76:81:29:d0:0a:f7:63:51:76:
|
||||
7a:23:f1:ca:57:d1:0e:1b:b5
|
||||
Exponent: 65537 (0x10001)
|
||||
X509v3 extensions:
|
||||
X509v3 Subject Alternative Name:
|
||||
DNS:alt.tradeshowhell.com
|
||||
X509v3 Basic Constraints:
|
||||
CA:FALSE
|
||||
Netscape Cert Type:
|
||||
SSL Client
|
||||
Signature Algorithm: md5WithRSAEncryption
|
||||
d0:1c:c8:74:87:06:0b:96:3d:05:4e:19:e4:19:9e:0a:12:76:
|
||||
57:c7:a3:24:34:dd:af:e9:67:cd:99:2a:43:d7:e6:b6:18:eb:
|
||||
b4:b0:63:be:e6:d8:ff:99:95:81:a7:88:b9:68:b9:0e:2f:cb:
|
||||
2b:2b:7c:0e:c4:66:d3:f4:89:91:ba:03:0a:35:e1:6b:19:0e:
|
||||
41:c8:f3:3c:bf:47:c1:60:ee:88:74:0a:41:08:4e:82:be:ae:
|
||||
46:b0:31:8d:f8:10:84:1a:af:03:52:39:87:b7:46:2f:7f:2e:
|
||||
f1:a6:03:4e:3c:bb:ea:0c:08:8f:77:17:b7:c8:d2:a5:a7:a0:
|
||||
56:9b:c8:5b:53:d1:36:01:96:85:46:c9:73:e5:cf:40:8c:fa:
|
||||
b2:c1:be:3e:8f:24:97:c3:35:ec:45:59:b3:f4:9b:3f:b0:50:
|
||||
5d:2b:d3:19:11:c6:5d:c1:61:26:db:34:4a:69:46:5a:c1:f2:
|
||||
43:f9:5a:4d:71:44:2a:62:28:c0:ac:51:63:35:88:cc:6d:9a:
|
||||
db:7b:d1:a1:a2:e4:86:96:83:48:73:7f:c9:a3:05:e6:46:82:
|
||||
1c:b4:99:9e:7a:b6:1e:87:08:e6:1d:b1:04:0f:ed:19:a6:b1:
|
||||
ce:71:47:ce:73:de:8c:d8:13:aa:a8:6f:b0:04:0c:9b:b7:d1:
|
||||
61:da:90:e3
|
||||
-----BEGIN CERTIFICATE-----
|
||||
MIIEnDCCAoQCAhACMA0GCSqGSIb3DQEBCwUAMIGXMQswCQYDVQQGEwJVUzEQMA4G
|
||||
A1UECAwHUmFja2V0YTEUMBIGA1UEBwwLUmFja2V0dmlsbGUxGTAXBgNVBAoMEFRl
|
||||
c3RpbmcgRXhhbXBsZXMxEDAOBgNVBAsMB1Rlc3RpbmcxFDASBgNVBAMMC2V4YW1w
|
||||
bGUuY29tMR0wGwYJKoZIhvcNAQkBFg5jYUBleGFtcGxlLmNvbTAgFw0xNjAzMTEy
|
||||
MjAzMjhaGA8yMTE4MTExMjIyMDMyOFowgYwxCzAJBgNVBAYTAlVTMRAwDgYDVQQI
|
||||
DAdSYWNrZXRhMRkwFwYDVQQKDBBUZXN0aW5nIEV4YW1wbGVzMRAwDgYDVQQLDAdU
|
||||
ZXN0aW5nMRswGQYDVQQDDBJjbGllbnQuZXhhbXBsZS5jb20xITAfBgkqhkiG9w0B
|
||||
CQEWEmNsaWVudEBleGFtcGxlLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC
|
||||
AQoCggEBAMDIKlIqHrCjgP2Z2TVBFSiYMZ1L4c3GHPFKxx7PLD5Op0t63ngJkY3Z
|
||||
MQY4f4vVh1YxC7m0EfCz1HwpNwCntkHO+SWGe3QPxsKT88/NaHvOxWln2AN18ITX
|
||||
ZOkabEhaCFfwVwEXuoR0lP1R26hSNdDEJ7g0xoXm2xa5bqCLagz6qh09N03XY9wU
|
||||
P63c2V8hGwF5pIBEYIFaV/NLG4Yen/sXbTg92OleCkl66YpRv2XgUc180KPzy53R
|
||||
sEvNiytuNczQf+iQp8QNtkAKYCuftIn6gz94zuZvbbeCxWUnBPLTQQlhnBzDk7hr
|
||||
5Zjhn9LgZEccPrSF10F5T1zzhwm/oT8CAwEAATANBgkqhkiG9w0BAQsFAAOCAgEA
|
||||
BxoEWniRHlfcPaeODLZoOINneZc1Ipv3B59h1rprMZXscr+cKuOvJsnjDASOafrY
|
||||
vmO+ytEBdk+LqxT2AmN0wQHodbwNTKdPfQak4EkNsl9NqMpL9/dlVkjoEnklgeD5
|
||||
zRhGkFoCDXzYh3vTMdo3X5w/j2XZcW1t70b64G5a9319vsfq9qcWLqciSjfPJrq0
|
||||
34ZziHtSya8Xls/AaMpaPnEAUNlUMFNV30EvOWb/QnXExgqjyDkRHRwTiskLT1Or
|
||||
K49K7W8/OtfHHpFMl9l/nyxNT4359dOO9runII5hXbZvy/3P04nHfQ5gz4P4b/Bo
|
||||
Hp0xzoJyDfavI0CjLIZaKn8Ls15xdaVRY3KvhX477mVWEOGsV4p2Na+uZ/nHrAiG
|
||||
tCI8k+TT6L9y+1E6W6SbN0xrebgGwgG1/q6aC3bZamYNPJ/I2h84gBVe2I+eywQW
|
||||
8fo5loaPgHcFvImeaMdx3DcjmIKfzry8Cr2sv6/VNqaKcdak5zpgAHQj5kLlyAuv
|
||||
2tiuW6JQsv9KA4u0MAwESBlycVL7DqZwY69K1Y1WPHKFoBCUkIScuNABFA9mvL+1
|
||||
Ylz3pARDdYkU2JUL54kTD7BkhCBiFGYGP4A6+knSvezpytdp9IQ/tF2ona0ytll+
|
||||
Ka2IZ62rjlyNWDDbQQ67FfaKGZGwiwTlcDIXTqg/LWk=
|
||||
MIIDQzCCAiugAwIBAgIBBDANBgkqhkiG9w0BAQQFADCBhDEUMBIGA1UEAxMLb2tj
|
||||
b21wcy5jb20xCzAJBgNVBAgTAk9IMQswCQYDVQQGEwJVUzEfMB0GCSqGSIb3DQEJ
|
||||
ARYQcm9vdEBva2NvbXBzLmNvbTEZMBcGA1UEChMQT0sgQ29tcHV0ZXJzIExMQzEW
|
||||
MBQGA1UECxMNSVQgRGVwYXJ0bWVudDAeFw0xMTAxMjIxNjQ5MjNaFw0xNjAxMjEx
|
||||
NjQ5MjNaMIGEMR8wHQYDVQQDExZ0ZXN0Y2xpZW50Lm9rY29tcHMuY29tMQswCQYD
|
||||
VQQIEwJPSDELMAkGA1UEBhMCVVMxHzAdBgkqhkiG9w0BCQEWEHJvb3RAb2tjb21w
|
||||
cy5jb20xGTAXBgNVBAoTEE9LIENvbXB1dGVycyBMTEMxCzAJBgNVBAsTAklUMIGf
|
||||
MA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDjoYxA3yalUjHyZZT68zIaodEG4zL0
|
||||
rhcnOEnEj/BqYUqxEqj/Il6ouNK+JIMdSORijbijoLdo0txTEf3Nh2d+MHZBGNSX
|
||||
fU91jLMXatRf4vpMw+ClK9Wy8Jr8jOz7mYxRsGJUkcJk0XlB2o+IQHaBKdAK92NR
|
||||
dnoj8cpX0Q4btQIDAQABo0IwQDAgBgNVHREEGTAXghVhbHQudHJhZGVzaG93aGVs
|
||||
bC5jb20wCQYDVR0TBAIwADARBglghkgBhvhCAQEEBAMCB4AwDQYJKoZIhvcNAQEE
|
||||
BQADggEBANAcyHSHBguWPQVOGeQZngoSdlfHoyQ03a/pZ82ZKkPX5rYY67SwY77m
|
||||
2P+ZlYGniLlouQ4vyysrfA7EZtP0iZG6Awo14WsZDkHI8zy/R8Fg7oh0CkEIToK+
|
||||
rkawMY34EIQarwNSOYe3Ri9/LvGmA048u+oMCI93F7fI0qWnoFabyFtT0TYBloVG
|
||||
yXPlz0CM+rLBvj6PJJfDNexFWbP0mz+wUF0r0xkRxl3BYSbbNEppRlrB8kP5Wk1x
|
||||
RCpiKMCsUWM1iMxtmtt70aGi5IaWg0hzf8mjBeZGghy0mZ56th6HCOYdsQQP7Rmm
|
||||
sc5xR85z3ozYE6qob7AEDJu30WHakOM=
|
||||
-----END CERTIFICATE-----
|
||||
|
|
|
|||
|
|
@ -1,27 +1,15 @@
|
|||
-----BEGIN RSA PRIVATE KEY-----
|
||||
MIIEpAIBAAKCAQEAwMgqUioesKOA/ZnZNUEVKJgxnUvhzcYc8UrHHs8sPk6nS3re
|
||||
eAmRjdkxBjh/i9WHVjELubQR8LPUfCk3AKe2Qc75JYZ7dA/GwpPzz81oe87FaWfY
|
||||
A3XwhNdk6RpsSFoIV/BXARe6hHSU/VHbqFI10MQnuDTGhebbFrluoItqDPqqHT03
|
||||
Tddj3BQ/rdzZXyEbAXmkgERggVpX80sbhh6f+xdtOD3Y6V4KSXrpilG/ZeBRzXzQ
|
||||
o/PLndGwS82LK241zNB/6JCnxA22QApgK5+0ifqDP3jO5m9tt4LFZScE8tNBCWGc
|
||||
HMOTuGvlmOGf0uBkRxw+tIXXQXlPXPOHCb+hPwIDAQABAoIBAAlH2Zm5A183j9cl
|
||||
l+pTZsRch07uP0GbvvrywaE/Ef8x5CXjFWCr/UDZ6t1EzQcbUXeZxtm6zH5M+fa8
|
||||
OTSj3kdOwnnG/px4wfXOD5e6aMRFEQXhBOotvFV41RfPuNTG2M36+QVJciY8Qovr
|
||||
a+qvgn25Y7wfdkst8PAoHyZFb+aN+RkiQLPPcZOYVJPKk8/3cC1j0hcRfluL0ygH
|
||||
KCeQmef+UtBn8bg1msjQQRL9vM3RbGyC/rYbKj3uU0pXT3WzxGu3QOEBgTQx8IB1
|
||||
pku0e/mfaTbiGRn2Xh4zoZPshi3YN31c7jza6NjT3Fq4bJhl88ESpLY4toOFQxwo
|
||||
ktfAJOECgYEA/tgrko+xaNPKfJWoysAiDZF2T/5JZSJ4T+EGx7r0XS/bMX4sudM7
|
||||
iD46JUNz/wavYeAlg2TIufYLz6323u5E/Uc9YAGCMtVHNWqxj6fLLM6qJBKdq6CU
|
||||
8Cd9e7ZhWfMn6eOi8UAff1Yk+rYwXEKOMB4bCbtBE8m4dvjOKxK6mO8CgYEAwafz
|
||||
jbGPRTEw1no1jMBTLyACEvRsTShXYrfE68saj/3uB2ms+7JOFMtPiyI0q439t7Od
|
||||
ogfr1PQ+MQ3tPwWkYgbb3CD1xdrNlk2qtKehmX4u9HNsYapZY3hZCxPyXkpeOrN2
|
||||
zxFzqZ+ks6mWTKp8OPIKOybBF9XlJTKYLHiaXLECgYBMLkTAODI5eu5R1c8yZMMJ
|
||||
OU2b1hEMqYQ7pLIJLMr1vGOS5PvrxMhMDwYEs6hOOSpeYMn2AD+8z19ygreEpsd6
|
||||
yzv+ohTQq07xGebgYbFrwI+93s7BSmybacKqI7fwUq7AzSqdYaTIxPCi/alxOvgU
|
||||
TDua6h4nEysQbYn7+EpNgwKBgQCVT8tnenm+nZjMJVnYdgktEn7G4pIGQ45s3MgG
|
||||
DYkjcGPwbzgisG2ndsKTwgHeLBJtax2k6nqYrOCurdA4gT8nHaay6O7WaEePFb8C
|
||||
nyTn1fSaIcx02QUmvonZEr4SmUBh/jEiopANPruckqsB3Yj91xCwXscOe6q7rXDL
|
||||
CQnrYQKBgQCabbpley7Ln8Ta9T0n1goD4MeLEvbdKpbMYgd69ibrGCt4YM/Oir68
|
||||
HMh0YDi6UnyxvTMWasmyADoIQvI7jHdPDRIZQJ5BDs84Bv2fRLsjXAw/uRNBK0vU
|
||||
CobgqrqaMoD2reaRjjGOJ/LXC+DyrndM1gLsVaOWmYk/J5tvs0Admg==
|
||||
MIICXAIBAAKBgQDjoYxA3yalUjHyZZT68zIaodEG4zL0rhcnOEnEj/BqYUqxEqj/
|
||||
Il6ouNK+JIMdSORijbijoLdo0txTEf3Nh2d+MHZBGNSXfU91jLMXatRf4vpMw+Cl
|
||||
K9Wy8Jr8jOz7mYxRsGJUkcJk0XlB2o+IQHaBKdAK92NRdnoj8cpX0Q4btQIDAQAB
|
||||
AoGAPgUF8abbILAEa8bBkJ4ySI9OJFJCz+ee51CuyJ9vIYzgjN5IrTrwD4hL4wKP
|
||||
tqrljvSOGgbv8d+BqCB+xkDeMT/mFBOyCKrrOX7TSSvVfu9ihRtiy7v2vjodwTNq
|
||||
L82JKscJXTwgR3QrJv6JPb/iZItbweFE4/UWMFDEd7J+dQECQQD5WzSmGTxWdvjx
|
||||
l+jhdVQmA6O87txBPAJP+hAfq/ViAIwVxEeDTBDYKHXBAzIjSpigerG6WkW8AeCQ
|
||||
2aDJOnRHAkEA6bIo+1xwwhZb42kPWiLKhW4bwKM7K7Y3uetQMehu8BOubr6QMHKb
|
||||
QCjz3/e+ldQ3tV9AgcFmp0juZ4YoBTcaIwJAPVZjIAyLHBXN7NfaUENlPKieiWYU
|
||||
RfO1+ehgOPo6tS2/R8dtc+2tIw7o0F6x4Z6C5s7nkxiLmNC5Zcgy1e0MFwJBAIwP
|
||||
WPx9RJ8uI1hCKQ9Odq5NdZiYu+fQx8lHvMKMmaCNSyfYUjaXGXD0mmUK6FCH5fNv
|
||||
6QtbTBjKXwfwoZ+ujJ0CQHAOCJY1vtycRYFh7B+A6Emp/w5aJAqJqS4A79FjCf3N
|
||||
w8MwJrAPTXvKILEnvhuW5uxg5VXqndK/gz+6z/eZyS4=
|
||||
-----END RSA PRIVATE KEY-----
|
||||
|
|
|
|||
|
|
@ -62,10 +62,10 @@
|
|||
(check "Server: Verified ~v~n" (ssl-peer-verified? out) valid?)
|
||||
(check "Server: Verified Peer Subject Name ~v~n" (ssl-peer-subject-name in)
|
||||
(and valid?
|
||||
#"/C=US/ST=Racketa/O=Testing Examples/OU=Testing/CN=client.example.com/emailAddress=client@example.com"))
|
||||
#"/CN=testclient.okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK Computers LLC/OU=IT"))
|
||||
(check "Server: Verified Peer Issuer Name ~v~n" (ssl-peer-issuer-name in)
|
||||
(and valid?
|
||||
#"/C=US/ST=Racketa/L=Racketville/O=Testing Examples/OU=Testing/CN=example.com/emailAddress=ca@example.com"))
|
||||
#"/CN=okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK Computers LLC/OU=IT Department"))
|
||||
(ssl-close ssl-listener)
|
||||
(check "Server: From Client: ~a~n" (read-line in) "yay the connection was made")
|
||||
(close-input-port in)
|
||||
|
|
@ -83,6 +83,7 @@
|
|||
(ssl-load-verify-root-certificates! ssl-client-context cacert)
|
||||
(ssl-set-verify! ssl-client-context #t))
|
||||
|
||||
|
||||
(let-values ([(in out) (ssl-connect "127.0.0.1"
|
||||
55000
|
||||
ssl-client-context)])
|
||||
|
|
@ -95,9 +96,9 @@
|
|||
(check "Client: Verified ~v~n" (ssl-peer-verified? in) valid?)
|
||||
(check "Client: Verified ~v~n" (ssl-peer-verified? out) valid?)
|
||||
(check "Client: Verified Peer Subject Name ~v~n" (ssl-peer-subject-name in)
|
||||
#"/C=US/ST=Racketa/O=Testing Examples/OU=Testing/CN=server.example.com/emailAddress=server@example.com")
|
||||
#"/CN=test.okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK Computers LLC/OU=IT")
|
||||
(check "Client: Verified Peer Issuer Name ~v~n" (ssl-peer-issuer-name in)
|
||||
#"/C=US/ST=Racketa/L=Racketville/O=Testing Examples/OU=Testing/CN=example.com/emailAddress=ca@example.com")
|
||||
#"/CN=okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK Computers LLC/OU=IT Department")
|
||||
|
||||
(write-string (format "yay the connection was made~n") out)
|
||||
(close-input-port in)
|
||||
|
|
|
|||
|
|
@ -1,35 +1,67 @@
|
|||
Certificate:
|
||||
Data:
|
||||
Version: 3 (0x2)
|
||||
Serial Number: 1 (0x1)
|
||||
Signature Algorithm: md5WithRSAEncryption
|
||||
Issuer: CN=okcomps.com, ST=OH, C=US/emailAddress=root@okcomps.com, O=OK Computers LLC, OU=IT Department
|
||||
Validity
|
||||
Not Before: Jan 21 13:19:20 2011 GMT
|
||||
Not After : Jan 20 13:19:20 2016 GMT
|
||||
Subject: CN=test.okcomps.com, ST=OH, C=US/emailAddress=root@okcomps.com, O=OK Computers LLC, OU=IT
|
||||
Subject Public Key Info:
|
||||
Public Key Algorithm: rsaEncryption
|
||||
RSA Public Key: (1024 bit)
|
||||
Modulus (1024 bit):
|
||||
00:ca:d0:a2:7c:5d:0c:bc:df:3b:1c:d2:b7:d4:b3:
|
||||
68:12:1b:3a:df:5e:75:f6:9f:71:1a:b2:29:76:e7:
|
||||
55:eb:2d:d2:cf:c1:a7:2f:54:91:68:cc:f0:ce:10:
|
||||
42:d4:d2:82:0d:56:f0:16:aa:a8:a4:f3:4f:c3:f7:
|
||||
55:3c:a0:90:c3:a9:04:63:86:90:7f:64:49:77:0d:
|
||||
9b:7b:02:e2:04:ec:52:08:c4:01:72:e4:e6:89:18:
|
||||
f6:fc:cc:8d:b6:9b:24:f4:c6:a9:78:67:e4:15:d4:
|
||||
68:1e:da:67:4f:d9:40:48:44:f0:9a:ae:5a:87:24:
|
||||
2a:b5:2e:83:d6:ad:f4:e5:9b
|
||||
Exponent: 65537 (0x10001)
|
||||
X509v3 extensions:
|
||||
X509v3 Subject Alternative Name:
|
||||
DNS:alt.tradeshowhell.com
|
||||
X509v3 Basic Constraints:
|
||||
CA:FALSE
|
||||
Netscape Cert Type:
|
||||
SSL Server
|
||||
Signature Algorithm: md5WithRSAEncryption
|
||||
ab:c9:75:73:f9:79:31:34:b9:3b:83:2f:3f:9e:4e:33:01:98:
|
||||
37:9b:bd:08:d6:14:ea:d9:a1:fa:7a:0d:ae:dc:00:fd:a6:01:
|
||||
ba:3e:d6:ed:8b:8d:43:ba:41:51:08:c6:c5:db:84:34:34:07:
|
||||
17:19:35:5d:8c:7f:37:b8:c1:02:c3:22:d9:dc:f4:85:4d:1c:
|
||||
6e:44:43:0d:7a:5a:de:4c:ba:a3:4b:a3:9b:07:3a:dd:f0:69:
|
||||
3d:89:65:e4:0d:f6:0d:04:58:00:74:b6:11:5e:e2:a7:1c:8d:
|
||||
d4:83:e3:9b:93:85:f7:d1:7c:5f:67:0c:38:02:1f:d6:44:0d:
|
||||
73:22:5f:d2:ff:e1:ef:be:11:e4:e7:1c:b7:d6:8b:b6:78:bb:
|
||||
09:e1:46:94:48:24:98:88:b2:6d:27:2a:85:5a:cd:34:b5:c4:
|
||||
74:1b:58:97:f8:4a:aa:13:e1:13:4d:86:80:36:b2:9a:31:3a:
|
||||
be:3f:c7:1b:76:71:e9:b5:7d:4b:61:9b:59:ad:c7:1b:2e:b8:
|
||||
7c:bd:6f:f8:06:44:eb:7b:fd:53:45:b0:fa:a4:37:b4:56:e2:
|
||||
87:ba:d4:5c:49:db:7d:31:a4:42:d3:d7:47:a3:6f:cb:e3:9d:
|
||||
5c:be:2e:eb:1b:0a:06:e2:ce:d6:c4:81:c2:c1:85:36:dc:4c:
|
||||
03:5b:b3:14
|
||||
-----BEGIN CERTIFICATE-----
|
||||
MIIGDzCCA/egAwIBAgICEAAwDQYJKoZIhvcNAQELBQAwgZcxCzAJBgNVBAYTAlVT
|
||||
MRAwDgYDVQQIDAdSYWNrZXRhMRQwEgYDVQQHDAtSYWNrZXR2aWxsZTEZMBcGA1UE
|
||||
CgwQVGVzdGluZyBFeGFtcGxlczEQMA4GA1UECwwHVGVzdGluZzEUMBIGA1UEAwwL
|
||||
ZXhhbXBsZS5jb20xHTAbBgkqhkiG9w0BCQEWDmNhQGV4YW1wbGUuY29tMCAXDTE2
|
||||
MDMxMTIyMDMyN1oYDzIxMTgxMTEyMjIwMzI3WjCBjDELMAkGA1UEBhMCVVMxEDAO
|
||||
BgNVBAgMB1JhY2tldGExGTAXBgNVBAoMEFRlc3RpbmcgRXhhbXBsZXMxEDAOBgNV
|
||||
BAsMB1Rlc3RpbmcxGzAZBgNVBAMMEnNlcnZlci5leGFtcGxlLmNvbTEhMB8GCSqG
|
||||
SIb3DQEJARYSc2VydmVyQGV4YW1wbGUuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOC
|
||||
AQ8AMIIBCgKCAQEAxwtM2E82qRxm1OH5LkGh+Ad5lHB55hBGY+Ge/xJWyoLaWnNf
|
||||
DjeyJ7l7eutUw4lDy1qnyg4oTPdzB5kR9v01f4W3AVAZd3j+Ea7lKhrsh7UHhZOb
|
||||
N5v8/Evnmom2nWbGHqMeHMp8eatNr/RcsKX/NxUnSOMHROc1Ih9YCTsZBEW+QIQ3
|
||||
73pc394PEM4cXGSf2QkL2Ej/uan7LnAXgofTYAYf9olrItyvMDPXAg24CYV2YjOR
|
||||
I41F09OyUb0rSIvXHsgg95xXQp63SgrBJ70FtMw47qd36AqEPpvAYZBfDKuZwxBM
|
||||
82VvWlNK8eQXJsWed05VjzEpR7ohuTthvgaXfwIDAQABo4IBajCCAWYwCQYDVR0T
|
||||
BAIwADARBglghkgBhvhCAQEEBAMCBkAwMwYJYIZIAYb4QgENBCYWJE9wZW5TU0wg
|
||||
R2VuZXJhdGVkIFNlcnZlciBDZXJ0aWZpY2F0ZTAdBgNVHQ4EFgQUnuY2r6AUzT6X
|
||||
a3tJWZ8WFQoWgQQwgcwGA1UdIwSBxDCBwYAUwyRduTy+oDeNKQJqqnMO8jHU086h
|
||||
gZ2kgZowgZcxCzAJBgNVBAYTAlVTMRAwDgYDVQQIDAdSYWNrZXRhMRQwEgYDVQQH
|
||||
DAtSYWNrZXR2aWxsZTEZMBcGA1UECgwQVGVzdGluZyBFeGFtcGxlczEQMA4GA1UE
|
||||
CwwHVGVzdGluZzEUMBIGA1UEAwwLZXhhbXBsZS5jb20xHTAbBgkqhkiG9w0BCQEW
|
||||
DmNhQGV4YW1wbGUuY29tggkAigO2jmnDmXQwDgYDVR0PAQH/BAQDAgWgMBMGA1Ud
|
||||
JQQMMAoGCCsGAQUFBwMBMA0GCSqGSIb3DQEBCwUAA4ICAQBtdUfWn4C9ezYKMlo8
|
||||
T+BVrDfGW4Cudygt4ckzhUhv6JxYmB3Z74VV0aVwx3Rb6BgBxbs7CjD3RU00IT8c
|
||||
SzLBVz8UMIttlu2B2EgKcpek/n+/PEp/TNGbK0DoSYyrmyzgEdv70/GMEziDcWxt
|
||||
K1577l+0IZEIXvVmjL9RXz2peaPNz5chGxTPrwwN08Ps6XPgtTzt1GpDDTow1jLR
|
||||
eZ8B+X6N1mNaXDQJdGXJek+VVss/lqUcXIOeVgyn8nJKmPrTT/drD7Y8JK+v2MIm
|
||||
AxMntYPi8YysgMmfSWZbReKaz0AkpCK0Fz/LAJmwYsbQ3F7BmU+dvjIy4BR0kj4L
|
||||
3MbbiDkoGOkAFrkz0GF0YqUgkkh9azzq5gxX1Q14xLrfHgdPIaVxJileQ1UJ8UJd
|
||||
m3uM7SuVFrtw4Al+OtWnlt/iWX71ERc07z3Y3LVTg++AS2sEmGvVdRge53uyCN79
|
||||
0g/3ZOL74k6/v0fE40qoo8VzZFLpXDaR73ITwcG6OwLWvEhd/RzovzOTPHrUnqJK
|
||||
rtVH81gMAdQ0eHhWtY312gAv9jyHCrtuUUD4n+sFv8yWkFm7ND2F7KrP2pgPX8z1
|
||||
WM8dPIChyjPFQHiAfp73Xl+DFJ85fqQq5FoaoFE562x2sj0LS8wC6FjGwMSKfy8s
|
||||
Z1z/rPg6199Dz4Nng87yTq6fAA==
|
||||
MIIDPDCCAiSgAwIBAgIBATANBgkqhkiG9w0BAQQFADCBhDEUMBIGA1UEAxMLb2tj
|
||||
b21wcy5jb20xCzAJBgNVBAgTAk9IMQswCQYDVQQGEwJVUzEfMB0GCSqGSIb3DQEJ
|
||||
ARYQcm9vdEBva2NvbXBzLmNvbTEZMBcGA1UEChMQT0sgQ29tcHV0ZXJzIExMQzEW
|
||||
MBQGA1UECxMNSVQgRGVwYXJ0bWVudDAeFw0xMTAxMjExMzE5MjBaFw0xNjAxMjAx
|
||||
MzE5MjBaMH4xGTAXBgNVBAMTEHRlc3Qub2tjb21wcy5jb20xCzAJBgNVBAgTAk9I
|
||||
MQswCQYDVQQGEwJVUzEfMB0GCSqGSIb3DQEJARYQcm9vdEBva2NvbXBzLmNvbTEZ
|
||||
MBcGA1UEChMQT0sgQ29tcHV0ZXJzIExMQzELMAkGA1UECxMCSVQwgZ8wDQYJKoZI
|
||||
hvcNAQEBBQADgY0AMIGJAoGBAMrQonxdDLzfOxzSt9SzaBIbOt9edfafcRqyKXbn
|
||||
Vest0s/Bpy9UkWjM8M4QQtTSgg1W8BaqqKTzT8P3VTygkMOpBGOGkH9kSXcNm3sC
|
||||
4gTsUgjEAXLk5okY9vzMjbabJPTGqXhn5BXUaB7aZ0/ZQEhE8JquWockKrUug9at
|
||||
9OWbAgMBAAGjQjBAMCAGA1UdEQQZMBeCFWFsdC50cmFkZXNob3doZWxsLmNvbTAJ
|
||||
BgNVHRMEAjAAMBEGCWCGSAGG+EIBAQQEAwIGQDANBgkqhkiG9w0BAQQFAAOCAQEA
|
||||
q8l1c/l5MTS5O4MvP55OMwGYN5u9CNYU6tmh+noNrtwA/aYBuj7W7YuNQ7pBUQjG
|
||||
xduENDQHFxk1XYx/N7jBAsMi2dz0hU0cbkRDDXpa3ky6o0ujmwc63fBpPYll5A32
|
||||
DQRYAHS2EV7ipxyN1IPjm5OF99F8X2cMOAIf1kQNcyJf0v/h774R5Occt9aLtni7
|
||||
CeFGlEgkmIiybScqhVrNNLXEdBtYl/hKqhPhE02GgDaymjE6vj/HG3Zx6bV9S2Gb
|
||||
Wa3HGy64fL1v+AZE63v9U0Ww+qQ3tFbih7rUXEnbfTGkQtPXR6Nvy+OdXL4u6xsK
|
||||
BuLO1sSBwsGFNtxMA1uzFA==
|
||||
-----END CERTIFICATE-----
|
||||
|
|
|
|||
|
|
@ -1,35 +1,14 @@
|
|||
-----BEGIN CERTIFICATE-----
|
||||
MIIGETCCA/mgAwIBAgICEAEwDQYJKoZIhvcNAQELBQAwgZcxCzAJBgNVBAYTAlVT
|
||||
MRAwDgYDVQQIDAdSYWNrZXRhMRQwEgYDVQQHDAtSYWNrZXR2aWxsZTEZMBcGA1UE
|
||||
CgwQVGVzdGluZyBFeGFtcGxlczEQMA4GA1UECwwHVGVzdGluZzEUMBIGA1UEAwwL
|
||||
ZXhhbXBsZS5jb20xHTAbBgkqhkiG9w0BCQEWDmNhQGV4YW1wbGUuY29tMCAXDTE2
|
||||
MDMxMTIyMDMyN1oYDzIxMTgxMTEyMjIwMzI3WjCBjjELMAkGA1UEBhMCVVMxEDAO
|
||||
BgNVBAgMB1JhY2tldGExGTAXBgNVBAoMEFRlc3RpbmcgRXhhbXBsZXMxEDAOBgNV
|
||||
BAsMB1Rlc3RpbmcxHDAaBgNVBAMME3NlcnZlcjIuZXhhbXBsZS5jb20xIjAgBgkq
|
||||
hkiG9w0BCQEWE3NlcnZlcjJAZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUA
|
||||
A4IBDwAwggEKAoIBAQDHC0zYTzapHGbU4fkuQaH4B3mUcHnmEEZj4Z7/ElbKgtpa
|
||||
c18ON7InuXt661TDiUPLWqfKDihM93MHmRH2/TV/hbcBUBl3eP4RruUqGuyHtQeF
|
||||
k5s3m/z8S+eaibadZsYeox4cynx5q02v9Fywpf83FSdI4wdE5zUiH1gJOxkERb5A
|
||||
hDfvelzf3g8QzhxcZJ/ZCQvYSP+5qfsucBeCh9NgBh/2iWsi3K8wM9cCDbgJhXZi
|
||||
M5EjjUXT07JRvStIi9ceyCD3nFdCnrdKCsEnvQW0zDjup3foCoQ+m8BhkF8Mq5nD
|
||||
EEzzZW9aU0rx5BcmxZ53TlWPMSlHuiG5O2G+Bpd/AgMBAAGjggFqMIIBZjAJBgNV
|
||||
HRMEAjAAMBEGCWCGSAGG+EIBAQQEAwIGQDAzBglghkgBhvhCAQ0EJhYkT3BlblNT
|
||||
TCBHZW5lcmF0ZWQgU2VydmVyIENlcnRpZmljYXRlMB0GA1UdDgQWBBSe5javoBTN
|
||||
Ppdre0lZnxYVChaBBDCBzAYDVR0jBIHEMIHBgBTDJF25PL6gN40pAmqqcw7yMdTT
|
||||
zqGBnaSBmjCBlzELMAkGA1UEBhMCVVMxEDAOBgNVBAgMB1JhY2tldGExFDASBgNV
|
||||
BAcMC1JhY2tldHZpbGxlMRkwFwYDVQQKDBBUZXN0aW5nIEV4YW1wbGVzMRAwDgYD
|
||||
VQQLDAdUZXN0aW5nMRQwEgYDVQQDDAtleGFtcGxlLmNvbTEdMBsGCSqGSIb3DQEJ
|
||||
ARYOY2FAZXhhbXBsZS5jb22CCQCKA7aOacOZdDAOBgNVHQ8BAf8EBAMCBaAwEwYD
|
||||
VR0lBAwwCgYIKwYBBQUHAwEwDQYJKoZIhvcNAQELBQADggIBAAXT2DwEkIZu3EsJ
|
||||
9seWfunZ2Two9G1BHaT4LzVMLiYejBVlV4MTjj4RYYToH6oGbpL+XefInZTlecUB
|
||||
FZjLcLFNoSKvNLMyUGwM5uC89i5W6l8/MIRw1L+GB5xVcbNIMp0EYQlTnoy7k3NF
|
||||
7NNU3rThr/kRuFndjZ7k3QN5uTcnkFqGwtWFM+yHcOq4fnJUA6y9gniEDnXXF8x+
|
||||
FRfcsKsQrqEyUGXiXrThUGtQd6j4oUdYdsN1HTTX1QPVMYZ8Qp62Fl9M+g5ZQJzG
|
||||
ON1+f+c5m0xGK/5lb5ugWeld/45coavXGn48ev5jfiW8D7jJl4owooB6at5xDxRJ
|
||||
+G3k3JfZpRNdUyahE4TBk+Ml8mKPYeiYs3Zfgs3ggubzZxoUyc0lGZquQLOZtLtq
|
||||
uXqH7abLgflVBsf9edkQw0asN4axLVMIuYtpuxP5UcIjlYx1hyAxfidiIZbzfAND
|
||||
0L1UPPlDG4Yf3ClAM875fyUz+xWe6FrVANTq1hWTI5azwXCQ5ucpfwNT2Tbos+/y
|
||||
oX6sVvWfs8qQd1whWHzFksj6jf9Wdiz95tyj5b0QcvP9BrPCGd94TXvNuecg8ZMw
|
||||
wF3S4Qo9P9LrhWhFFrPZQkzKbdtIrCaR16d7lzue1qLXMHR3NfqUzk0IswNlV10T
|
||||
IwkCwD3IE2RiB59HUJqv8y9JKr/P
|
||||
MIICETCCAXoCCQChYEk8e/hBbjANBgkqhkiG9w0BAQUFADBNMQswCQYDVQQGEwJV
|
||||
UzELMAkGA1UECAwCTUExDzANBgNVBAcMBkJvc3RvbjENMAsGA1UECgwEVGVzdDER
|
||||
MA8GA1UEAwwIdGVzdC5jb20wHhcNMTQwNTA5MTQ1NjQwWhcNMTcwMjAyMTQ1NjQw
|
||||
WjBNMQswCQYDVQQGEwJVUzELMAkGA1UECAwCTUExDzANBgNVBAcMBkJvc3RvbjEN
|
||||
MAsGA1UECgwEVGVzdDERMA8GA1UEAwwIdGVzdC5jb20wgZ8wDQYJKoZIhvcNAQEB
|
||||
BQADgY0AMIGJAoGBAMrQonxdDLzfOxzSt9SzaBIbOt9edfafcRqyKXbnVest0s/B
|
||||
py9UkWjM8M4QQtTSgg1W8BaqqKTzT8P3VTygkMOpBGOGkH9kSXcNm3sC4gTsUgjE
|
||||
AXLk5okY9vzMjbabJPTGqXhn5BXUaB7aZ0/ZQEhE8JquWockKrUug9at9OWbAgMB
|
||||
AAEwDQYJKoZIhvcNAQEFBQADgYEASX12GYExD+DqEpxykXGmfJ5d608EmlTgSaCr
|
||||
EQCqo5xKkf1hqVIMVKfuiJ45nYhZ12t8+un2GKp7+ZZfn+pk7MJtb5TeH40JsLZr
|
||||
wb1WZ2jx4sjSBwiosxgAUtcdbOgxOha71SdhxPDMhBHLG25kq8gf0gFCo/4fcSNM
|
||||
Ax1QFNs=
|
||||
-----END CERTIFICATE-----
|
||||
|
|
|
|||
|
|
@ -1,27 +1,15 @@
|
|||
-----BEGIN RSA PRIVATE KEY-----
|
||||
MIIEpgIBAAKCAQEAxwtM2E82qRxm1OH5LkGh+Ad5lHB55hBGY+Ge/xJWyoLaWnNf
|
||||
DjeyJ7l7eutUw4lDy1qnyg4oTPdzB5kR9v01f4W3AVAZd3j+Ea7lKhrsh7UHhZOb
|
||||
N5v8/Evnmom2nWbGHqMeHMp8eatNr/RcsKX/NxUnSOMHROc1Ih9YCTsZBEW+QIQ3
|
||||
73pc394PEM4cXGSf2QkL2Ej/uan7LnAXgofTYAYf9olrItyvMDPXAg24CYV2YjOR
|
||||
I41F09OyUb0rSIvXHsgg95xXQp63SgrBJ70FtMw47qd36AqEPpvAYZBfDKuZwxBM
|
||||
82VvWlNK8eQXJsWed05VjzEpR7ohuTthvgaXfwIDAQABAoIBAQC7FkQEjXAzRB7j
|
||||
ugMdF1PGbkA45f+t315KQ6fO2M37S0MyAX83PeKWtCD8SHZD1KGEYpGTufrnXS8h
|
||||
1R6tqRK/6k85TLCjO3aT6HA+Q1BPvjhztWoPuu7vtejbuNWM3S0bXvbO2QRm2D0N
|
||||
RgJZh617eMaUG9CZUzj9+bgl9QZum/T7lE0IQvel2hUCQPNAfdm11hFzDPLBUkMy
|
||||
N+h5VhMLfBbYd8YxS2m+/9V0UMcQjwsCGsk75dGQ0jUJjiMDXBYXMqMGCVZd0LYQ
|
||||
JNMx0GqaSFj5LsR2CPMY2M3xn9ulh13vgSNBxprjH4XaLSpujEtZIqm7bPUaL7n/
|
||||
IeGliaoBAoGBAPjIxLf+Dp3EepcSpOERlVhpSzjSXPyz1v/k+ZwUeBn8urzAsrNs
|
||||
9Q9dWthAAmIQorUpgG/iizkVQm1dXhxzR47DlFSCfsn9g1JdEHRLt0bWq38YwPb5
|
||||
OctGEFsqchrNpvonb1iBaQuCZesLw29Hwm3x6jpoPyhkgEgVRAL3/n+ZAoGBAMzR
|
||||
NbB/YnATd/hXK81OVEpHx6KT9W4Emz3DCIYhVX2rk5b9ZDirl3QpHcwjoX9TW6iM
|
||||
MQV/lRPU5MLHJH3N9MibzDnNoiejXYoGiFEFXcxBQeSEnPi79WOV86EEIHji+oCG
|
||||
4viwUNnDNFo06Oo/3ZRfKmC2WBGdQTarbkHicZ7XAoGBAK17MtIqsv6I+ANI2Pip
|
||||
Tj8sjWu+JWGB9rbScMzJ6UYV2hGtPe+oVuqz6plJaWAAwbUaj5l1nCfeD0g8B1hH
|
||||
euqur0yPAuLPiTdx9ftioRcgss4Z8NVHzWlWHim0W4UdSwa9YQOSmjGQaImS1mFO
|
||||
5OHOA8tezkvYaSvayGZZkHphAoGBALytuaz3HGKsvKcM/q/qCaJID7NIZB7OpYg2
|
||||
4+JUUOItLhA5K5s9D4+V1PpalIqr6tMRGpO7HUUgqQB53bb7BRXM2E0jjs6/Iwtk
|
||||
yy0AKZFhSGdQdx54YC02VTIukA9s4WGHYQ3Btyl0NwUmmq442VG2fV6MfAL1/75y
|
||||
HGcbSJoPAoGBALnnFpCr1BT2ogcDXdUWPTmKMde4QZOM0O7DguTEkSFtPdjlijhn
|
||||
TButsiroGsC44gYi+wbll9mmaj6ZjCVclH7Z9lbvoZQxYiis/hD/eH8HR0yyFsp/
|
||||
MMyX3yCv+fawwKGU1eZQSijz38lGNBvM/hWhc8vFSycaarrEaE5wcjcw
|
||||
MIICXQIBAAKBgQDK0KJ8XQy83zsc0rfUs2gSGzrfXnX2n3Easil251XrLdLPwacv
|
||||
VJFozPDOEELU0oINVvAWqqik80/D91U8oJDDqQRjhpB/ZEl3DZt7AuIE7FIIxAFy
|
||||
5OaJGPb8zI22myT0xql4Z+QV1Gge2mdP2UBIRPCarlqHJCq1LoPWrfTlmwIDAQAB
|
||||
AoGAN2HRfPRLzieHFM/Vsxdqi8czxFsfC0FuuUN9XyK8q4PP1TukU6BcNKoB98Mo
|
||||
/MSfDtV2qjnf42stlO2tMOkHnmkx6Kz/aoiG7rfPjVqRVOy+LZ6HZj5bxaIC0WkF
|
||||
2RbuHB2pLmrZGfQI0F/aFQpUQCqM4S4e1SDBxAyygtzkaUECQQD7pqWpXQ+VjejK
|
||||
/Gd8hNPQk71vziJsXn3fVVa0aYxh8WapbvQODC6aMvow4ows6oJgMJdsfjBfBDbd
|
||||
KNtcTCbHAkEAzlHtfH+o6dVuAaURUfhDj4Ld25/ZQepKMsI3CJaS3eP5+efVbjhr
|
||||
yedC+p7moN9oTLPxee+EqoB8921MWa4mjQJAI/upNnVrFAxtnBDJT2HC09E8Ri9o
|
||||
dqxwPS37ruJkw2B8OH/3/8Y4J65gXfsW5hlGOTDZhhbpHb0Bh1AfRaxR4wJBALn+
|
||||
EWFSlCt4RBsne12xuPX+u5HpoClT1F+9xW7wjqWJhyhKXpVmN4Vj/XWBGdecjqHW
|
||||
9bE+wxIRkpZa6aFO5WECQQChsZbIQ3Oa5D5cjmImzmhWS7pYB/hTt3RZODiB35Ec
|
||||
0tDEkEYz3kx2WmVQdXnlP3/JS8F9FrDJX+y2YxLhvQ75
|
||||
-----END RSA PRIVATE KEY-----
|
||||
|
|
|
|||
|
|
@ -14,18 +14,14 @@
|
|||
(for/list ([f-stx (in-list (syntax->list #'(f ...)))])
|
||||
(define f (syntax->datum f-stx))
|
||||
(format "tests-~a.rkt" f))])
|
||||
(syntax/loc stx
|
||||
(let ([succesful 0])
|
||||
(run-tests*
|
||||
(list (let ()
|
||||
(local-require (only-in tests-f run-pkg-tests))
|
||||
(λ ()
|
||||
(printf "starting ~a\n" 'tests-f)
|
||||
(run-pkg-tests)
|
||||
(set! succesful (add1 succesful))))
|
||||
...))
|
||||
(unless (= succesful (length '(f ...)))
|
||||
(exit 1)))))]))
|
||||
(syntax/loc stx
|
||||
(run-tests*
|
||||
(list (let ()
|
||||
(local-require (only-in tests-f run-pkg-tests))
|
||||
(λ ()
|
||||
(printf "starting ~a\n" 'tests-f)
|
||||
(run-pkg-tests)))
|
||||
...))))]))
|
||||
|
||||
(define (run-tests* l)
|
||||
(run-pkg-tests*
|
||||
|
|
|
|||
|
|
@ -22,35 +22,18 @@
|
|||
(shelly-begin
|
||||
(initialize-catalogs)
|
||||
|
||||
(define-syntax-rule (shelly-install-dry-run what src)
|
||||
(shelly-case
|
||||
(format "Test dry-run installation of ~a" what)
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1
|
||||
$ (~a "raco pkg install --dry-run " src)
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1))
|
||||
|
||||
(define-syntax-rule (shelly-install/d what src)
|
||||
(begin
|
||||
(shelly-install-dry-run what src)
|
||||
(shelly-install what src)))
|
||||
|
||||
(define-syntax-rule (shelly-install*/d what srcs pkgs)
|
||||
(begin
|
||||
(shelly-install-dry-run what srcs)
|
||||
(shelly-install* what srcs pkgs)))
|
||||
|
||||
(shelly-case
|
||||
"raco pkg install tests"
|
||||
(shelly-install/d "local package (tgz)" "test-pkgs/pkg-test1.tgz")
|
||||
(shelly-install/d "local package (zip)" "test-pkgs/pkg-test1.zip")
|
||||
(shelly-install/d "local package (file://zip)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1.zip"))))
|
||||
(shelly-install/d "local package (plt)" "test-pkgs/pkg-test1.plt")
|
||||
(shelly-install*/d "local package (zip, compiled)" "test-pkgs/pkg-test1b.zip" "pkg-test1b")
|
||||
(shelly-install*/d "local package (zip, single-collection)"
|
||||
"test-pkgs/pkg-test1.zip test-pkgs/pkg-test3.zip"
|
||||
"pkg-test1 pkg-test3")
|
||||
(shelly-install/d "local package (dir)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1"))))
|
||||
(shelly-install/d "local package (file://dir)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1"))))
|
||||
(shelly-install "local package (tgz)" "test-pkgs/pkg-test1.tgz")
|
||||
(shelly-install "local package (zip)" "test-pkgs/pkg-test1.zip")
|
||||
(shelly-install "local package (file://zip)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1.zip"))))
|
||||
(shelly-install "local package (plt)" "test-pkgs/pkg-test1.plt")
|
||||
(shelly-install* "local package (zip, compiled)" "test-pkgs/pkg-test1b.zip" "pkg-test1b")
|
||||
(shelly-install* "local package (zip, single-collection)"
|
||||
"test-pkgs/pkg-test1.zip test-pkgs/pkg-test3.zip"
|
||||
"pkg-test1 pkg-test3")
|
||||
(shelly-install "local package (dir)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1"))))
|
||||
(shelly-install "local package (file://dir)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1"))))
|
||||
|
||||
;; Check ".zip" file with extra directory layer:
|
||||
(let ([dir (make-temporary-file "zip~a" 'directory)]
|
||||
|
|
@ -136,18 +119,17 @@
|
|||
"local directory fails when not there"
|
||||
$ "raco pkg install --copy test-pkgs/pkg-test1-not-there/" =exit> 1)
|
||||
|
||||
(parameterize ([current-directory test-source-directory])
|
||||
(shelly-case
|
||||
"directory fails due to path overlap"
|
||||
$ "raco pkg install test-pkgs/pkg-test1"
|
||||
=exit> 1
|
||||
=stderr> #rx"overlap"
|
||||
$ (~a "raco pkg install " (find-collects-dir))
|
||||
=exit> 1
|
||||
=stderr> #rx"overlap.*collection"
|
||||
$ (~a "raco pkg install " (collection-path "tests"))
|
||||
=exit> 1
|
||||
=stderr> #rx"overlap.*package"))
|
||||
(shelly-case
|
||||
"directory fails due to path overlap"
|
||||
$ "raco pkg install test-pkgs/pkg-test1"
|
||||
=exit> 1
|
||||
=stderr> #rx"overlap"
|
||||
$ (~a "raco pkg install " (find-collects-dir))
|
||||
=exit> 1
|
||||
=stderr> #rx"overlap.*collection"
|
||||
$ (~a "raco pkg install " (collection-path "tests"))
|
||||
=exit> 1
|
||||
=stderr> #rx"overlap.*package")
|
||||
|
||||
(define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory)))
|
||||
$ (~a "cp -r test-pkgs/pkg-test1 "tmp-dir"pkg-test1")
|
||||
|
|
@ -183,24 +165,23 @@
|
|||
$ (~a "cp -r "tmp-dir"pkg-test1 "tmp-dir"pkg-test1-linking")
|
||||
$ (~a "cp -r test-pkgs/pkg-test1-staging "tmp-dir"pkg-test1-staging")
|
||||
|
||||
(parameterize ([current-directory test-source-directory])
|
||||
(with-fake-root
|
||||
(shelly-case
|
||||
"linking local directory"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1
|
||||
$ (~a "raco pkg install --link "tmp-dir"pkg-test1-linking")
|
||||
$ "racket -e '(require pkg-test1)'"
|
||||
$ "racket -e '(require pkg-test1/a)'" =exit> 1
|
||||
$ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking\")'") =stdout> "\"pkg-test1-linking\"\n"
|
||||
$ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking/README\")'") =stdout> "\"pkg-test1-linking\"\n"
|
||||
$ "racket -e '(require pkg/lib)' -e '(path->pkg \"test-pkgs\")'" =stdout> "\"racket-test\"\n"
|
||||
$ "racket -e '(require pkg/lib)' -e '(path->pkg (collection-file-path \"main.rkt\" \"racket\"))'" =stdout> "#f\n"
|
||||
$ (~a "cp "tmp-dir"pkg-test1-staging/a.rkt "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt")
|
||||
$ "racket -e '(require pkg-test1/a)'"
|
||||
$ (~a "rm -f "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt")
|
||||
$ "racket -e '(require pkg-test1/a)'" =exit> 1
|
||||
$ "raco pkg remove pkg-test1-linking"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1)))
|
||||
(with-fake-root
|
||||
(shelly-case
|
||||
"linking local directory"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1
|
||||
$ (~a "raco pkg install --link "tmp-dir"pkg-test1-linking")
|
||||
$ "racket -e '(require pkg-test1)'"
|
||||
$ "racket -e '(require pkg-test1/a)'" =exit> 1
|
||||
$ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking\")'") =stdout> "\"pkg-test1-linking\"\n"
|
||||
$ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking/README\")'") =stdout> "\"pkg-test1-linking\"\n"
|
||||
$ "racket -e '(require pkg/lib)' -e '(path->pkg \"test-pkgs\")'" =stdout> "\"racket-test\"\n"
|
||||
$ "racket -e '(require pkg/lib)' -e '(path->pkg (collection-file-path \"main.rkt\" \"racket\"))'" =stdout> "#f\n"
|
||||
$ (~a "cp "tmp-dir"pkg-test1-staging/a.rkt "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt")
|
||||
$ "racket -e '(require pkg-test1/a)'"
|
||||
$ (~a "rm -f "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt")
|
||||
$ "racket -e '(require pkg-test1/a)'" =exit> 1
|
||||
$ "raco pkg remove pkg-test1-linking"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1))
|
||||
|
||||
$ (~a "cp -r "tmp-dir"pkg-test3 "tmp-dir"pkg-test3-linking")
|
||||
|
||||
|
|
|
|||
|
|
@ -29,7 +29,5 @@
|
|||
" (build-path (find-system-path 'addon-dir) (symbol->string 'other)))\"")
|
||||
$ "raco pkg remove -u --auto pkg-b"
|
||||
$ "raco pkg show -l -u -a" =stdout> " [none]\n"
|
||||
$ "raco pkg migrate --dry-run -u other"
|
||||
$ "raco pkg show -l -u -a" =stdout> " [none]\n"
|
||||
$ "raco pkg migrate -u other"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9.]+ \\(catalog \"pkg-a\"\\)\npkg-b +[a-f0-9.]+ +\\(catalog \"pkg-b\"\\)\n")))
|
||||
|
|
|
|||
|
|
@ -15,11 +15,11 @@
|
|||
"promote"
|
||||
$ "raco pkg config --set catalogs http://localhost:9990"
|
||||
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip" =exit> 1 =stderr> #rx"already installed"
|
||||
$ "raco pkg install test-pkgs/pkg-test1.zip" =exit> 1 =stderr> #rx"already installed from a different source"
|
||||
$ "raco pkg install pkg-test1" ; promote
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg install pkg-test1" =exit> 1 =stderr> #rx"already installed" ; redundant promote fails
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 0
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 0
|
||||
|
|
@ -32,9 +32,9 @@
|
|||
"demote"
|
||||
$ "raco pkg config --set catalogs http://localhost:9990"
|
||||
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg remove --demote pkg-test2"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2\\* +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2\\* +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 0
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 0
|
||||
$ "raco pkg remove --auto"
|
||||
|
|
@ -44,8 +44,8 @@
|
|||
"demote+auto"
|
||||
$ "raco pkg config --set catalogs http://localhost:9990"
|
||||
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg remove --demote --auto pkg-test1" =exit> 0 ; should have no effect
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg remove --demote --auto pkg-test2"
|
||||
$ "raco pkg show -l -u -a" =stdout> " [none]\n"))))
|
||||
|
|
|
|||
|
|
@ -21,8 +21,7 @@
|
|||
"remove and show"
|
||||
(shelly-case "remove of not installed package fails"
|
||||
$ "raco pkg show -l -u -a" =stdout> " [none]\n"
|
||||
$ "raco pkg remove not-there" =exit> 1
|
||||
$ "raco pkg remove --dry-run not-there" =exit> 1)
|
||||
$ "raco pkg remove not-there" =exit> 1)
|
||||
(shelly-case "remove of bad name"
|
||||
$ "raco pkg remove bad/" =exit> 1
|
||||
=stderr> #rx"disallowed")
|
||||
|
|
@ -36,21 +35,16 @@
|
|||
"pkg-test1 pkg-test1")
|
||||
(shelly-install "remove of dep fails"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\"\\)\n"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg remove pkg-test1" =exit> 1 =stderr> #rx"pkg-test1 \\(required by: \\(pkg-test2\\)\\)"
|
||||
$ "raco pkg remove --dry-run pkg-test1" =exit> 1 =stderr> #rx"pkg-test1 \\(required by: \\(pkg-test2\\)\\)"
|
||||
$ "raco pkg remove --dry-run pkg-test2"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg remove pkg-test2"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\n")
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\"\\)\n")
|
||||
(shelly-install "remove of dep can be forced"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip"
|
||||
$ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0
|
||||
$ "raco pkg remove --dry-run --force pkg-test1"
|
||||
$ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0
|
||||
$ "raco pkg remove --force pkg-test1"
|
||||
$ "racket -e '(require pkg-test2/contains-dep)'" =exit> 1
|
||||
$ "raco pkg install test-pkgs/pkg-test1.zip"
|
||||
|
|
@ -74,7 +68,7 @@
|
|||
$ "racket -e '(require pkg-test1)'" =exit> 1
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 1
|
||||
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 0
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 0
|
||||
$ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0
|
||||
|
|
|
|||
|
|
@ -45,8 +45,6 @@
|
|||
"test-pkgs/pkg-test1.zip"
|
||||
"pkg-test1"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update --dry-run test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(finally
|
||||
|
|
@ -54,8 +52,6 @@
|
|||
(shelly-install "packages can be replaced with local packages (file + name)"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update --dry-run --name pkg-test1 test-pkgs/pkg-test1-v2.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update --name pkg-test1 test-pkgs/pkg-test1-v2.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(define tmp2-dir (path->directory-path (make-temporary-file "pkg~a" 'directory)))
|
||||
|
|
@ -64,8 +60,6 @@
|
|||
(shelly-install "packages can be replaced with local packages (directory)"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ (~a "raco pkg update --dry-run --name pkg-test1 "tmp2-dir"pkg-test1-v2")
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ (~a "raco pkg update --name pkg-test1 "tmp2-dir"pkg-test1-v2")
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(shelly-install "replacement checksum can be checked"
|
||||
|
|
@ -74,8 +68,6 @@
|
|||
(shelly-install "checksum can be supplied for local directory"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ (~a "raco pkg update --dry-run --name pkg-test1 --checksum abcdef "tmp2-dir"pkg-test1-v2")
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ (~a "raco pkg update --name pkg-test1 --checksum abcdef "tmp2-dir"pkg-test1-v2")
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43
|
||||
$ "raco pkg show" =stdout> #rx"abcdef"
|
||||
|
|
@ -100,8 +92,6 @@
|
|||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "raco pkg update --dry-run pkg-test1" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update pkg-test1" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43)
|
||||
(finally
|
||||
|
|
@ -115,12 +105,9 @@
|
|||
(shelly-install* "remote packages can be updated, single-collection to multi-collection"
|
||||
"test-pkgs/pkg-test1.zip http://localhost:9997/update-test/pkg-test3.zip"
|
||||
"pkg-test1 pkg-test3"
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main loaded\n"
|
||||
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum for pkg-test3\nNo updates available\n"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update --dry-run pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main loaded\n"
|
||||
$ "raco pkg update pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main version 2 loaded\n")
|
||||
(finally
|
||||
|
|
@ -131,15 +118,12 @@
|
|||
$ "mkdir -p test-pkgs/update-test"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
(shelly-install* "remote packages can be updated, multi-collection to single-collection"
|
||||
(shelly-install* "remote packages can be updated, multi-colelction to single-collection"
|
||||
"test-pkgs/pkg-test1.zip http://localhost:9997/update-test/pkg-test3.zip"
|
||||
"pkg-test1 pkg-test3"
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main version 2 loaded\n"
|
||||
$ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum for pkg-test3\nNo updates available\n"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip"
|
||||
$ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM"
|
||||
$ "raco pkg update --dry-run pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main version 2 loaded\n"
|
||||
$ "raco pkg update pkg-test3" =exit> 0
|
||||
$ "racket -e '(require pkg-test3)'" =stdout> "pkg-test3/main loaded\n")
|
||||
(finally
|
||||
|
|
@ -161,8 +145,6 @@
|
|||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
|
||||
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"
|
||||
$ "raco pkg update --dry-run --update-deps pkg-test2" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 42
|
||||
$ "raco pkg update --update-deps pkg-test2" =exit> 0
|
||||
$ "racket -e '(require pkg-test1/update)'" =exit> 43
|
||||
$ "raco pkg remove pkg-test2")
|
||||
|
|
|
|||
|
|
@ -13,23 +13,7 @@
|
|||
setup/dirs
|
||||
"shelly.rkt")
|
||||
|
||||
(define-runtime-path test-source-directory ".")
|
||||
|
||||
;; Use a consistent directory, so that individual tests can be
|
||||
;; run after "tests-create.rkt":
|
||||
(define-runtime-path test-directory (build-path (find-system-path 'temp-dir)
|
||||
"pkg-test-work"))
|
||||
|
||||
(define (sync-test-directory)
|
||||
(printf "Syncing test directory\n")
|
||||
(make-directory* test-directory)
|
||||
(parameterize ([current-directory test-source-directory])
|
||||
(for ([f (in-directory)])
|
||||
(define src f)
|
||||
(define dest (build-path test-directory f))
|
||||
(cond
|
||||
[(directory-exists? src) (make-directory* dest)]
|
||||
[else (copy-file src dest #t)]))))
|
||||
(define-runtime-path test-directory ".")
|
||||
|
||||
(define-syntax-rule (this-test-is-run-by-the-main-test)
|
||||
(module test racket/base))
|
||||
|
|
@ -202,7 +186,6 @@
|
|||
(shelly-case "setup info cache" $ "raco setup -nDKxiI --no-foreign-libs")
|
||||
(with-fake-root
|
||||
(parameterize ([current-directory test-directory])
|
||||
(sync-test-directory)
|
||||
(t)))))))
|
||||
|
||||
(define-syntax-rule (shelly-install** message pkg rm-pkg (pre ...) (more ...))
|
||||
|
|
|
|||
|
|
@ -787,8 +787,7 @@
|
|||
'pos
|
||||
'neg))
|
||||
x)
|
||||
'(body ctc)
|
||||
'(body ctc ctc)) ; result if contract is applied twice
|
||||
'(body ctc))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->d-underscore3
|
||||
|
|
@ -798,8 +797,7 @@
|
|||
'pos
|
||||
'neg))
|
||||
x)
|
||||
'(ctc body)
|
||||
'(ctc ctc body)) ; result if contract is applied twice
|
||||
'(ctc body))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->d-underscore4
|
||||
|
|
|
|||
|
|
@ -732,8 +732,7 @@
|
|||
(quote neg))
|
||||
b)
|
||||
(unbox b))
|
||||
'(5 4 3 2 1)
|
||||
'(5 4 5 4 3 2 1 2 1)) ; result if contract is applied twice
|
||||
'(5 4 3 2 1))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i44
|
||||
|
|
@ -857,8 +856,7 @@
|
|||
'neg)
|
||||
1)
|
||||
x)
|
||||
'(res-check res-eval body arg-eval)
|
||||
'(res-check res-eval res-check res-eval body arg-eval arg-eval)) ; result if contract is applied twice
|
||||
'(res-check res-eval body arg-eval))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i49
|
||||
|
|
@ -874,8 +872,7 @@
|
|||
'neg)
|
||||
1)
|
||||
x)
|
||||
'(res-check body res-eval arg-eval)
|
||||
'(res-check res-check body res-eval res-eval arg-eval arg-eval)) ; result if contract is applied twice
|
||||
'(res-check body res-eval arg-eval))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i50
|
||||
|
|
@ -891,8 +888,7 @@
|
|||
'neg)
|
||||
1)
|
||||
x)
|
||||
'(res-check body res-eval arg-eval)
|
||||
'(res-check res-check body res-eval arg-eval res-eval arg-eval)) ; result if contract is applied twice
|
||||
'(res-check body res-eval arg-eval))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i51
|
||||
|
|
@ -908,8 +904,7 @@
|
|||
'neg)
|
||||
1)
|
||||
x)
|
||||
'(res-check body res-eval arg-eval)
|
||||
'(res-check res-check body res-eval arg-eval res-eval arg-eval)) ; result if contract is applied twice
|
||||
'(res-check body res-eval arg-eval))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i52
|
||||
|
|
@ -929,14 +924,6 @@
|
|||
3 2 1)
|
||||
3)
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i54
|
||||
'((contract (->i (#:one [one any/c] #:two [two any/c] #:three [three any/c]) any)
|
||||
(λ (#:one one #:two two #:three three) (list one two three))
|
||||
'pos 'neg)
|
||||
#:one 1 #:two 2 #:three 3)
|
||||
'(1 2 3))
|
||||
|
||||
(test/pos-blame
|
||||
'->i-arity1
|
||||
'(contract (->i ([x number?]) () any) (λ () 1) 'pos 'neg))
|
||||
|
|
@ -1354,8 +1341,7 @@
|
|||
'pos
|
||||
'neg))
|
||||
x)
|
||||
'(body ctc)
|
||||
'(body ctc ctc)) ; result if contract is applied twice
|
||||
'(body ctc))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i-underscore3
|
||||
|
|
@ -1365,8 +1351,7 @@
|
|||
'pos
|
||||
'neg))
|
||||
x)
|
||||
'(body ctc)
|
||||
'(body ctc ctc)) ; result if contract is applied twice
|
||||
'(body ctc))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->i-underscore4
|
||||
|
|
@ -1393,8 +1378,7 @@
|
|||
'neg)
|
||||
11)
|
||||
x)
|
||||
'(body ctc)
|
||||
'(body ctc ctc)) ; result if contract is applied twice
|
||||
'(body ctc))
|
||||
|
||||
(test/pos-blame
|
||||
'->i-bad-number-of-result-values1
|
||||
|
|
@ -1440,22 +1424,4 @@
|
|||
(λ (x y) x)
|
||||
'pos 'neg) 1 2)
|
||||
"didn't raise an error")
|
||||
#t)
|
||||
|
||||
(test/spec-passed/result
|
||||
'shortcut-error-message
|
||||
'(with-handlers ([exn:fail?
|
||||
(λ (x) (define m
|
||||
(regexp-match #rx"expected: ([^\n]*)\n"
|
||||
(exn-message x)))
|
||||
(if m
|
||||
(list-ref m 1)
|
||||
(format "ack regexp didn't match: ~s"
|
||||
(exn-message x))))])
|
||||
((contract (->i ([y () (and/c number? (>/c 1))]) any)
|
||||
(λ (y) 1)
|
||||
'pos 'neg)
|
||||
1))
|
||||
"(and/c number? (>/c 1))")
|
||||
|
||||
)
|
||||
#t))
|
||||
|
|
|
|||
|
|
@ -716,20 +716,4 @@
|
|||
|
||||
(test/spec-passed
|
||||
'->*-opt-optional5
|
||||
'((contract (->* () integer? #:post #t) (lambda x 1) 'pos 'neg)))
|
||||
|
||||
(test/pos-blame
|
||||
'->*-opt-vs-mand1
|
||||
'(contract (->* (integer?) (symbol? boolean?) number?)
|
||||
(lambda (x y [z #t])
|
||||
x)
|
||||
'pos
|
||||
'neg))
|
||||
(test/pos-blame
|
||||
'->*-opt-vs-mand2
|
||||
'(contract (->* () (symbol? boolean?) symbol?)
|
||||
(lambda (y [z #t])
|
||||
y)
|
||||
'pos
|
||||
'neg))
|
||||
)
|
||||
'((contract (->* () integer? #:post #t) (lambda x 1) 'pos 'neg))))
|
||||
|
|
|
|||
|
|
@ -262,12 +262,6 @@
|
|||
'contract-arrow4
|
||||
'((contract (integer? . -> . integer?) (lambda (x) #f) 'pos 'neg) 1))
|
||||
|
||||
(test/pos-blame
|
||||
'contract-arrow5
|
||||
'(let ()
|
||||
(struct s (x))
|
||||
((contract (-> s? integer?) s-x 'pos 'neg) (s #f))))
|
||||
|
||||
(test/neg-blame
|
||||
'contract-arrow-arity1
|
||||
'((contract (-> number? number? number?)
|
||||
|
|
@ -341,38 +335,6 @@
|
|||
(eq? f (contract (-> any/c any) f 'pos 'neg)))
|
||||
#f)
|
||||
|
||||
(test/spec-passed/result
|
||||
'contract->...1
|
||||
'((contract (-> integer? char? ... boolean? any)
|
||||
(λ args args)
|
||||
'pos 'neg)
|
||||
1 #\a #\b #\c #f)
|
||||
'(1 #\a #\b #\c #f))
|
||||
(test/neg-blame
|
||||
'contract->...2
|
||||
'((contract (-> integer? char? ... boolean? any)
|
||||
(λ args args)
|
||||
'pos 'neg)
|
||||
1 #\a "b" #\c #f))
|
||||
(test/spec-passed/result
|
||||
'contract->...3
|
||||
'((contract (-> integer? ... any)
|
||||
(λ args args)
|
||||
'pos 'neg)
|
||||
1 2 3 4 5 6 7)
|
||||
'(1 2 3 4 5 6 7))
|
||||
(test/neg-blame
|
||||
'contract->...4
|
||||
'((contract (-> integer? ... any)
|
||||
(λ args args)
|
||||
'pos 'neg)
|
||||
1 2 3 4 #f 6 7))
|
||||
(test/spec-passed
|
||||
'contract->...5
|
||||
'(contract (-> procedure? any/c ... list? any)
|
||||
(λ (proc last . stuff) stuff)
|
||||
'pos 'neg))
|
||||
|
||||
|
||||
(test/spec-passed
|
||||
'contract-arrow-all-kwds2
|
||||
|
|
@ -411,27 +373,6 @@
|
|||
'something-else 'yet-another-thing)
|
||||
1)))
|
||||
|
||||
(test/spec-passed/result
|
||||
'chaperone-procedure*-and-contract-interaction
|
||||
'(let ()
|
||||
(define (f1 x) x)
|
||||
|
||||
(define-values (prop:p prop:p? prop:get-p)
|
||||
(make-impersonator-property 'p))
|
||||
|
||||
(define the-answer 'dont-know)
|
||||
|
||||
(define f2 (chaperone-procedure*
|
||||
f1
|
||||
(λ (f x)
|
||||
(set! the-answer (and (prop:p? f) (prop:get-p f)))
|
||||
x)))
|
||||
(define f3 (contract (-> integer? integer?) f2 'pos 'neg))
|
||||
(define f4 (chaperone-procedure f3 #f prop:p 1234))
|
||||
(f4 1)
|
||||
the-answer)
|
||||
1234)
|
||||
|
||||
(test/pos-blame
|
||||
'predicate/c1
|
||||
'(contract predicate/c 1 'pos 'neg))
|
||||
|
|
@ -485,30 +426,6 @@
|
|||
((impersonate-procedure s? (λ (x) (values (λ (r) "") x))) 11))
|
||||
'pos 'neg))
|
||||
|
||||
(test/spec-passed
|
||||
'any/c-in-domain1
|
||||
'((contract (-> any/c real?)
|
||||
(λ (x) 0)
|
||||
'pos 'neg) 0))
|
||||
|
||||
(test/pos-blame
|
||||
'any/c-in-domain2
|
||||
'((contract (-> any/c real?)
|
||||
(λ (x) #f)
|
||||
'pos 'neg) 0))
|
||||
|
||||
(test/spec-passed
|
||||
'any/c-in-domain3
|
||||
'((contract (-> any/c any/c any/c any/c real?)
|
||||
(λ (x y z w) 0)
|
||||
'pos 'neg) 0 1 2 3))
|
||||
|
||||
(test/pos-blame
|
||||
'any/c-in-domain4
|
||||
'((contract (-> any/c any/c any/c any/c real?)
|
||||
(λ (x y z w) #f)
|
||||
'pos 'neg) 0 1 2 3))
|
||||
|
||||
;; this test ensures that no contract wrappers
|
||||
;; are created for struct predicates
|
||||
(test/spec-passed/result
|
||||
|
|
@ -589,55 +506,4 @@
|
|||
'neg))
|
||||
(void)))
|
||||
|
||||
(test/spec-passed/result
|
||||
'->-order-of-evaluation1
|
||||
'(let ([l '()])
|
||||
(-> (begin (set! l (cons 1 l)) #f)
|
||||
(begin (set! l (cons 2 l)) #f)
|
||||
(begin (set! l (cons 3 l)) #f)
|
||||
(begin (set! l (cons 4 l)) #f)
|
||||
(begin (set! l (cons 5 l)) #f))
|
||||
(reverse l))
|
||||
'(1 2 3 4 5))
|
||||
(test/spec-passed/result
|
||||
'->-order-of-evaluation2
|
||||
'(let ([l '()])
|
||||
(-> (begin (set! l (cons 1 l)) #f)
|
||||
(begin (set! l (cons 2 l)) #f)
|
||||
(begin (set! l (cons 3 l)) #f)
|
||||
...
|
||||
(begin (set! l (cons 4 l)) #f)
|
||||
(begin (set! l (cons 5 l)) #f)
|
||||
(begin (set! l (cons 6 l)) #f))
|
||||
(reverse l))
|
||||
'(1 2 3 4 5 6))
|
||||
|
||||
(contract-error-test
|
||||
'->-arity-error1
|
||||
'(contract
|
||||
(-> any/c any/c)
|
||||
(lambda (x y) #t)
|
||||
'pos 'neg)
|
||||
(lambda (e)
|
||||
(regexp-match? "a procedure that accepts 1 non-keyword argument"
|
||||
(exn-message e))))
|
||||
(contract-error-test
|
||||
'->-arity-error2
|
||||
'(contract
|
||||
(-> any/c)
|
||||
(lambda (x y) #t)
|
||||
'pos 'neg)
|
||||
(lambda (e)
|
||||
(regexp-match? "a procedure that accepts 0 non-keyword argument"
|
||||
(exn-message e))))
|
||||
(contract-error-test
|
||||
'->-arity-error3
|
||||
'(contract
|
||||
(->* (any/c) (#:x any/c) any/c)
|
||||
(lambda (x) #t)
|
||||
'pos 'neg)
|
||||
(lambda (e)
|
||||
(regexp-match? "a procedure that accepts the #:x keyword argument"
|
||||
(exn-message e))))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -283,16 +283,4 @@
|
|||
(define-struct/contract thing ([stuff flat-blame-ok/c]))
|
||||
(thing-stuff (thing 5)))))
|
||||
|
||||
(test/spec-passed/result
|
||||
'suggest/c1
|
||||
'(with-handlers ([exn:fail?
|
||||
(λ (x)
|
||||
(define m (regexp-match #rx"suggestion:[^\n]*\n"
|
||||
(exn-message x)))
|
||||
(and m (car m)))])
|
||||
(contract (suggest/c zero? "suggestion" "try zero?")
|
||||
1
|
||||
'pos 'neg))
|
||||
"suggestion: try zero?\n")
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -2615,33 +2615,4 @@
|
|||
(init-field [x 0]))
|
||||
'pos 'neg)])
|
||||
(equal? (new c%) (new c%)))
|
||||
#f)
|
||||
|
||||
(contract-error-test
|
||||
'->m-arity-error-1
|
||||
'(contract (->m string? string?)
|
||||
(lambda (y) y)
|
||||
'pos
|
||||
'neg)
|
||||
(lambda (e)
|
||||
(regexp-match? "a method that accepts 1 non-keyword argument"
|
||||
(exn-message e))))
|
||||
(contract-error-test
|
||||
'->m-arity-error-2
|
||||
'(contract (->m string?)
|
||||
(lambda () y)
|
||||
'pos
|
||||
'neg)
|
||||
(lambda (e)
|
||||
(regexp-match? "a method that accepts 0 non-keyword argument"
|
||||
(exn-message e))))
|
||||
(contract-error-test
|
||||
'->m-arity-error3
|
||||
'(contract (->*m (any/c) (#:x any/c) any/c)
|
||||
(lambda (x y) #t)
|
||||
'pos
|
||||
'neg)
|
||||
(lambda (e)
|
||||
(regexp-match? "a method that accepts the #:x keyword argument"
|
||||
(exn-message e))))
|
||||
)
|
||||
#f))
|
||||
|
|
|
|||
|
|
@ -1069,19 +1069,6 @@
|
|||
(eval '(dynamic-require ''provide/contract55-m2 'a)))
|
||||
'5)
|
||||
|
||||
(test/spec-failed
|
||||
'provide/contract56
|
||||
'(let ()
|
||||
(eval '(module provide/contract56-m1 racket/base
|
||||
(require racket/contract/base)
|
||||
(provide
|
||||
(contract-out
|
||||
[f (-> integer? integer?)]))
|
||||
(define f 1)))
|
||||
(eval '(dynamic-require ''provide/contract56-m1 #f)))
|
||||
"provide/contract56-m1")
|
||||
|
||||
|
||||
(contract-error-test
|
||||
'contract-error-test8
|
||||
#'(begin
|
||||
|
|
|
|||
|
|
@ -27,8 +27,7 @@
|
|||
'pos
|
||||
'neg)
|
||||
(λ (x) x)))
|
||||
11
|
||||
do-not-double-wrap)
|
||||
11)
|
||||
|
||||
(test/pos-blame
|
||||
'∀1
|
||||
|
|
@ -53,5 +52,4 @@
|
|||
'pos
|
||||
'neg)
|
||||
11))
|
||||
11
|
||||
do-not-double-wrap))
|
||||
11))
|
||||
|
|
@ -58,12 +58,6 @@
|
|||
(ctest #t contract-first-order-passes? (non-empty-listof integer?) (list 1))
|
||||
(ctest #f contract-first-order-passes? (non-empty-listof integer?) (list))
|
||||
|
||||
(ctest #t contract-first-order-passes? (*list/c integer? boolean? char?) '(1 2 3 4 #f #\a))
|
||||
(ctest #t contract-first-order-passes? (*list/c integer? boolean? char?) '(#f #\a))
|
||||
(ctest #f contract-first-order-passes? (*list/c integer? boolean? char?) '(1 2 #f 4 #f #\a))
|
||||
(ctest #f contract-first-order-passes? (*list/c integer? boolean? char?) '())
|
||||
(ctest #f contract-first-order-passes? (*list/c integer? boolean? char?) '(#f))
|
||||
(ctest #f contract-first-order-passes? (*list/c integer? boolean? char?) 1)
|
||||
|
||||
(ctest #t contract-first-order-passes?
|
||||
(vector-immutableof integer?)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
(require rackunit
|
||||
racket/contract/private/arrow-common
|
||||
racket/contract/private/arrow
|
||||
|
||||
(for-template racket/contract/private/arrow-val-first)
|
||||
racket/contract/private/application-arity-checking
|
||||
|
|
@ -78,16 +78,8 @@
|
|||
(valid-app-shapes '(2) '() '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? #:x any/c integer?))
|
||||
(valid-app-shapes '(1) '(#:x) '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? (... ...) any))
|
||||
(valid-app-shapes 0 '() '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? integer? (... ...) any))
|
||||
(valid-app-shapes 1 '() '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? integer? (... ...) integer? any))
|
||||
(valid-app-shapes 2 '() '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? integer? (... ...) integer? boolean? char? any))
|
||||
(valid-app-shapes 4 '() '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? boolean? char? (... ...) integer? char? any))
|
||||
(valid-app-shapes 4 '() '()))
|
||||
(check-equal? (->-valid-app-shapes #'(-> integer? #:x any/c #:y any/c integer?))
|
||||
(valid-app-shapes '(1) '(#:x #:y) '()))
|
||||
|
||||
(check-equal? (->*-valid-app-shapes #'(->* (integer? #:x any/c #:y any/c) integer?))
|
||||
(valid-app-shapes '(1) '(#:x #:y) '()))
|
||||
|
|
@ -105,6 +97,7 @@
|
|||
(check-equal? (->*-valid-app-shapes #'(->i ([m any/c]) ([o any/c]) #:rest [r any/c] [r any/c]))
|
||||
(valid-app-shapes '(1 2 . 3) '() '()))
|
||||
|
||||
|
||||
(check-true (valid-argument-list? #'(f x) (valid-app-shapes '(1 2 . 3) '() '())))
|
||||
(check-true (valid-argument-list? #'(f x y) (valid-app-shapes '(1 2 . 3) '() '())))
|
||||
(check-true (valid-argument-list? #'(f x y a b c d) (valid-app-shapes '(1 2 . 3) '() '())))
|
||||
|
|
|
|||
|
|
@ -57,16 +57,6 @@
|
|||
'(list-contract? (list*of any/c))
|
||||
#f)
|
||||
|
||||
(test/spec-passed/result
|
||||
'list-contract-10c
|
||||
'(list-contract? (list*of any/c boolean?))
|
||||
#f)
|
||||
|
||||
(test/spec-passed/result
|
||||
'list-contract-10d
|
||||
'(list-contract? (list*of any/c null?))
|
||||
#t)
|
||||
|
||||
(test/spec-passed/result
|
||||
'list-contract-11
|
||||
'(list-contract? (non-empty-listof any/c))
|
||||
|
|
@ -159,18 +149,6 @@
|
|||
c))
|
||||
#t)
|
||||
|
||||
(test/spec-passed/result
|
||||
'list-contract-25
|
||||
'(list-contract?
|
||||
(*list/c integer? boolean? char?))
|
||||
#t)
|
||||
|
||||
(test/spec-passed/result
|
||||
'list-contract-26
|
||||
'(list-contract?
|
||||
(*list/c (-> integer? integer?) boolean? char?))
|
||||
#t)
|
||||
|
||||
(test/pos-blame
|
||||
'test-contract-25
|
||||
'(contract (letrec ([c (recursive-contract (first-or/c (cons/c any/c c) empty?)
|
||||
|
|
|
|||
|
|
@ -65,29 +65,6 @@
|
|||
'imlistof5
|
||||
'(contract (list*of integer?) (cons #f #t) 'pos 'neg))
|
||||
|
||||
(test/spec-passed/result
|
||||
'imlistof6
|
||||
'(contract (list*of integer? char?) '(1 2 . #\3) 'pos 'neg)
|
||||
'(1 2 . #\3))
|
||||
(test/pos-blame
|
||||
'imlistof7
|
||||
'(contract (list*of integer? char?) '() 'pos 'neg))
|
||||
(test/pos-blame
|
||||
'imlistof8
|
||||
'(contract (list*of integer? char?) #f 'pos 'neg))
|
||||
(test/pos-blame
|
||||
'imlistof9
|
||||
'(contract (list*of integer? char?) (list 1 2) 'pos 'neg))
|
||||
(test/pos-blame
|
||||
'imlistof10
|
||||
'(contract (list*of integer? char?) (cons #f #t) 'pos 'neg))
|
||||
(test/spec-passed
|
||||
'imlistof11
|
||||
'(contract (list*of (-> integer? integer?)
|
||||
(-> boolean? boolean? boolean?))
|
||||
(cons (λ (x) x) (cons (λ (y) y) (λ (a b) a)))
|
||||
'pos 'neg))
|
||||
|
||||
(test/pos-blame
|
||||
'cons/dc1
|
||||
'(contract (cons/dc [hd integer?] [tl (hd) integer?])
|
||||
|
|
@ -171,39 +148,4 @@
|
|||
'(contract? (cons/dc [hd integer?] [tl (hd) integer?] #:impersonator))
|
||||
#t)
|
||||
|
||||
(test/spec-passed/result
|
||||
'*list/c1
|
||||
'(contract (*list/c integer? char? boolean?) '(1 2 3 #\a #f) 'pos 'neg)
|
||||
'(1 2 3 #\a #f))
|
||||
(test/pos-blame
|
||||
'*list/c2
|
||||
'(contract (*list/c integer? char? boolean?) '(1 2 #\a #\a #f) 'pos 'neg))
|
||||
(test/spec-passed/result
|
||||
'*list/c3
|
||||
'((car (contract (*list/c (-> integer? integer?) (-> boolean? boolean?))
|
||||
(list (λ (x) x) (λ (y) y)) 'pos 'neg))
|
||||
1)
|
||||
1)
|
||||
(test/neg-blame
|
||||
'*list/c4
|
||||
'((car (contract (*list/c (-> integer? integer?) (-> boolean? boolean?))
|
||||
(list (λ (x) x) (λ (y) y)) 'pos 'neg))
|
||||
#f))
|
||||
(test/spec-passed/result
|
||||
'*list/c5
|
||||
'((cadr (contract (*list/c (-> integer? integer?) (-> boolean? boolean?))
|
||||
(list (λ (x) x) (λ (y) y)) 'pos 'neg))
|
||||
#f)
|
||||
#f)
|
||||
(test/neg-blame
|
||||
'*list/c6
|
||||
'((cadr (contract (*list/c (-> integer? integer?) (-> boolean? boolean?))
|
||||
(list (λ (x) x) (λ (y) y)) 'pos 'neg))
|
||||
1))
|
||||
(test/pos-blame
|
||||
'*list/c7
|
||||
'((caddr (contract (*list/c (-> integer? integer?) (-> boolean? boolean?) (-> char? char?))
|
||||
(list (λ (x) x) (λ (y) y) (λ (y) 'not-a-bool) (λ (y) y)) 'pos 'neg))
|
||||
#f))
|
||||
|
||||
)
|
||||
|
|
@ -29,8 +29,7 @@
|
|||
(test/spec-passed/result
|
||||
'make-contract-1
|
||||
'((contract proj:add1->sub1 sqrt 'pos 'neg) 15)
|
||||
3
|
||||
do-not-double-wrap)
|
||||
3)
|
||||
|
||||
(test/pos-blame
|
||||
'make-contract-2
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user