change -q to config option, fix unlikely race condition in wake-on-signal, add path->url and url->path, and adjust URL parsing

svn: r9239

collects/drscheme/syncheck.ss

@@ -2399,11 +2399,18 @@ If the namespace does not, they are colored the unbound color.
                                           (label (fw:gui-utils:format-literal-label (string-constant cs-view-docs) (exported-index-desc-name (entry-desc index-entry))))
                                           (callback
                                            (λ (x y)
-                                             (send-url (format "file://~a~a"
+                                              (let* ([url (path->url path)]
-                                                               (path->string path) 
+                                                     [url2 (if tag
-                                                               (if tag
+                                                               (make-url (url-scheme url)
-                                                                   (string-append "#" (uri-encode tag))
+                                                                         (url-user url)
-                                                                   ""))))))))))))))))))))))
+                                                                         (url-host url)
+                                                                         (url-port url)
+                                                                         (url-path-absolute? url)
+                                                                         (url-path url)
+                                                                         (url-query url)
+                                                                         tag)
+                                                               url)])
+                                                (send-url (url->string url2))))))))))))))))))))))
     
     
     

collects/games/crazy8s/info.ss

@@ -1,4 +1,5 @@
 #lang setup/infotab
 
+(define name "Crazy 8s")
 (define game "crazy8s.ss")
 (define game-set "Card Games")

collects/games/ginrummy/info.ss

@@ -1,4 +1,5 @@
 #lang setup/infotab
 
+(define name "Rummy")
 (define game "ginrummy.ss")
 (define game-set "Card Games")

collects/games/gofish/info.ss

@@ -1,4 +1,5 @@
 #lang setup/infotab
 
+(define name "Go Fish")
 (define game "gofish.ss")
 (define game-set "Card Games")

collects/games/mines/info.ss

@@ -1,4 +1,5 @@
 #lang setup/infotab
 
+(define name "Minesweeper")
 (define game-set "Puzzle Games")
 (define game "mines.ss")

collects/net/scribblings/url.scrbl

@@ -73,7 +73,16 @@ URL that ends in a slash. For example, the result of
 @scheme[(string->url "http://www.drscheme.org/a/")] has a
 @scheme[path] field with strings @scheme["a"] and @scheme[""], while
 the result of @scheme[(string->url "http://www.drscheme.org/a")] has a
-@scheme[path] field with only the string @scheme["a"].}
+@scheme[path] field with only the string @scheme["a"].
+
+When a @scheme["file"] URL is represented by a @scheme[url] structure,
+the @scheme[path] field is mostly a list of path elements. For Unix
+paths, the root directory is not included in @scheme[path]; its
+presence or absence is implicit in the @scheme[path-absolute?] flag.
+For Windows paths, the first element typically represents a drive, but
+a UNC path is represented by a first element that is @scheme[""] and
+then successive elements complete the drive components that are
+separated by @litchar{/} or @litchar{\}.}
 
 @defstruct[path/param ([path (or/c string? (one-of/c 'up 'same))]
                        [param (listof string?)])]{
@@ -95,7 +104,26 @@ Parses the URL specified by @scheme[str] into a @scheme[url]
 struct. The @scheme[string->url] procedure uses
 @scheme[form-urlencoded->alist] when parsing the query, so it is
 sensitive to the @scheme[current-alist-separator-mode] parameter for
-determining the association separator.}
+determining the association separator.
+
+If @scheme[str] starts with @scheme["file:"], then the path is always
+parsed as an absolute path, and the parsing details depend on
+@scheme[file-url-path-convention-type]:
+
+@itemize[
+
+ @item{@scheme['unix] : If @scheme["file:"] is followed by
+       @litchar{//} and a non-@litchar{/}, then the first element
+       after the @litchar{//} is parsed as a host (and maybe port);
+       otherwise, the first element starts the path, and the host is
+       @scheme[""].}
+
+ @item{@scheme['windows] : If @scheme["file:"] is followed by
+       @litchar{//}, then the @litchar{//} is stripped; the remainder
+       parsed as a Windows path. The host is always @scheme[""] and
+       the port is always @scheme[#f].}
+
+]}
 
 
 @defproc[(combine-url/relative [base url?] [relative string?]) url?]{
@@ -117,17 +145,50 @@ scheme @scheme["http"].}
 
 @defproc[(url->string [URL url?]) string?]{
 
-Generates a string corresponding to the contents of a @scheme[url] struct.
+Generates a string corresponding to the contents of a @scheme[url]
-For a @scheme["file:"] URL, empty strings in the path list are treated as
+struct.  For a @scheme["file:"] URL, the URL must not be relative, the
-@scheme['same] for @scheme[build-path].
+result always starts @litchar{file://}, and the interpretation of the
+path depends on the value of @scheme[file-url-path-convention-type]:
+
+@itemize[
+
+ @item{@scheme['unix] : Elements in @scheme[URL] are treated as path
+       elements. Empty strings in the path list are treated like
+       @scheme['same].}
+
+ @item{@scheme['windows] : If the first element is @scheme[""] then
+       the next two elements define the UNC root, and the rest of the
+       elements are treated as path elements. Empty strings in the
+       path list are treated like @scheme['same].}
+
+]
 
 The @scheme[url->string] procedure uses
-@scheme[alist->form-urlencoded] when formatting the query, so it it
+@scheme[alist->form-urlencoded] when formatting the query, so it is
 sensitive to the @scheme[current-alist-separator-mode] parameter for
 determining the association separator. The default is to separate
 associations with a @litchar{&}.}
 
 
+@defproc[(path->url [path (or/c path-string? path-for-some-system?)])
+         url?]{
+
+Converts a path to a @scheme[url].}
+
+
+@defproc[(url->path [URL url?]
+                    [kind (one-of/c 'unix 'windows) (system-path-convention-type)])
+         path-for-some-system?]{
+
+Converts @scheme[URL], which is assumed to be a @scheme["file"] URL,
+to a path.}
+
+
+@defparam[file-url-path-convention-type kind (one-of/c 'unix 'windows)]{
+
+Determines the default conversion to and from strings for
+@scheme["file"] URLs. See @scheme[string->url] and @scheme[url->string].}
+
 
 @deftogether[(
 @defproc[(get-pure-port [URL url?]

collects/net/url-sig.ss

@@ -15,7 +15,10 @@ purify-port
 netscape/string->url
 string->url
 url->string
+path->url
+url->path
 call/input-url
 combine-url/relative
 url-exception?
 current-proxy-servers
+file-url-path-convention-type

collects/net/url-unit.ss

@@ -9,7 +9,7 @@
 ;;   "impure" = they have text waiting
 ;;   "pure" = the MIME headers have been read
 
-(module url-unit mzscheme
+(module url-unit scheme/base
   (require mzlib/file
            mzlib/unit
            mzlib/port
@@ -22,17 +22,14 @@
            "tcp-sig.ss")
   (provide url@)
 
-  ;; undocumented hook to allow testing
-  (provide set-url:os-type!)
-  (define url:os-type (system-type))
-  (define (set-url:os-type! new) (set! url:os-type new))
-
   (define-unit url@
     (import tcp^)
     (export url^)
 
     (define-struct (url-exception exn:fail) ())
 
+    (define file-url-path-convention-type (make-parameter (system-path-convention-type)))
+
     (define current-proxy-servers
       (make-parameter null
         (lambda (v)
@@ -73,6 +70,11 @@
             [query  (url-query url)]
             [fragment (url-fragment url)]
             [sa string-append])
+        (when (and (equal? scheme "file")
+                   (not (url-path-absolute? url)))
+          (raise-mismatch-error "url->string"
+                                "cannot convert relative file URL to a string: "
+                                url))
         (sa (if scheme (sa scheme ":") "")
             (if (or user host port)
               (sa "//"
@@ -82,7 +84,9 @@
                   ;; There used to be a "/" here, but that causes an
                   ;; extra leading slash -- wonder why it ever worked!
                   )
-              "")
+              (if (equal? "file" scheme) ; always need "//" for "file" URLs
+                  "//"
+                  ""))
             (combine-path-strings (url-path-absolute? url) path)
             ;; (if query (sa "?" (uri-encode query)) "")
             (if (null? query) "" (sa "?" (alist->form-urlencoded query)))
@@ -131,25 +135,37 @@
         (tcp-abandon-port client->server)
         server->client))
 
-    (define (file://->path url)
+    (define (file://->path url [kind (system-path-convention-type)])
-      ;; remove all ""s
+      (let ([strs (map path/param-path (url-path url))]
-      (let ([elts (remove* '("") (map path/param-path (url-path url)))]
+            [string->path-element/same
-            [abs? (url-path-absolute? url)])
+             (lambda (e)
-        ;; See the discussion in PR8060 for an explanation
+               (if (symbol? e)
-        (if (eq? 'windows url:os-type)
+                   e
-          (let ([host (or (url-host url) "")])
+                   (if (string=? e "")
-            (unless (equal? "" host) (set! elts (cons host elts)))
+                       'same
-            (if (null? elts)
+                       (bytes->path-element (string->bytes/locale e) kind))))]
-              (build-path) ; make it throw the error
+            [string->path/win (lambda (s)
-              (let* ([fst (car elts)] [len (string-length fst)])
+                                (bytes->path (string->bytes/utf-8 s) 'windows))])
-                (if (or (not abs?) (eq? #\: (string-ref fst (sub1 len))))
+        (if (and (url-path-absolute? url)
-                  (apply build-path elts)
+                 (eq? 'windows kind))
-                  (if (null? (cdr elts))
+            ;; If initial path is "", then build UNC path.
-                    (build-path (string-append "\\\\" (car elts)))
+            (cond
-                    (apply build-path
+             [(not (url-path-absolute? url))
-                           (string-append "\\\\" (car elts) "\\" (cadr elts))
+              (apply build-path (map string->path-element/same strs))]
-                           (cddr elts)))))))
+             [(and ((length strs) . >= . 3)
-          (apply build-path (if abs? (cons "/" elts) elts)))))
+                   (equal? (car strs) ""))
+              (apply build-path 
+                     (string->path/win
+                      (string-append "\\\\" (cadr strs) "\\" (caddr strs) "\\"))
+                     (map string->path-element/same (cdddr strs)))]
+             [(pair? strs)
+              (apply build-path (string->path/win (car strs))
+                     (map string->path-element/same (cdr strs)))]
+             [else (build-path)]) ; error
+            (let ([elems (map string->path-element/same strs)])
+              (if (url-path-absolute? url)
+                  (apply build-path "/" elems)
+                  (apply build-path elems))))))
 
     ;; file://get-pure-port : url -> in-port
     (define (file://get-pure-port url)
@@ -362,19 +378,33 @@
                                                scheme)))
            (url-error "Invalid URL string; bad scheme ~e: ~e" scheme str))
          ;; Windows => "file://xxx:/...." specifies a "xxx:/..." path
-         (when (and (equal? "" port) (equal? "file" scheme)
+         (let ([win-file? (and (or (equal? "" port) 
-                    (eq? 'windows url:os-type))
+                                   (not port))
-           (set! path (string-append host ":" path))
+                               (equal? "file" scheme)
-           (set! host #f))
+                               (eq? 'windows (file-url-path-convention-type))
-         (let* ([scheme   (and scheme (string-downcase scheme))]
+                               (not (equal? host "")))])
-                [host     (and host (string-downcase host))]
+           (when win-file?
-                [user     (uri-decode/maybe user)]
+             (if (equal? "" port)
-                [port     (and port (string->number port))]
+                 (set! path (string-append host ":" path))
-                [abs?     (regexp-match? #rx"^/" path)]
+                 (set! path (if path
-                [path     (separate-path-strings path)]
+                                (if host
-                [query    (if query (form-urlencoded->alist query) '())]
+                                    (string-append host "/" path)
-                [fragment (uri-decode/maybe fragment)])
+                                    path)
-           (make-url scheme user host port abs? path query fragment)))
+                                host)))
+             (set! port #f)
+             (set! host ""))
+           (let* ([scheme   (and scheme (string-downcase scheme))]
+                  [host     (and host (string-downcase host))]
+                  [user     (uri-decode/maybe user)]
+                  [port     (and port (string->number port))]
+                  [abs?     (or (equal? "file" scheme)
+                                (regexp-match? #rx"^/" path))]
+                  [path     (if win-file?
+                                (separate-windows-path-strings path)
+                                (separate-path-strings path))]
+                  [query    (if query (form-urlencoded->alist query) '())]
+                  [fragment (uri-decode/maybe fragment)])
+             (make-url scheme user host port abs? path query fragment))))
        (cdr (or (regexp-match url-rx str)
                 (url-error "Invalid URL string: ~e" str)))))
 
@@ -389,6 +419,9 @@
       (let ([strs (regexp-split #rx"/" str)])
         (map separate-params (if (string=? "" (car strs)) (cdr strs) strs))))
 
+    (define (separate-windows-path-strings str)
+      (url-path (path->url (bytes->path (string->bytes/utf-8 str) 'windows))))
+
     (define (separate-params s)
       (let ([lst (map path-segment-decode (regexp-split #rx";" s))])
         (make-path/param (car lst) (cdr lst))))
@@ -423,6 +456,52 @@
                  (apply string-append (reverse r))
                  (loop (cdr strings) (list* (car strings) sep r))))]))
 
+    (define (path->url path)
+      (let ([url-path (let loop ([path (simplify-path path #f)][accum null])
+                        (let-values ([(base name dir?) (split-path path)])
+                          (cond
+                           [(not base)
+                            (append (map
+                                     (lambda (s)
+                                       (make-path/param s null))
+                                     (if (eq? (path-convention-type path) 'windows)
+                                         ;; For Windows, massage the root:
+                                         (let ([s (regexp-replace 
+                                                   #rx"[/\\\\]$"
+                                                   (bytes->string/utf-8
+                                                    (path->bytes name))
+                                                   "")])
+                                           (cond
+                                            [(regexp-match? #rx"^\\\\\\\\[?]\\\\[a-zA-Z]:" s)
+                                             ;; \\?\<drive>: path:
+                                             (regexp-split #rx"[/\\]+" (substring s 4))]
+                                            [(regexp-match? #rx"^\\\\\\\\[?]\\\\UNC" s)
+                                             ;; \\?\ UNC path:
+                                             (regexp-split #rx"[/\\]+" (substring s 7))]
+                                            [(regexp-match? #rx"^[/\\]" s)
+                                             ;; UNC path:
+                                             (regexp-split #rx"[/\\]+" s)]
+                                            [else
+                                             (list s)]))
+                                         ;; On other platforms, we drop the root:
+                                         null))
+                                    accum)]
+                           [else
+                            (let ([accum (cons (make-path/param 
+                                                (if (symbol? name)
+                                                    name
+                                                    (bytes->string/utf-8
+                                                     (path-element->bytes name)))
+                                                null)
+                                               accum)])
+                              (if (eq? base 'relative) 
+                                  accum
+                                  (loop base accum)))])))])
+        (make-url "file" #f "" #f (absolute-path? path) url-path '() #f)))
+
+    (define (url->path url [kind (system-path-convention-type)])
+      (file://->path url kind))
+    
     ;; delete-pure-port : url [x list (str)] -> in-port
     (define/kw (delete-pure-port url #:optional [strings '()])
       (method-pure-port 'delete url #f strings))

collects/net/url.ss

@@ -26,7 +26,9 @@
 
   (provide/contract
    (string->url ((or/c bytes? string?) . -> . url?))
+   (path->url ((or/c path-string? path-for-some-system?) . -> . url?))
    (url->string (url? . -> . string?))
+   (url->path ((url?) ((one-of/c 'unix 'windows)) . opt-> . path-for-some-system?))
 
    (get-pure-port (opt-> (url?) ((listof string?)) input-port?))
    (get-impure-port (opt-> (url?) ((listof string?)) input-port?))
@@ -54,6 +56,8 @@
    (combine-url/relative (url? string? . -> . url?))
    (url-exception? (any/c . -> . boolean?))
    (current-proxy-servers
-    (parameter/c (or/c false/c (listof (list/c string? string? number?))))))
+    (parameter/c (or/c false/c (listof (list/c string? string? number?)))))
+   (file-url-path-convention-type
+    (parameter/c (one-of/c 'unix 'windows))))
   )
 

collects/scribblings/reference/reader.scrbl

@@ -804,10 +804,10 @@ of alphanumeric ASCII, @litchar{+}, @litchar{-}, @litchar{_}, and/or
 @litchar{/} characters terminated by
 @schemelink[char-whitespace?]{whitespace} or an end-of-file.  The
 sequence must not start or end with @litchar{/}. A sequence
-@litchar{#lang }@nonterm{name} is equivalent to
+@litchar["#lang\u20"]@nonterm{name} is equivalent to
-@litchar{#reader }@nonterm{name}@litchar{/lang/reader}, except that
+@litchar["#reader\u20"]@nonterm{name}@litchar{/lang/reader}, except
-the terminating whitespace (if any) is consumed before the external
+that the terminating whitespace (if any) is consumed before the
-reading procedure is called.
+external reading procedure is called.
 
 Finally, @as-index{@litchar{#!}} followed by alphanumeric ASCII,
 @litchar{+}, @litchar{-}, or @litchar{_} is a synonym for

collects/scribblings/reference/startup.scrbl

@@ -174,10 +174,6 @@ flags:
         @Flag{i}/@DFlag{repl}, but uses @scheme[read-eval-print-loop]
         instead of @scheme[graphical-read-eval-print-loop].}
 
-  @item{@FlagFirst{q} or @DFlagFirst{no-init-file} : Skips loading
-        @scheme[(find-system-path 'init-file)] for
-        @Flag{i}/@DFlag{repl} or @Flag{z}/@DFlag{text-repl}.}
-
   @item{@FlagFirst{n} or @DFlagFirst{no-lib} : Skips requiring the
         initialization library (i.e., @schememodname[scheme/init] or
         @schememodname[scheme/gui/init], unless it is changed with the
@@ -204,6 +200,10 @@ flags:
         of compiled byte-code @filepath{.zo} files, by initializing
         @scheme[current-compiled-file-paths] to @scheme[null].}
 
+  @item{@FlagFirst{q} or @DFlagFirst{no-init-file} : Skips loading
+        @scheme[(find-system-path 'init-file)] for
+        @Flag{i}/@DFlag{repl} or @Flag{z}/@DFlag{text-repl}.}
+
   @item{@FlagFirst{I} @nonterm{path} : Sets @scheme[(lib #,
         @nontermstr{path})] as the path to @scheme[require] to initialize
         the namespace, unless namespace initialization is disabled.}

collects/scribblings/reference/struct.scrbl

@@ -112,7 +112,8 @@ The resulting structure type has
 addition to any fields from @scheme[super-type]), but only
 @scheme[init-field-cnt] constructor arguments (in addition to any
 constructor arguments from @scheme[super-type]). The remaining fields
-are initialized with @scheme[auto-v].
+are initialized with @scheme[auto-v]. The total field count (including
+@scheme[super-type] fields) must be no more than 32768.
 
 The @scheme[props] argument is a list of pairs, where the @scheme[car]
 of each pair is a structure type property descriptor, and the
@@ -439,8 +440,9 @@ used instead of a list that contains only a symbol (in the case that
 the structure type has no supertype, no automatic fields, and no
 mutable fields).
 
-If the number of fields indicated by @scheme[key] is inconsistent with
+The total field count must be no more than 32768. If the number of
-the number of supplied @scheme[v]s, the @exnraise[exn:fail:contract].
+fields indicated by @scheme[key] is inconsistent with the number of
+supplied @scheme[v]s, the @exnraise[exn:fail:contract].
 
 @examples[
 (make-prefab-struct 'clown "Binky" "pie")
@@ -450,6 +452,14 @@ the number of supplied @scheme[v]s, the @exnraise[exn:fail:contract].
 (make-prefab-struct '(clown 1 (1 #f) #(0)) "Binky" "pie")
 ]}
 
+@defproc[(prefab-key->struct-type [key (or/c symbol? list?)] 
+                                  [field-count (integer-in 0 32768)])
+         struct-type?]{
+
+Returns a @tech{structure type descriptor} for the @tech{prefab}
+structure type specified by the combination of @scheme[key] and
+@scheme[field-count].}
+
 @;------------------------------------------------------------------------
 @section[#:tag "structinfo"]{Structure Type Transformer Binding}
 
@@ -540,10 +550,10 @@ procedure encapsulated by @scheme[make-struct-info].}
 
 @defproc[(checked-struct-info? [v any/c]) boolean?]{
 
-Returns @scheme[#t] if @scheme[v] is a structure encapsulated by 
+Returns @scheme[#t] if @scheme[v] is a procedure encapsulated by
-@scheme[make-struct-info] and produced by @scheme[define-struct]. Such
+@scheme[make-struct-info] and produced by @scheme[define-struct], but
-values may be relied upon to accurately represent a structure and have
+only when no parent type is specified or the parent type is also
-correct super-type information.}
+specified through a transformer binding to such a value).}
 
 @defproc[(make-struct-info [thunk (-> (and/c struct-info? list?))])
          struct-info?]{

collects/scribblings/reference/syntax.scrbl

@@ -1307,6 +1307,7 @@ Legal only in a @tech{module begin context}, and handled by the
                             id
                             (file string)
                             (planet id)
+                            (planet string)
                             (planet rel-string
                                     (user-string pkg-string vers ...)
                                     rel-string ...)]
@@ -1475,12 +1476,13 @@ corresponds to the default @tech{module name resolver}.
  current platform's path conventions.}
 
  @defsubform*[((planet id)
+               (planet string)
                (planet rel-string (user-string pkg-string vers ...)
                        rel-string ...))]{
 
  Specifies a library available via the @PLaneT server.
 
- The first form is a shorthand for the second, where the @scheme[id]'s
+ The first form is a shorthand for the last one, where the @scheme[id]'s
  character sequence must match the following @nonterm{spec} grammar:
 
  @BNF[
@@ -1504,9 +1506,17 @@ corresponds to the default @tech{module name resolver}.
  and where an @nonterm{elem} is a non-empty sequence of characters
  that are ASCII letters, ASCII digits, @litchar{-}, @litchar{+}, or
  @litchar{_}, and an @nonterm{int} is a non-empty sequence of ASCII
- digits.
+ digits. As this shorthand is expended, a @filepath{.plt} extension is
+ added to @nonterm{pkg}, and a @filepath{.ss} extension is added to
+ @scheme{path}; if no @nonterm{path} is included, @filepath{main.ss}
+ is used in the expansion.
 
- In the more general second form of a @scheme[planet] module path, the
+ A @scheme[(planet string)] form is like a @scheme[(planet id)] form
+ with the identifier converted to a string, except that the
+ @scheme[string] can optionally end with a file extension for a
+ @nonterm{path}.
+
+ In the more general last form of a @scheme[planet] module path, the
  @scheme[rel-string]s are similar to the @scheme[lib] form, except
  that the @scheme[(user-string pkg-string vers ...)]  names a
  @|PLaneT|-based package instead of a @tech{collection}.}

collects/scribblings/scribble/reader.scrbl

@@ -284,8 +284,8 @@ are valid text.
 As described above, the text turns to a sequence of string arguments
 for the resulting form.  Spaces at the beginning and end of lines are
 discarded, and newlines turn to individual @scheme["\n"] strings
-(i.e., they are not merged with other body parts).  (See also the
+(i.e., they are not merged with other body parts); see also the
-information about newlines and indentation below.)  Spaces are
+information about newlines and indentation below. Spaces are
 @italic{not} discarded if they appear after the open @litchar["{"]
 (before the closing @litchar["}"]) when there is also text that
 follows (precedes) it; specifically, they are preserved in a

collects/tests/mzscheme/net.ss

@@ -11,7 +11,6 @@
 (require net/url
 	 net/uri-codec
          mzlib/string
-         net/url-unit ; to get set-url:os-type!
          )
 
 (test "%Pq" uri-decode "%Pq")
@@ -280,8 +279,10 @@
   (err/rt-test (string->url "a b://www.foo.com/") url-exception?)
 
   ;; test file: urls
-  (test-s->u #("file" #f #f #f #t (#("abc") #("def.html")) () #f)
+  (test-s->u #("file" #f "" #f #t (#("abc") #("def.html")) () #f)
-             "file:/abc/def.html")
+             "file:///abc/def.html")
+  (test "file:///abc/def.html" url->string (string->url "file:///abc/def.html"))
+  (test "file://a/b" url->string (string->url "file://a/b"))
 
   (test-s->u #("file" #f "localhost" #f #t (#("abc") #("def.html")) () #f)
              "file://localhost/abc/def.html")
@@ -289,25 +290,55 @@
   ;; test files: urls with colons, and the different parsing on Windows
   (test-s->u #("file" #f "localhost" 123 #t (#("abc") #("def.html")) () #f)
              "file://localhost:123/abc/def.html")
-  (set-url:os-type! 'unix)
+  (parameterize ([file-url-path-convention-type 'unix])
-  ;; different parse for file://foo:/...
+    ;; different parse for file://foo:/...
-  (test #("file" #f "foo" #f #t (#("abc") #("def.html")) () #f)
+    (test #("file" #f "foo" #f #t (#("abc") #("def.html")) () #f)
+          string->url/vec
+          "file://foo:/abc/def.html"))
+  (parameterize ([file-url-path-convention-type 'windows])
+    (test #("file" #f "" #f #t (#("foo:") #("abc") #("def.html")) () #f)
         string->url/vec
         "file://foo:/abc/def.html")
-  (set-url:os-type! 'windows)
+    (test #("file" #f "" #f #t (#("c:") #("abc") #("def.html")) () #f)
-  (test #("file" #f #f #f #f (#("foo:") #("abc") #("def.html")) () #f)
         string->url/vec
-        "file://foo:/abc/def.html")
+        "file://c:/abc/def.html")
-  (set-url:os-type! 'unix)
+    (test #("file" #f "" #f #t (#("") #("d") #("c") #("abc") #("def.html")) () #f)
-  ;; but no effect on http://foo:/...
-  (test #("http" #f "foo" #f #t (#("abc") #("def.html")) () #f)
         string->url/vec
-        "http://foo:/abc/def.html")
+        "file:\\\\d\\c\\abc\\def.html"))
-  (set-url:os-type! 'windows)
+
-  (test #("http" #f "foo" #f #t (#("abc") #("def.html")) () #f)
+  (parameterize ([file-url-path-convention-type 'unix])
-        string->url/vec
+    ;; but no effect on http://foo:/...
-        "http://foo:/abc/def.html")
+    (test #("http" #f "foo" #f #t (#("abc") #("def.html")) () #f)
-  (set-url:os-type! 'unix)
+          string->url/vec
+          "http://foo:/abc/def.html"))
+  (parameterize ([file-url-path-convention-type 'windows])
+    (test #("http" #f "foo" #f #t (#("abc") #("def.html")) () #f)
+          string->url/vec
+          "http://foo:/abc/def.html"))
+
+  (test "file:///c:/a/b"
+        url->string (path->url (bytes->path #"c:\\a\\b" 'windows)))    
+  (test "file:///c:/a/b"
+        url->string (path->url (bytes->path #"\\\\?\\c:\\a\\b" 'windows)))
+
+  (test #"/a/b/c" path->bytes
+        (url->path (path->url (bytes->path #"/a/b/c" 'unix)) 'unix))
+  (test #"a/b/c" path->bytes
+        (url->path (path->url (bytes->path #"a/b/c" 'unix)) 'unix))
+  (test #"c:\\a\\b" path->bytes
+        (url->path (path->url (bytes->path #"c:/a/b" 'windows)) 'windows))
+  (test #"a\\b" path->bytes
+        (url->path (path->url (bytes->path #"a/b" 'windows)) 'windows))
+  (test #"\\\\d\\c\\a" path->bytes
+        (url->path (path->url (bytes->path #"//d/c/a" 'windows)) 'windows))
+  (test #"c:\\a\\b" path->bytes
+        (url->path (path->url (bytes->path #"\\\\?\\c:\\a\\b" 'windows)) 'windows))
+  (test #"\\\\d\\c\\a\\b" path->bytes
+        (url->path (path->url (bytes->path #"\\\\?\\UNC\\d\\c\\a\\b" 'windows)) 'windows))
+  (test #"\\\\?\\c:\\a/x\\b" path->bytes
+        (url->path (path->url (bytes->path #"\\\\?\\c:\\a/x\\b" 'windows)) 'windows))
+  (test #"\\\\?\\UNC\\d\\c\\a/x\\b" path->bytes
+        (url->path (path->url (bytes->path #"\\\\?\\UNC\\d\\\\c\\a/x\\b" 'windows)) 'windows))
     
   ;; see PR8809 (value-less keys in the query part)
   (test-s->u #("http" #f "foo.bar" #f #t (#("baz")) ((ugh . #f)) #f)

src/mzscheme/cmdline.inc

@@ -833,6 +833,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	  break;
 	case 'q':
 	  no_init_file = 1;
+          was_config_flag = 1;
 	  break;
         case 'n':
           no_init_ns = 1;
@@ -1073,7 +1074,6 @@ static int run_from_cmd_line(int argc, char *_argv[],
 # ifdef CMDLINE_STDIO_FLAG
 	 "  -z, --text-repl : Like -i, but use text read-eval-print loop\n"
 # endif
-	 "  -q, --no-init-file : Skip load of " INIT_FILENAME " for " REPL_FLAGS "\n"
          "  -n, --no-lib : Skip `(require (lib \"<init-lib>\"))' for " REPL_FLAGS "/-e/-f/-r\n"
 	 "  -v, --version : Show version\n"
 # ifdef CMDLINE_STDIO_FLAG
@@ -1084,6 +1084,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 # endif
 	 " Configuration options:\n"
          "  -c, --no-compiled : Disable loading of compiled files\n"
+	 "  -q, --no-init-file : Skip load of " INIT_FILENAME " for " REPL_FLAGS "\n"
          "  -I <path> : Set <init-lib> to <path>\n"
 	 "  -X <dir>, --collects <dir> : Main collects at <dir> relative to " PROGRAM "\n"
 	 "  -S <dir>, --search <dir> : More collects at <dir> relative to " PROGRAM "\n"

src/mzscheme/src/port.c

@@ -286,7 +286,7 @@ int scheme_force_port_closed;
 static int flush_out, flush_err;
 
 #if defined(FILES_HAVE_FDS)
-static int external_event_fd, put_external_event_fd, event_fd_set;
+static int external_event_fd, put_external_event_fd;
 #endif
 
 static void register_port_wait();
@@ -7961,7 +7961,6 @@ static void default_sleep(float v, void *fds)
   if (external_event_fd) {
     char buf[10];
     read(external_event_fd, buf, 10);
-    event_fd_set = 0;
   }
 #endif
 }
@@ -7980,8 +7979,7 @@ void scheme_signal_received(void)
 /* Ensure that MzScheme wakes up if asleep. */
 {
 #if defined(FILES_HAVE_FDS)
-  if (put_external_event_fd && !event_fd_set) {
+  if (put_external_event_fd) {
-    event_fd_set = 1;
     write(put_external_event_fd, "!", 1);
   }
 #endif

src/mzscheme/src/struct.c

@@ -1784,14 +1784,19 @@ static Scheme_Object *make_prefab_struct(int argc, Scheme_Object *argv[])
   return scheme_make_prefab_struct_instance(stype, vec);
 }
 
+#define MAX_STRUCT_FIELD_COUNT 32768
+#define MAX_STRUCT_FIELD_COUNT_STR "32768"
+
 static Scheme_Object *prefab_key_struct_type(int argc, Scheme_Object *argv[])
 {
   Scheme_Struct_Type *stype;
   int v;
 
-  if (!SCHEME_INTP(argv[1]))
+  if (SCHEME_INTP(argv[1])) {
     v = SCHEME_INT_VAL(argv[1]);
-  else
+    if (v > MAX_STRUCT_FIELD_COUNT)
+      v = -1;
+  } else
     v = -1;
 
   stype = scheme_lookup_prefab_type(argv[0], (v >= 0) ? v : -1);
@@ -1800,7 +1805,15 @@ static Scheme_Object *prefab_key_struct_type(int argc, Scheme_Object *argv[])
     scheme_wrong_type("make-prefab-struct", "prefab key", 0, argc, argv);
 
   if (v < 0)
-    scheme_wrong_type("make-prefab-struct", "non-negative fixnum", 1, argc, argv);
+    scheme_wrong_type("make-prefab-struct", 
+                      "integer in [0, " MAX_STRUCT_FIELD_COUNT_STR "]", 
+                      1, argc, argv);
+
+  if (stype->num_slots != v) {
+    scheme_arg_mismatch("make-prefab-struct", 
+                        "prefab key field count does not match supplied count: ",
+                        argv[1]);
+  }
 
   return (Scheme_Object *)stype;
 }
@@ -2661,17 +2674,17 @@ static Scheme_Object *_make_struct_type(Scheme_Object *basesym, const char *base
   if (parent_type)
     struct_type->proc_attr = parent_type->proc_attr;
 
-  /* Check for integer overflow or total more than 32768: */
+  /* Check for integer overflow or total more than MAX_STRUCT_FIELD_COUNT: */
   if ((num_fields < 0) || (num_uninit_fields < 0)
-      || (num_fields > 32768)
+      || (num_fields > MAX_STRUCT_FIELD_COUNT)
-      || (num_uninit_fields > 32768)
+      || (num_uninit_fields > MAX_STRUCT_FIELD_COUNT)
-      || (num_uninit_fields + num_fields > 32768)
+      || (num_uninit_fields + num_fields > MAX_STRUCT_FIELD_COUNT)
       || (parent_type
 	  && ((struct_type->num_slots < parent_type->num_slots)
 	      || (struct_type->num_islots < parent_type->num_islots)))) {
     /* Too many fields. */
     scheme_raise_exn(MZEXN_FAIL,
-		     "too many fields for struct-type; maximum total field count is 32768");
+		     "too many fields for struct-type; maximum total field count is " MAX_STRUCT_FIELD_COUNT_STR);
     return NULL;
   }
 
@@ -3276,6 +3289,9 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
   if (scheme_proper_list_length(key) < 0)
     return NULL;
 
+  if (field_count > MAX_STRUCT_FIELD_COUNT)
+    field_count = MAX_STRUCT_FIELD_COUNT;
+
   if (prefab_table) {
     a = scheme_lookup_in_table(prefab_table, (const char *)key);
     if (a)
@@ -3329,6 +3345,8 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
         return NULL;
     } else {
       icnt = SCHEME_INT_VAL(a);
+      if (icnt > MAX_STRUCT_FIELD_COUNT)
+        return NULL;
       key = SCHEME_CDR(key);
     }
     
@@ -3371,6 +3389,9 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
       prev++;
     }
 
+    if (parent && (icnt + parent->num_slots > MAX_STRUCT_FIELD_COUNT))
+      return NULL;
+
     parent = (Scheme_Struct_Type *)_make_struct_type(name, NULL, 0, 
                                                      (Scheme_Object *)parent,
                                                      scheme_false,