From 1959c567431344b468d47fa873e093b5ab0787c4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 9 Feb 2008 13:01:39 +0000 Subject: [PATCH] doc and test repairs svn: r8597 --- collects/browser/browser.scrbl | 530 ++++++++++++++++++ collects/browser/info.ss | 1 + collects/mzlib/sandbox.ss | 29 +- collects/mzlib/scribblings/mzlib.scrbl | 52 ++ collects/mzlib/scribblings/plt-match.scrbl | 16 + collects/mzlib/scribblings/port.scrbl | 16 + collects/mzlib/scribblings/pregexp.scrbl | 56 ++ collects/mzlib/scribblings/restart.scrbl | 67 +++ collects/mzlib/scribblings/sandbox.scrbl | 82 +++ collects/mzlib/scribblings/sendevent.scrbl | 29 + collects/mzlib/scribblings/serialize.scrbl | 36 ++ collects/mzlib/sendevent.ss | 26 +- collects/scheme/mzscheme.ss | 3 +- collects/scribble/basic.ss | 9 +- collects/scribble/run.ss | 2 +- collects/scribble/scheme.ss | 89 ++- collects/scribblings/reference/data.scrbl | 24 + collects/scribblings/reference/match.scrbl | 4 +- collects/scribblings/reference/mz.ss | 20 +- .../scribblings/reference/serialization.scrbl | 2 +- .../scribblings/reference/syntax-model.scrbl | 18 +- .../scribblings/setup-plt/setup-plt.scrbl | 1 - collects/tests/mzscheme/read.ss | 35 +- collects/tests/mzscheme/stx.ss | 6 +- collects/tests/mzscheme/syntax.ss | 8 +- 25 files changed, 1072 insertions(+), 89 deletions(-) create mode 100644 collects/browser/browser.scrbl create mode 100644 collects/mzlib/scribblings/plt-match.scrbl create mode 100644 collects/mzlib/scribblings/port.scrbl create mode 100644 collects/mzlib/scribblings/pregexp.scrbl create mode 100644 collects/mzlib/scribblings/restart.scrbl create mode 100644 collects/mzlib/scribblings/sandbox.scrbl create mode 100644 collects/mzlib/scribblings/sendevent.scrbl create mode 100644 collects/mzlib/scribblings/serialize.scrbl diff --git a/collects/browser/browser.scrbl b/collects/browser/browser.scrbl new file mode 100644 index 0000000000..a64d377d9f --- /dev/null +++ b/collects/browser/browser.scrbl @@ -0,0 +1,530 @@ +#lang scribble/doc + +@(require scribble/manual + (for-label browser/browser + browser/htmltext + framework/framework)) + +@title{@bold{Browser}: Simple HTML Rendering} + +The @schememodname[browser/browser] library provides the following +procedures and classes for parsing and viewing HTML files. The +@schememodname[browser/htmltext] library provides a simplified +interface for rendering to a subclass of the MrEd @scheme[text%] +class. The [browser/external] library provides utilities for launching +an external browser (such as Firefox). + +@section[#:tag "browser"]{Browser} + +@defmodule[browser/browser] + +The browser supports basic HTML commands, plus special Scheme +hyperlinks of the form @(litchar "..."). When +the user clicks on such a link, the string @scheme[sexpr] is parsed as +a Scheme program and evaluated. Since @scheme[sexpr] is likely to +contain Scheme strings, and since escape characters are difficult for +people to read, a @litchar{|} character in @scheme[sexpr] is +converted to a @litchar{"} character before it is parsed. Thus, + +@verbatim[#<Nowhere +EOS +] + +creates a ``Nowhere'' hyperlink, which executes the Scheme program + +@schemeblock[ +"This goes nowhere." +] + +The value of that program is a string. When a Scheme hyperlink returns +a string, it is parsed as a new HTML document. Thus, where the use +clicks on ``Nowhere,'' the result is a new page that says ``This goes +nowhere.'' + +The browser also treats comment forms containing @(litchar "MZSCHEME=sexpr") +specially. Whereas the @(litchar "...") form executes the +expression when the user clicks, the @(litchar "MZSCHEME") expression in a comment +is executed immediately during HTML rendering. If the result is a +string, the comment is replaced in the input HTML stream with the +content of the string. Thus, + +@verbatim[#< +EOS +] + +inserts the path of the current working directory into the containing +document (and ``Here'' is boldfaced). If the result is a snip instead +of a string, it replaces the comment in the document. Other types of +return values are ignored. + +If the html file is being accessed as a @(litchar "file:") url, the +@scheme[current-load-relative-directory] parameter is set to the +directory during the evaluation of the mzscheme code (in both +examples). The Scheme code is executed through @scheme[eval]. + +The @(litchar "MZSCHEME") forms are disabled unless the web page is a +@(litchar "file:") url that points into the @scheme[doc] collection. + +@defproc[(open-url [url null]) null]{ + Opens the given url + (either a string, url record, or port) + in a vanilla browser frame and returns + the frame. The frame is an instance of + @scheme[hyper-frame%]. +} + +@defproc[(html-img-ok [on? null undefined]) null]{ + @scheme[html-img-ok] controls image rendering for the browser. + + If @scheme[on?] is provided, sets the value of the parameter to + @scheme[on?], otherwise returns the current value of the parameter +} + +@defproc[(html-eval-ok [on? null undefined]) null]{ + @scheme[html-eval-ok] controls the evaluation of @(litchar "MZSCHEME=") + tags. + + If @scheme[on?] is provided, sets the value of the parameter to + @scheme[on?], otherwise returns the current value of the parameter +} + +@defmixin[hyper-frame-mixin () ()]{ + The result of this mixin takes one argument, a url + string. During the initialization of objects created from + this mixin, the code shows the frame and visits the url. + + @defconstructor[([frame% null])]{ + Extends the given @scheme[frame%] class. + } + + @defmethod[(get-hyper-panel%) null]{ + Returns the class that is instantiated when the frame is created. + Must be a panel with hyper-panel-mixin mixed in. Defaults to + just returning @scheme[hyper-panel%]. + } + + @defmethod[(get-hyper-panel) null]{ + Returns the hyper panel in this frame. + } +} + +@defmixin[hyper-no-show-frame-mixin () ()]{ + This is the same as the @scheme[hyper-frame-mixin], except that it + doesn't show the frame and the initialization arguments + are unchanged. + + @defconstructor[([frame% null])]{ + Extends the given @scheme[frame%] class. + } +} + +@defmixin[hyper-text-mixin () ()]{ + The initialization arguments are extended with + four new first arguments: a url or a port to be loaded + into the @scheme[text%] object (using the @scheme[reload] method, + described below), a top-level-window or @scheme[#f] to use as a + parent for status dialogs, a progress procedure used as + for @scheme[get-url], and either @scheme[#f] or a post string to be sent + to a web server (technically changing the GET to a POST). + + Sets the autowrap-bitmap to @scheme[#f]. + + An instance of a @scheme[(hyper-text-mixin text%)] class should be displayed + only in an instance of a class created with @scheme[hyper-canvas-mixin] + (described below). + + @defconstructor[([text% null])]{ + Extends the given @scheme[text%] class. + } + + The mixin adds the following methods: + + @defmethod[(map-shift-style [start null] [end null] [shift-style null]) null]{ + Maps the given style over the given range. + } + + @defmethod[(make-link-style [start null] [end null]) null]{ + Changes the style for the given range to the link style. + } + + @defmethod[(get-url) null]{ + Returns the URL displayed by the editor, or @scheme[#f] if there + is none. + } + + @defmethod[(get-title) null]{ + Gets the page's title. + } + + @defmethod[(set-title [string null]) null]{ + Sets the page's title. + } + + @defmethod[(hyper-delta) null]{ + A @scheme[style-delta%] object; override it to set the link style. + } + + @defmethod[(add-tag [name-string null] [pos null]) null]{ + Installs a tag. + } + + @defmethod[(find-tag [name-string/number null]) null]{ + Finds the location of a tag in the buffer (where tags are + installed in HTML with @(litchar "")) and returns its + position. If @scheme[name] is a number, the number is returned + (assumed to be an offset rather than a tag). Otherwise, + if the tag is not found, @scheme[#f] is returned. + } + + @defmethod[(remove-tag [name null]) null]{ + Removes a tag. + } + + @defmethod[(post-url [url string?] [post-data-bytes null #f]) null]{ + Follows the link in the string. + @scheme[post-data-bytes] defaults to @scheme[#f] + } + + @defmethod[(add-link [start null] [end null] [url-string null]) null]{ + Installs a hyperlink. + } + + @defmethod[(add-scheme-callback [start null] [end null] [scheme-string null]) null]{ + Installs a Scheme evaluation hyperlink. + } + + @defmethod[(add-thunk-callback [start null] [end null] [thunk null]) null]{ + Installs a thunk-based hyperlink. + } + + @defmethod[(eval-scheme-string [string null]) null]{ + Called to handle the @(litchar "...") + tag and @(litchar "") comments (see above). + Evaluates the string; if the result is a string, + it is opened as an HTML page. + } + + @defmethod[(reload) null]{ + Reloads the current page. + + The text defaultly uses the basic style named "Html + Standard" in the editor (if it exists). } + + @defmethod[(remap-url [url null]) null]{ + When visiting a new page, this method is called to remap + the url. The remapped url is used in place of the + original url. If this method returns @scheme[#f], the page doesn't + go anywhere. + + This method may be killed (if the user clicks the + ``stop'' button) + } + + @defmethod[(get-hyper-keymap) null]{ + Returns a keymap suitable for frame-level handling of events to + redirect page-up, etc. to the browser canvas. + } + +} + +@defclass[hyper-text% hyper-text-mixin #;(hyper-text-mixin text:keymap%) ()]{ + + Extends the @scheme[text:keymap%] class to support standard + key bindings in the browser window. + +} + +@defmixin[hyper-canvas-mixin () ()]{ + @defconstructor[([editor-canvas% null])]{ + Extends the given + @scheme[editor-canvas%] class. + The initialization arguments are unchanged. + } + + The canvas's parent should be an instance of a class derived with + @scheme[hyper-panel-mixin] (described below). + + @defmethod[(get-editor%) null]{ + Returns the class used to implement the editor in the browser + window. It should be derived from @scheme[hyper-text%] + and should pass on the + initialization arguments to @scheme[hyper-text%]. + + The dynamic extent of the initialization of this + editor is called on a thread that may be killed (via a + custodian shutdown) + + In that case, the editor in the browser's + editor-canvas may not be an instance of this class. + } + + @defmethod[(current-page) null]{ + Returns a representation of the currently displayed page, which + includes a particular editor and a visible range within the + editor. + } + + @defmethod[(goto-url [url null] [relative-to-url null] [progress-proc null undefined] [post-data-bytes null @scheme[#f]]) null]{ + Changes to the given url, loading it by calling the @scheme[make-editor] + method. If @scheme[relative-to-url] is not @scheme[#f], it must be + a URL for resolving @scheme[url] as a relative URL. + @scheme[url] may also be a port, in which case, + @scheme[relative-to-url] must be @scheme[#f]. + + The @scheme[progress-proc] procedure is called with a boolean at the + point where the URL has been resolved and enough progress has + been made to dismiss any message that the URL is being + resolved. The procedure is called with @scheme[#t] if the URL will be + loaded into a browser window, @scheme[#f] otherwise (e.g., the user will + save the URL content to a file). + + If @scheme[post-data-bytes] is a byte string instead of false, the URL + GET is changed to a POST with the given data. + } + + @defmethod[(set-page [page null] [notify? null]) null]{ + Changes to the given page. If @scheme[notify?] is not @scheme[#f], + the canvas's parent is notified about the change by calling its + @scheme[leaving-page] method. + } + + @defmethod[(after-set-page) null]{ + Called during @scheme[set-page]. Defaultly does nothing. + } +} + +@defmixin[hyper-panel-mixin () ()]{ + @defconstructor[([area-container% null])]{ + Extends the given area + container class. The initialization arguments are unchanged, but + initialization creates controls and a hyper text canvas. The + controls permit a user to move back and forth in the hypertext + history. + } + + The mixin adds a initialization argument, @scheme[info-line?], + which is a boolean indicating whether the browser should contain a + line to display special @(litchar "DOCNOTE") tags in a page. + Such tags are used primarily by the PLT documentation. + + The mixin adds the following instance variables: + + @defmethod[(make-canvas [container null]) null]{ + Creates the panel's hypertext canvas, an instance of a class + derived using @scheme[hyper-canvas-mixin] (described above). This + method is called during initialization. + } + + @defmethod[(get-canvas%) null]{ + Returns the class instantiated by make-canvas. It must be derived from + @scheme[hyper-canvas%]. + } + + @defmethod[(make-control-bar-panel [container null]) null]{ + Creates the panel's sub-container for the control bar containing + the navigation buttons. If @scheme[#f] is returned, the panel will + have no control bar. The default method instantiates + @scheme[horizontal-panel%]. + } + + @defmethod[(rewind) null]{ + Goes back one page, if possible. + } + + @defmethod[(forward) null]{ + Goes forward one page, if possible. + } + + @defmethod[(get-canvas) null]{ + Gets the hypertext canvas. + } + + @defmethod[(on-navigate) null]{ + Callback that is invoked any time the displayed hypertext page + changes (either by clicking on a link in the canvas or by + @scheme[rewind] or @scheme[forward] calls). + } + + @defmethod[(leaving-page [page null] [new-page null]) null]{ + This method is called by the hypertext canvas to notify the + panel that the hypertext page changed. The @scheme[page] is @scheme[#f] + if @scheme[new-page] is the first page for the canvas. See also + @scheme[page->editor] (described below). + } + + @defmethod[(filter-notes [list-of-strings null]) null]{ + Given the notes from a page as a list of strings (where + each string is a note), returns a single string to print + above the page. + } + + @defmethod[(reload) null]{ + Reloads the currently visible page by calling the @scheme[reload] + method of the currently displayed hyper-text. + } +} + +@defproc[(editor->page [editor null]) null]{ + Creates a page record for the given editor, + suitable for use with the @scheme[set-page] method of + @scheme[hyper-canvas-mixin]. +} + +@defproc[(page->editor [page null]) null]{ + Extracts the editor from a page record. +} + +@defproc[(on-installer-run [proc null undefined]) null]{ + Parameter for a procedure to be invoked + after the installer is run on a .plt file. +} + +@defproc[(bullet-size [n null undefined]) null]{ + Parameter controlling the point size of a + bullet. +} + +@defmixin[image-map-snip% () ()]{ + Instances of this class behave like @scheme[image-snip%] objects, + except they have a @(litchar " ... ") associated with them and + when clicking on them (in the map) they will cause their + init arg text to follow the corresponding link. + + @defconstructor[([html-text (is-a?/c html-text<%>)])]{ + } + + @defmethod[(set-key [key-string null]) null]{ + Sets the key for the image map (eg, "#key"). + } + + @defmethod[(get-key) null]{ + Returns the current key. + } + + @defmethod[(add-area [shape-string null] [list-of-numbers null] [href-string null]) null]{ + Registers the shape named by the shape-string whose + coordinates are specified by the list-of-numbers to go to + the href named href-string when that region of the image + is clicked on. + } +} + +@section[#:tag "browser-unit"]{Browser Unit} + +@defmodule[browser/browser-unit] + +The _browser-unit.ss_ library in the "browser" collection is a +unitized version of the code documented above. It imports unit +matching the following signatures: +@(itemize + (item @scheme[setup:plt-installer^]) + (item @scheme[mred^]) + (item @scheme[tcp^] " (see \"tcp-sig.ss\" in the \"net\" collection)") + (item @scheme[url^] " (see \"url-sig.ss\" in the \"url\" collection)")) + +It exports the @scheme[browser^] signature. + +The _browser-sig.ss_ library in the ``browser'' collection defines +the @scheme[browser^] signature with all of the names listed above. + + +@section[#:tag "html-text"]{HTML As Text} + +@defmodule[browser/htmltext] + +@definterface[html-text<%> ()]{ + An interface that extends @scheme[text%] with the following methods: + + @defmethod[(get-url) null]{ + Returns a base URL used for building + relative URLs, or @scheme[#f] if no base is available. + } + + @defmethod[(set-title [str null]) null]{ + Registers the title @scheme[str] + for the rendered page. + } + + @defmethod[(add-link [start-pos null] [end-pos null] [url-string null]) null]{ + Registers a hyperlink for the given region in rendered page. + } + + @defmethod[(label [pos null]) null]{ + Registers a tag at the given position in the rendered page. + } + + @defmethod[(make-link-style [start-pos null] [end-pos null]) null]{ + Modifies the style of the rendered page from @scheme[start-pos] to + @scheme[end-pos] to look like a hyperlink. + } + + @defmethod*[([(add-scheme-callback [pos null] [endpos null] [code-string null]) null] + [(add-scheme-callback [pos null] [endpos null] [thunk null]) null])]{ + Registers a code-evaluating or thunk-invoking hyperlink for the given region. + } + + @defmethod[(post-url [url null] [post-data-bytes null]) null]{ + Performs a post to the given @scheme[url] with the given post data. + } +} + +@defmixin[html-text-mixin () ()]{ + @defconstructor[([text%-subclassr% null])]{ + Extends the given @scheme[text%] class with implementations of the + @scheme[html-text<%>] methods. Hyperlinks are attached to clickbacks + that use @scheme[send-url] + (from the ``sendurl.ss'' library of the ``net'' collection). + } +} + +@defproc[(render-html-to-text [input-port null] [html-text<%>-obj null] [load-img? null] [eval-mz? null]) null]{ + Reads HTML from @scheme[input-port] and renders it to + @scheme[html-text<%>-obj]. If @scheme[load-img?] is false, then images + are rendered as Xed-out boxes. If @scheme[eval-mz?] is false, then + MZSCHEME hyperlink expressions and comments are not evaluated. + + Uses the style named ``Html Standard'' in the editor's + style-list (if it exists) for all of the inserted text's + default style. +} + +@section[#:tag "external"]{Launching an External Browser} + +@defmodule[browser/external] + +@defproc[(send-url [str null] [separate-window? void #t]) null]{ + Like @scheme[send-url] in @scheme[(lib "sendurl.ss" "net")], but under Unix, + the user is prompted for a browser to use if none is recorded + in the preferences file. +} + +@defproc[(browser-preference? [v null]) null]{ + Returns @scheme[#t] if @scheme[v] is a valid browser preference. +} + +@defproc[(update-browser-preference [url-or-#f null]) null]{ + Under Unix, prompts the user for a browser preference and records + the user choice as a framework preference (even if one is already + recorded). If @scheme[url-or-#f] is not @scheme[#f], it is used in the + dialog to explain which URL is to be opened; if it is @scheme[#f], + the @scheme['internal] will be one of the options for the user. +} + +@defproc[(install-help-browser-preference-panel) null]{ + Installs a framework preference panel for ``Browser'' options. +} + +@defproc[(add-to-browser-prefs-panel [proc null]) null]{ + The @scheme[proc] must be a procedure that takes a @scheme[panel%] argument. + It will be called when the ``Browser'' panel is constructed for + preferences. The supplied argument is the panel, so @scheme[proc] can add + additional option controls. If the panel is already created, @scheme[proc] + is called immediately. +} + +@scheme[tool@] + + A unit that implements a DrScheme tool to add the ``Browser'' + preference panel. diff --git a/collects/browser/info.ss b/collects/browser/info.ss index 7596ba4915..6fc66dc9bc 100644 --- a/collects/browser/info.ss +++ b/collects/browser/info.ss @@ -3,3 +3,4 @@ (define name "Browser") (define tools (list (list "tool.ss"))) (define tool-names (list "Browser")) +(define scribblings '(("browser.scrbl"))) diff --git a/collects/mzlib/sandbox.ss b/collects/mzlib/sandbox.ss index 0ddc451d5b..e1120f24ce 100644 --- a/collects/mzlib/sandbox.ss +++ b/collects/mzlib/sandbox.ss @@ -1,10 +1,31 @@ (module sandbox scheme/base (require scheme/sandbox (prefix-in mz: (only-in mzscheme make-namespace))) - (provide (except-out (all-from-out scheme/sandbox) - make-evaluator - make-module-evaluator - gui?) + (provide sandbox-init-hook + sandbox-reader + sandbox-input + sandbox-output + sandbox-error-output + sandbox-propagate-breaks + sandbox-coverage-enabled + sandbox-namespace-specs + sandbox-override-collection-paths + sandbox-security-guard + sandbox-path-permissions + sandbox-network-guard + sandbox-make-inspector + sandbox-eval-limits + kill-evaluator + break-evaluator + set-eval-limits + put-input + get-output + get-error-output + get-uncovered-expressions + call-with-limits + with-limits + exn:fail:resource? + exn:fail:resource-resource (rename-out [*make-evaluator make-evaluator] [gui? mred?])) diff --git a/collects/mzlib/scribblings/mzlib.scrbl b/collects/mzlib/scribblings/mzlib.scrbl index 84c608902d..5e5aae0de0 100644 --- a/collects/mzlib/scribblings/mzlib.scrbl +++ b/collects/mzlib/scribblings/mzlib.scrbl @@ -170,6 +170,58 @@ Re-exports @schememodname[file/md5]. @; ---------------------------------------------------------------------- +@include-section["plt-match.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["port.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["pregexp.scrbl"] + +@; ---------------------------------------------------------------------- + +@mzlib[pretty] + +Re-exports @schememodname[scheme/pretty]. + +@; ---------------------------------------------------------------------- + +@mzlib[process] + +Re-exports @schememodname[scheme/system]. + +@; ---------------------------------------------------------------------- + +@include-section["restart.scrbl"] + +@; ---------------------------------------------------------------------- + +@mzlib[runtime-path] + +Re-exports @schememodname[scheme/runtime-path]. + +@; ---------------------------------------------------------------------- + +@include-section["sandbox.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["sendevent.scrbl"] + +@; ---------------------------------------------------------------------- + +@include-section["serialize.scrbl"] + +@; ---------------------------------------------------------------------- + +@mzlib[shared] + +Re-exports @schememodname[scheme/shared]. + +@; ---------------------------------------------------------------------- + @(bibliography (bib-entry #:key "Shivers06" diff --git a/collects/mzlib/scribblings/plt-match.scrbl b/collects/mzlib/scribblings/plt-match.scrbl new file mode 100644 index 0000000000..a356c6a3ed --- /dev/null +++ b/collects/mzlib/scribblings/plt-match.scrbl @@ -0,0 +1,16 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/plt-match)) + +@mzlib[#:mode title plt-match] + +The @schememodname[mzlib/plt-match] library mostly re-provides +@scheme[scheme/match]. + +@deftogether[( +@defform*[((define-match-expander id proc-expr) + (define-match-expander id proc-expr proc-expr) + (define-match-expander id proc-expr proc-expr proc-expr))] +)]{ + +The same as the form from @schememodname[mzlib/match].} diff --git a/collects/mzlib/scribblings/port.scrbl b/collects/mzlib/scribblings/port.scrbl new file mode 100644 index 0000000000..3b92d914d9 --- /dev/null +++ b/collects/mzlib/scribblings/port.scrbl @@ -0,0 +1,16 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/port)) + +@mzlib[#:mode title port] + +The @schememodname[mzlib/port] library mostly re-provides +@scheme[scheme/port]. + +@defproc[(strip-shell-command-start [in input-port?]) void?]{ + +Reads and discards a leading @litchar{#!} in @scheme[in] (plus +continuing lines if the line ends with a backslash). Since +@litchar{#!} followed by a forward slash or space is a comment, this +procedure is not needed before reading Scheme expressions.} + diff --git a/collects/mzlib/scribblings/pregexp.scrbl b/collects/mzlib/scribblings/pregexp.scrbl new file mode 100644 index 0000000000..c5fb04d3b9 --- /dev/null +++ b/collects/mzlib/scribblings/pregexp.scrbl @@ -0,0 +1,56 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/pregexp + (only-in scheme/base regexp-quote))) + +@mzlib[#:mode title pregexp] + +The @schememodname[mzlib/pregexp] library provides wrappers around +@scheme[regexp-match], @|etc| that coerce string and byte-string +arguments to @scheme[pregexp] matchers instead of @scheme[regexp] +matchers. + +The library also re-exports: @scheme[pregexp], and it re-exports +@scheme[regexp-quote] as @scheme[pregexp-quote]. + +@deftogether[( +@defproc[(pregexp-match [pattern (or/c string? bytes? regexp? byte-regexp?)] + [input (or/c string? bytes? input-port?)] + [start-pos nonnegative-exact-integer? 0] + [end-pos (or/c nonnegative-exact-integer? false/c) #f] + [output-port (or/c output-port? false/c) #f]) + (or/c (listof (or/c (cons (or/c string? bytes?) + (or/c string? bytes?)) + false/c)) + false/c)] +@defproc[(pregexp-match-positions [pattern (or/c string? bytes? regexp? byte-regexp?)] + [input (or/c string? bytes? input-port?)] + [start-pos nonnegative-exact-integer? 0] + [end-pos (or/c nonnegative-exact-integer? false/c) #f] + [output-port (or/c output-port? false/c) #f]) + (or/c (listof (or/c (cons nonnegative-exact-integer? + nonnegative-exact-integer?) + false/c)) + false/c)] +@defproc[(pregexp-split [pattern (or/c string? bytes? regexp? byte-regexp?)] + [input (or/c string? bytes? input-port?)] + [start-pos nonnegative-exact-integer? 0] + [end-pos (or/c nonnegative-exact-integer? false/c) #f]) + (listof (or/c string? bytes?))] +@defproc[(pregexp-replace [pattern (or/c string? bytes? regexp? byte-regexp?)] + [input (or/c string? bytes?)] + [insert (or/c string? bytes? + (string? . -> . string?) + (bytes? . -> . bytes?))]) + (or/c string? bytes?)] +@defproc[(pregexp-replace* [pattern (or/c string? bytes? regexp? byte-regexp?)] + [input (or/c string? bytes?)] + [insert (or/c string? bytes? + (string? . -> . string?) + (bytes? . -> . bytes?))]) + (or/c string? bytes?)] +)]{ + +Like @scheme[regexp-match], @|etc|, but a string @scheme[pattern] +argument is compiled via @scheme[pregexp], and a byte string +@scheme[pattern] argument is compiled via @scheme[byte-pregexp].} diff --git a/collects/mzlib/scribblings/restart.scrbl b/collects/mzlib/scribblings/restart.scrbl new file mode 100644 index 0000000000..6ea4c861d6 --- /dev/null +++ b/collects/mzlib/scribblings/restart.scrbl @@ -0,0 +1,67 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/restart + mzlib/cmdline)) + +@mzlib[#:mode title restart] + +@margin-note{See @scheme[scheme/sandbox] for a more general way to + simulate running a new PLT Scheme process.} + +@defproc[(restart-mzscheme [init-argv (vectorof string?)] + [adjust-flag-table (any/c . -> . any/c)] + [argv (vectorof string?)] + [init-namespace (-> any)]) + boolean?]{ + +Simulates starting MzScheme with the vector of command-line strings +@scheme[argv]. The @scheme[init-argv], @scheme[adjust-flag-table], and +@scheme[init-namespace] arguments are used to modify the default +settings for command-line flags, adjust the parsing of command-line +flags, and customize the initial namespace, respectively. + +The vector of strings @scheme[init-argv] is read first with the +standard MzScheme command-line parsing. Flags that load files or +evaluate expressions (e.g., @Flag{f} and @Flag{e}) are ignored, but +flags that set MzScheme's modes (e.g., @Flag{c} or @Flag{j}) +effectively set the default mode before @scheme[argv] is parsed. + +Before @scheme[argv] is parsed, the procedure +@scheme[adjust-flag-table] is called with a command-line flag table as +accepted by @scheme[parse-command-line]. The return value must also be +a table of command-line flags, and this table is used to parse +@scheme[argv]. The intent is to allow @scheme[adjust-flag-table] to +add or remove flags from the standard set. + +After @scheme[argv] is parsed, a new thread and a namespace are +created for the ``restarted'' MzScheme. (The new namespace is +installed as the current namespace in the new thread.) In the new +thread, restarting performs the following actions: + +@itemize{ + + @item{The @scheme[init-namespace] procedure is called with no + arguments. The return value is ignored.} + + @item{Expressions and files specified by @scheme[argv] are evaluated + and loaded. If an error occurs, the remaining expressions and + files are ignored, and the return value for + @scheme[restart-mzscheme] is set to @scheme[#f].} + + @item{The @scheme[read-eval-print-loop] procedure is called, unless a + flag in @scheme[init-argv] or @scheme[argv] disables it. When + @scheme[read-eval-print-loop] returns, the return value for + @scheme[restart-mzscheme] is set to @scheme[#t].} + +} + +Before evaluating command-line arguments, an exit handler is installed +that immediately returns from @scheme[restart-mzscheme] with the value +supplied to the handler. This exit handler remains in effect when +@scheme[read-eval-print-loop] is called (unless a command-line +argument changes it). If @scheme[restart-mzscheme] returns normally, +the return value is determined as described above. + +Note that an error in a command-line expression followed by +@scheme[read-eval-print-loop] produces a @scheme[#t] result. This is +consistent with MzScheme's stand-alone behavior.} diff --git a/collects/mzlib/scribblings/sandbox.scrbl b/collects/mzlib/scribblings/sandbox.scrbl new file mode 100644 index 0000000000..e58f93cbb7 --- /dev/null +++ b/collects/mzlib/scribblings/sandbox.scrbl @@ -0,0 +1,82 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/sandbox + (only-in scheme/sandbox make-module-evaluator))) + +@(begin + (define-syntax-rule (bind id) + (begin + (require (for-label scheme/sandbox)) + (define id (scheme make-evaluator)))) + (bind scheme-make-evaluator)) + +@mzlib[#:mode title sandbox] + +The @schememodname[mzlib/sandbox] library mostly re-exports +@schememodname[scheme/sandbox], but it provides a slightly different +@scheme[make-evaluator] function. + +The library re-exports the following bindings: + +@schemeblock[ +sandbox-init-hook +sandbox-reader +sandbox-input +sandbox-output +sandbox-error-output +sandbox-propagate-breaks +sandbox-coverage-enabled +sandbox-namespace-specs +sandbox-override-collection-paths +sandbox-security-guard +sandbox-path-permissions +sandbox-network-guard +sandbox-make-inspector +sandbox-eval-limits +kill-evaluator +break-evaluator +set-eval-limits +put-input +get-output +get-error-output +get-uncovered-expressions +call-with-limits +with-limits +exn:fail:resource? +exn:fail:resource-resource +] + +@defproc*[([(make-evaluator [language (or/c module-path? + (one-of/c 'r5rs 'beginner 'beginner-abbr + 'intermediate 'intermediate-lambda 'advanced) + (list/c (one-of/c 'special) symbol?) + (list/c (one-of/c 'special) symbol?) + (cons/c (one-of/c 'begin) list?))] + [requires (or/c (cons/c 'begin list?) + (listof (or/c module-path? path?)))] + [input-program any/c] ...) + (any/c . -> . any)] + [(make-evaluator [module-decl (or/c syntax? pair?)]) + (any/c . -> . any)])]{ + +Like @scheme-make-evaluator or @scheme[make-module-evaluator], but +with several differences: + +@itemize{ + + @item{The @scheme[language] argument can be one of a fixed set of + symbols: @scheme['r5rs], etc. They are converted by adding a + @scheme[(list 'special ....)] wrapper.} + + @item{If @scheme[requires] starts with @scheme['begin], then each + element in the remainder of the list is effectively evaluated + as a prefix to the program. Otherwise, it corresponds to the + @scheme[#:requires] argument of @|scheme-make-evaluator|.} + + @item{For each of @scheme[language] and @scheme[requires] that starts + with @scheme['begin], the expressions are inspected to find + top-level @scheme[require] forms (using symbolic equality to + detect @scheme[require]), and the @scheme[require]d modules are + added to the @scheme[#:allow] list for @|scheme-make-evaluator|.} + +}} diff --git a/collects/mzlib/scribblings/sendevent.scrbl b/collects/mzlib/scribblings/sendevent.scrbl new file mode 100644 index 0000000000..1bd830e630 --- /dev/null +++ b/collects/mzlib/scribblings/sendevent.scrbl @@ -0,0 +1,29 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/sendevent)) + +@(begin + (define-syntax-rule (bind id) + (begin + (require (for-label scheme/gui/base)) + (define id (scheme send-event)))) + (bind mred-send-event)) + +@mzlib[#:mode title sendevent] + +The @schememodname[mzlib/sendevent] library provides a +@scheme[send-event] function that works only on Mac OS X, and only +when running in MrEd (though the library can be loaded in MzScheme). + +@defproc[(send-event [receiver-bytes (lambda (s) (and (bytes? s) + (= 4 (bytes-length s))))] + [event-class-bytes (lambda (s) (and (bytes? s) + (= 4 (bytes-length s))))] + [event-id-bytes (lambda (s) (and (bytes? s) + (= 4 (bytes-length s))))] + [direct-arg-v any/c (void)] + [argument-list list? null]) + any/c]{ + +Calls @|mred-send-event| @schememodname[scheme/gui/base], if +available, otherwise raises @scheme[exn:fail:unsupported].} diff --git a/collects/mzlib/scribblings/serialize.scrbl b/collects/mzlib/scribblings/serialize.scrbl new file mode 100644 index 0000000000..78184435ca --- /dev/null +++ b/collects/mzlib/scribblings/serialize.scrbl @@ -0,0 +1,36 @@ +#lang scribble/doc +@(require "common.ss" + (for-label mzlib/serialize)) + +@(begin + (define-syntax-rule (bind id id2) + (begin + (require (for-label scheme/serialize)) + (define id (scheme define-serializable-struct)) + (define id2 (scheme define-serializable-struct/versions)))) + (bind scheme-define-serializable-struct scheme-define-serializable-struct/versions)) + +@mzlib[#:mode title serialize] + +The @schememodname[mzlib/serialize] library provides the same bindings +as @schememodname[scheme/serialize], except that +@scheme[define-serializable-struct] and +@scheme[define-serializable-struct/versions] are based on the syntax +of @scheme[define-struct] from @schememodname[mzscheme]. + +@deftogether[( +@defform[(define-serializable-struct id-maybe-super (field-id ...) maybe-inspector-expr)] +@defform/subs[(define-serializable-struct/versions id-maybe-super vers-num (field-id ...) + (other-version-clause ...) + maybe-inspector-expr) + ([id-maybe-super id + (id super-id)] + [maybe-inspector-expr code:blank + inspector-expr] + [other-version-clause (other-vers make-proc-expr + cycle-make-proc-expr)])] +)]{ + +Like @scheme-define-serializable-struct and +@scheme-define-serializable-struct/versions, but with the syntax of +closer to @scheme[define-struct] of @schememodname[mzscheme].} diff --git a/collects/mzlib/sendevent.ss b/collects/mzlib/sendevent.ss index 15c5fc65c6..fff2800b40 100644 --- a/collects/mzlib/sendevent.ss +++ b/collects/mzlib/sendevent.ss @@ -1,16 +1,14 @@ +#lang scheme/base +(require scheme/gui/dynamic) -(module sendevent mzscheme - (require "etc.ss") - (provide send-event) +(provide send-event) - (define send-event - (opt-lambda (who class msg [data (void)] [args null]) - (let ([send-event (with-handlers ([exn:fail? (lambda (x) #f)]) - (dynamic-require '(lib "mred.ss" "mred") - 'send-event))]) - (if send-event - (send-event who class msg data args) - (raise - (make-exn:fail:unsupported - "send-event: only supported in MrEd" - (current-continuation-marks)))))))) +(define send-event + (lambda (who class msg [data (void)] [args null]) + (if (gui-available?) + ((gui-dynamic-require 'send-event) who class msg data args) + (raise + (make-exn:fail:unsupported + "send-event: only supported in MrEd" + (current-continuation-marks)))))) + diff --git a/collects/scheme/mzscheme.ss b/collects/scheme/mzscheme.ss index dda03fc6e4..8a53a3cbb5 100644 --- a/collects/scheme/mzscheme.ss +++ b/collects/scheme/mzscheme.ss @@ -41,7 +41,8 @@ free-identifier=? free-transformer-identifier=? free-template-identifier=? - free-label-identifier=?) + free-label-identifier=? + vector-copy!) (rename syntax->datum syntax-object->datum) (rename datum->syntax datum->syntax-object) (rename free-identifier=? module-identifier=?) diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss index 9408f0c011..b83ba4ad8e 100644 --- a/collects/scribble/basic.ss +++ b/collects/scribble/basic.ss @@ -111,8 +111,15 @@ tt span-class subscript superscript) +(define hspace-cache (make-vector 100 #f)) + (define (hspace n) - (make-element 'hspace (list (make-string n #\space)))) + (if (n . < . (vector-length hspace-cache)) + (or (vector-ref hspace-cache n) + (let ([h (make-element 'hspace (list (make-string n #\space)))]) + (vector-set! hspace-cache n h) + h)) + (make-element 'hspace (list (make-string n #\space))))) (define (elem . str) (make-element #f (decode-content str))) diff --git a/collects/scribble/run.ss b/collects/scribble/run.ss index af777dfb22..b491d36c2a 100644 --- a/collects/scribble/run.ss +++ b/collects/scribble/run.ss @@ -58,7 +58,7 @@ (define (build-docs-files files) (build-docs (map (lambda (file) - (dynamic-require file 'doc)) + (dynamic-require `(file ,file) 'doc)) files) files)) diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index 16394d9a73..30ceba9778 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -54,11 +54,57 @@ (make-spaces #f (list (literalize-spaces (substring i 0 (caar m))) - (make-element 'hspace (list (make-string cnt #\space))) + (hspace cnt) (literalize-spaces (substring i (cdar m)))) cnt)) i))) + + (define line-breakable-space (make-element 'tt (list " "))) + + (define id-element-cache #f #;(make-hash-table 'equal)) + (define element-cache #f #;(make-hash-table 'equal)) + + (define (make-id-element c s) + (let* ([key (and id-element-cache + (let ([b (identifier-label-binding c)]) + (list (syntax-e c) + (module-path-index-resolve (caddr b)) + (cadddr b) + (list-ref b 5))))]) + (or (and key + (hash-table-get id-element-cache key #f)) + (let ([e (make-delayed-element + (lambda (renderer sec ri) + (let* ([tag (find-scheme-tag sec ri c 'for-label)]) + (if tag + (list + (case (car tag) + [(form) + (make-link-element "schemesyntaxlink" (list s) tag)] + [else + (make-link-element "schemevaluelink" (list s) tag)])) + (list + (make-element "badlink" + (list (make-element "schemevaluelink" (list s)))))))) + (lambda () s) + (lambda () s))]) + (when key + (hash-table-put! id-element-cache key e)) + e)))) + + (define (make-element/cache style content) + (if (and element-cache + (pair? content) + (string? (car content)) + (null? (cdr content))) + (let ([key (cons style content)]) + (or (hash-table-get element-cache key #f) + (let ([e (make-element style content)]) + (hash-table-put! element-cache key e) + e))) + (make-element style content))) + (define (typeset-atom c out color? quote-depth) (let*-values ([(is-var?) (and (identifier? c) (memq (syntax-e c) (current-variable-list)))] @@ -81,21 +127,7 @@ (quote-depth . <= . 0) (not (or it? is-var?))) (if (pair? (identifier-label-binding c)) - (make-delayed-element - (lambda (renderer sec ri) - (let* ([tag (find-scheme-tag sec ri c 'for-label)]) - (if tag - (list - (case (car tag) - [(form) - (make-link-element "schemesyntaxlink" (list s) tag)] - [else - (make-link-element "schemevaluelink" (list s) tag)])) - (list - (make-element "badlink" - (list (make-element "schemevaluelink" (list s)))))))) - (lambda () s) - (lambda () s)) + (make-id-element c s) s) (literalize-spaces s)) (cond @@ -183,7 +215,7 @@ (make-element "highlighted" (list c))) values) (if (and color? cls) - (make-element cls (list v)) + (make-element/cache cls (list v)) v)) content)) (set! dest-col (+ dest-col len))]))])) @@ -208,8 +240,8 @@ (when (positive? amt) (let ([old-dest-col dest-col]) (out (if (and (= 1 amt) (not multi-line?)) - (make-element 'tt (list " ")) ; allows a line break to replace the space - (make-element 'hspace (list (make-string amt #\space)))) + line-breakable-space ; allows a line break to replace the space + (hspace amt)) #f) (set! dest-col (+ old-dest-col amt)))))) (set! src-col c) @@ -240,9 +272,9 @@ (make-sized-element (if val? value-color #f) (list - (make-element (if val? value-color paren-color) '(". ")) + (make-element/cache (if val? value-color paren-color) '(". ")) (typeset a #f "" "" "" (not val?)) - (make-element (if val? value-color paren-color) '(" ."))) + (make-element/cache (if val? value-color paren-color) '(" ."))) (+ (syntax-span a) 4))) (list (syntax-source a) (syntax-line a) @@ -480,11 +512,16 @@ (graph-reference? s)) (gen-typeset c multi-line? prefix1 prefix suffix color?) (typeset-atom c - (case-lambda - [(elem color) - (make-sized-element (and color? color) (list elem) (or (syntax-span c) 1))] - [(elem color len) - (make-sized-element (and color? color) (list elem) len)]) + (letrec ([mk + (case-lambda + [(elem color) + (mk elem color (or (syntax-span c) 1))] + [(elem color len) + (if (and (string? elem) + (= len (string-length elem))) + (make-element/cache (and color? color) (list elem)) + (make-sized-element (and color? color) (list elem) len))])]) + mk) color? 0)))) (define (to-element c) diff --git a/collects/scribblings/reference/data.scrbl b/collects/scribblings/reference/data.scrbl index d68a70c67d..3cb53e5955 100644 --- a/collects/scribblings/reference/data.scrbl +++ b/collects/scribblings/reference/data.scrbl @@ -353,6 +353,30 @@ If @scheme[vec] is itself immutable, then it is returned as the result.} Changes all slots of @scheme[vec] to contain @scheme[v].} +@defproc[(vector-copy! [dest (and/c vector? (not/c immutable?))] + [dest-start exact-nonnegative-integer?] + [src vector?] + [src-start exact-nonnegative-integer? 0] + [src-end exact-nonnegative-integer? (vector-length src)]) + void?]{ + + Changes the elements of @scheme[dest] starting at position + @scheme[dest-start] to match the elements in @scheme[src] from + @scheme[src-start] (inclusive) to @scheme[src-end] (exclusive). The + vectors @scheme[dest] and @scheme[src] can be the same vector, and in + that case the destination region can overlap with the source region; + the destination elements after the copy match the source elements + from before the copy. If any of @scheme[dest-start], + @scheme[src-start], or @scheme[src-end] are out of range (taking into + account the sizes of the vectors and the source and destination + regions), the @exnraise[exn:fail:contract]. + +@examples[(define v (vector 'A 'p 'p 'l 'e)) + (vector-copy! v 4 #(y)) + (vector-copy! v 0 v 3 4) + v]} + + @defproc[(vector->values [vec vector?] [start-pos nonnegative-exact-integer? 0] [end-pos nonnegative-exact-integer? (vector-length vec)]) diff --git a/collects/scribblings/reference/match.scrbl b/collects/scribblings/reference/match.scrbl index a309b9c344..bf5325faf8 100644 --- a/collects/scribblings/reference/match.scrbl +++ b/collects/scribblings/reference/match.scrbl @@ -12,7 +12,7 @@ The @scheme[match] form and related forms support general pattern matching on Scheme values. See also @secref["regexp"] for information on regular-expression matching on strings, bytes, and streams. -@note-lib[scheme/match] +@note-lib[scheme/match #:use-sources (mzlib/plt-match)] @defform/subs[(match val-expr clause ...) ([clause [pat expr ...+] @@ -36,7 +36,7 @@ the object being matched before calling the failure procedure, otherwise the behavior of matching is unpredictable. The grammar of @scheme[pat] is as follows, where non-italicized -identifers are recognized symbolically (i.e., not by binding). +identifiers are recognized symbolically (i.e., not by binding). @|match-grammar| diff --git a/collects/scribblings/reference/mz.ss b/collects/scribblings/reference/mz.ss index 02fcbcc543..9d017d05b1 100644 --- a/collects/scribblings/reference/mz.ss +++ b/collects/scribblings/reference/mz.ss @@ -35,14 +35,18 @@ (provide note-lib-only) - (define-syntax-rule (note-lib-only lib . more) - (defmodule lib - (t "The bindings documented in this section are provided by the " - (schememodname lib) - " library, not " (schememodname scheme/base) - " or " (schememodname scheme) - "." - . more))) + (define-syntax note-lib-only + (syntax-rules () + [(_ lib #:use-sources (src ...) . more) + (defmodule lib #:use-sources (src ...) + (t "The bindings documented in this section are provided by the " + (schememodname lib) + " library, not " (schememodname scheme/base) + " or " (schememodname scheme) + "." + . more))] + [(_ lib . more) + (note-lib-only lib #:use-sources () . more)])) (define (*exnraise s) (make-element #f (list s " exception is raised"))) diff --git a/collects/scribblings/reference/serialization.scrbl b/collects/scribblings/reference/serialization.scrbl index 324396d4af..b6b707bfb4 100644 --- a/collects/scribblings/reference/serialization.scrbl +++ b/collects/scribblings/reference/serialization.scrbl @@ -8,7 +8,7 @@ @title[#:tag "serialization"]{Serialization} -@note-lib-only[scheme/serialize] +@note-lib-only[scheme/serialize #:use-sources (scheme/private/serialize)] @defproc[(serializable? [v any/c]) boolean?]{ diff --git a/collects/scribblings/reference/syntax-model.scrbl b/collects/scribblings/reference/syntax-model.scrbl index 5ec19ddc2a..b2e99f7d2b 100644 --- a/collects/scribblings/reference/syntax-model.scrbl +++ b/collects/scribblings/reference/syntax-model.scrbl @@ -218,17 +218,23 @@ following grammar: A fully-expanded @tech{syntax object} corresponds to a @deftech{parse} of a program (i.e., a @deftech{parsed} program), and @tech{lexical -information} on its @tech{identifiers} indicates the @tech{parse}. +information} on its @tech{identifiers} indicates the +@tech{parse}. + +@margin-note{Beware that the symbolic names of identifiers in a fully +expanded program may not match the symbolic names in the grammar. Only +the binding (according to @scheme[free-identifier=?]) matters.} More specifically, the typesetting of identifiers in the above grammar is significant. For example, the second case for @scheme[_expr] is a @tech{syntax-object} list whose first element is an @tech{identifier}, where the @tech{identifier}'s @tech{lexical information} specifies a -binding to the @scheme[define-values] of the @schememodname[scheme/base] -language (i.e., the @tech{identifier} is @scheme[free-identifier=?] to -one whose binding is @scheme[define-values]). In all cases, -identifiers above typeset as syntactic-form names refer to the -bindings defined in @secref["syntax"]. +binding to the @scheme[define-values] of the +@schememodname[scheme/base] language (i.e., the @tech{identifier} is +@scheme[free-identifier=?] to one whose binding is +@scheme[define-values]). In all cases, identifiers above typeset as +syntactic-form names refer to the bindings defined in +@secref["syntax"]. Only @tech{phase levels} 0 and 1 are relevant for the parse of a program (though the @scheme[_datum] in a @scheme[quote-syntax] form diff --git a/collects/scribblings/setup-plt/setup-plt.scrbl b/collects/scribblings/setup-plt/setup-plt.scrbl index fb1833cb0f..7b0d42a471 100644 --- a/collects/scribblings/setup-plt/setup-plt.scrbl +++ b/collects/scribblings/setup-plt/setup-plt.scrbl @@ -3,7 +3,6 @@ @(require scribble/manual scribble/bnf (for-label scheme - setup setup/setup-unit setup/option-unit setup/option-sig diff --git a/collects/tests/mzscheme/read.ss b/collects/tests/mzscheme/read.ss index da396d54a2..df867b3449 100644 --- a/collects/tests/mzscheme/read.ss +++ b/collects/tests/mzscheme/read.ss @@ -175,23 +175,24 @@ (load-relative "numstrs.ss") (let loop ([l number-table]) (unless (null? l) - (let* ([pair (car l)] - [v (car pair)] - [s (cadr pair)]) - (cond - [(memq v '(X DBZ NOE)) - (err/rt-test (readstr s) exn:fail:read?) - (test #f string->number s)] - [v - (test v readstr s) - (test (if (symbol? v) #f v) string->number s)] - [else - (test (string->symbol s) readstr s) - (test #f string->number s) - (unless (regexp-match "#" s) - (err/rt-test (readstr (string-append "#d" s)) exn:fail:read?) - (test #f string->number (string-append "#d" s)))])) - (loop (cdr l)))) + (let* ([pair (car l)] + [v (car pair)] + [s (cadr pair)]) + (cond + [(memq v '(X DBZ NOE)) + (err/rt-test (readstr s) exn:fail:read?) + (test #f string->number s)] + [v + (printf "here ~a\n" test) + (test v readstr s) + (test (if (symbol? v) #f v) string->number s)] + [else + (test (string->symbol s) readstr s) + (test #f string->number s) + (unless (regexp-match "#" s) + (err/rt-test (readstr (string-append "#d" s)) exn:fail:read?) + (test #f string->number (string-append "#d" s)))])) + (loop (cdr l)))) (test 5 readstr "#| hi |# 5") (test 5 readstr "#| #| #| #| hi |# |# |# |# 5") diff --git a/collects/tests/mzscheme/stx.ss b/collects/tests/mzscheme/stx.ss index 881c1181b2..ed6b2766e7 100644 --- a/collects/tests/mzscheme/stx.ss +++ b/collects/tests/mzscheme/stx.ss @@ -445,9 +445,9 @@ (cdddr b)) b))) -(test '('#%kernel case-lambda scheme/init case-lambda #f #f) identifier-binding* #'case-lambda) -(test '(scheme/promise delay scheme/init delay #f #f) identifier-binding* #'delay) -(test '('#%kernel #%module-begin scheme/init #%plain-module-begin #f #f) identifier-binding* #'#%plain-module-begin) +(test '('#%kernel case-lambda (lib "scheme/init") case-lambda #f #f) identifier-binding* #'case-lambda) +(test '(scheme/promise delay (lib "scheme/init") delay #f #f) identifier-binding* #'delay) +(test '('#%kernel #%module-begin (lib "scheme/init") #%plain-module-begin #f #f) identifier-binding* #'#%plain-module-begin) (require (only-in scheme/base [#%plain-module-begin #%pmb])) (test '('#%kernel #%module-begin scheme/base #%plain-module-begin #f #f) identifier-binding* #'#%pmb) diff --git a/collects/tests/mzscheme/syntax.ss b/collects/tests/mzscheme/syntax.ss index b5455f3d3b..40f374647b 100644 --- a/collects/tests/mzscheme/syntax.ss +++ b/collects/tests/mzscheme/syntax.ss @@ -365,10 +365,10 @@ (test 70 'let* (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x)))) (test 70 'let*-values (let ((x 2) (y 3)) (let*-values (((x) 7) ((z) (+ x y))) (* z x)))) (test #t 'letrec (letrec ((-even? - (lambda (n) (if (zero? n) #t (-odd? (- n 1))))) - (-odd? - (lambda (n) (if (zero? n) #f (-even? (- n 1)))))) - (-even? 88))) + (lambda (n) (if (zero? n) #t (-odd? (- n 1))))) + (-odd? + (lambda (n) (if (zero? n) #f (-even? (- n 1)))))) + (-even? 88))) (test #t 'letrec-values (letrec-values (((-even? -odd?) (values (lambda (n) (if (zero? n) #t (-odd? (- n 1))))