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

A bunch of fprintf' -> eprintf' conversions (and a few related things).

Browse Source
This commit is contained in:
Eli Barzilay 2012-05-06 12:06:00 -04:00
parent 084f1dcea7
commit 17090fca4f
98 changed files with 243 additions and 367 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/2htdp/private/image-more.rkt
View File

@ -651,9 +651,9 @@
(ibitmap-angle bitmap))])
(values l t r b)))]
[else
(fprintf (current-error-port) "using bad bounding box for ~s\n" atomic-shape)
(eprintf "using bad bounding box for ~s\n" atomic-shape)
(values 0 0 100 100)]))
(define (rotated-rectangular-bounding-box w h θ)
(let*-values ([(ax ay) (rotate-xy (- (/ w 2)) (- (/ h 2)) θ)]
[(bx by) (rotate-xy (- (/ w 2)) (/ h 2) θ)]

3
collects/compiler/commands/ctool.rkt
View File

@ -225,8 +225,7 @@
(begin (link-variant 'cgc) (compile-variant 'cgc)))
(define (compiler-warning)
(fprintf (current-error-port)
"Warning: ~a\n ~a\n"
(eprintf "Warning: ~a\n ~a\n"
"compilation to C is usually less effective for performance"
"than relying on the bytecode just-in-time compiler."))

3
collects/compiler/demodularizer/util.rkt
View File

@ -9,9 +9,6 @@
(define total-stxs (length (prefix-stxs pre)))
(+ syntax-start total-stxs (if (zero? total-stxs) 0 1)))
(define (eprintf . args)
(apply fprintf (current-error-port) args))
(struct nothing ())
(define-syntax-rule (eprintf* . args) (void))

20
collects/compiler/embed-unit.rkt
View File

@ -364,7 +364,7 @@
[else
;; First use of the module. Get code and then get code for imports.
(when verbose?
(fprintf (current-error-port) "Getting ~s as ~s\n" module-path filename))
(eprintf "Getting ~s as ~s\n" module-path filename))
(let* ([submod-path (if (pair? filename)
(cddr filename)
null)]
@ -412,7 +412,7 @@
(cond
[(extension? code)
(when verbose?
(fprintf (current-error-port) " using extension: ~s\n" (extension-path code)))
(eprintf " using extension: ~s\n" (extension-path code)))
(set-box! codes
(cons (make-mod filename module-path code
name prefix full-name
@ -504,7 +504,7 @@
(append sub-paths normalized-extra-paths))
(when verbose?
(unless (null? runtime-paths)
(fprintf (current-error-port) "Runtime paths for ~s: ~s\n"
(eprintf "Runtime paths for ~s: ~s\n"
filename
runtime-paths)))
(if (and collects-dest
@ -934,7 +934,7 @@
(quote ,(map (lambda (m)
(let ([p (extension-path (mod-code m))])
(when verbose?
(fprintf (current-error-port) "Recording extension at ~s\n" p))
(eprintf "Recording extension at ~s\n" p))
(list (path->bytes p)
(mod-full-name m)
;; The program name isn't used. It just helps ensures that
@ -1040,7 +1040,7 @@
(unless (or (extension? (mod-code nc))
(eq? nc table-mod))
(when verbose?
(fprintf (current-error-port) "Writing module from ~s\n" (mod-file nc)))
(eprintf "Writing module from ~s\n" (mod-file nc)))
(write (compile-using-kernel
`(current-module-declare-name
(make-resolved-module-path
@ -1067,7 +1067,7 @@
outp))))
(for-each (lambda (f)
(when verbose?
(fprintf (current-error-port) "Copying from ~s\n" f))
(eprintf "Copying from ~s\n" f))
(call-with-input-file* f
(lambda (i)
(copy-port i outp))))
@ -1173,7 +1173,7 @@
(check-collects-path 'create-embedding-executable collects-path collects-path-bytes)
(let ([exe (find-exe mred? variant)])
(when verbose?
(fprintf (current-error-port) "Copying to ~s\n" dest))
(eprintf "Copying to ~s\n" dest))
(let-values ([(dest-exe orig-exe osx?)
(cond
[(and mred? (eq? 'macosx (system-type)))
@ -1347,12 +1347,12 @@
#:exists 'append))
(values start decl-end (file-size dest-exe) #f)))))])
(when verbose?
(fprintf (current-error-port) "Setting command line\n"))
(let ()
(eprintf "Setting command line\n"))
(let ()
(let ([full-cmdline (make-full-cmdline start decl-end end)])
(when collects-path-bytes
(when verbose?
(fprintf (current-error-port) "Setting collection path\n"))
(eprintf "Setting collection path\n"))
(set-collects-path dest-exe collects-path-bytes))
(cond
[(and use-starter-info? osx?)

3
collects/compiler/main.rkt
View File

@ -376,8 +376,7 @@
(begin (link-variant 'cgc) (compile-variant 'cgc)))
(define (compiler-warning)
(fprintf (current-error-port)
"Warning: ~a\n ~a\n"
(eprintf "Warning: ~a\n ~a\n"
"compilation to C is usually less effective for performance"
"than relying on the bytecode just-in-time compiler."))

7
collects/compiler/private/macfw.rkt
View File

@ -44,8 +44,7 @@
(if v
(bytes->string/utf-8 v)
(begin
(fprintf (current-error-port)
"warning: cannot find existing link for ~a in ~a\n"
p dest)
#f)))))
(eprintf "warning: cannot find existing link for ~a in ~a\n"
p dest)
#f)))))

15
collects/compiler/private/xform.rkt
View File

@ -459,7 +459,7 @@
(let loop ()
(let ([l (read-bytes-line (list-ref proc 3) 'any)])
(unless (eof-object? l)
(fprintf (current-error-port) "~a\n" l)
(eprintf "~a\n" l)
(loop))))
(close-input-port (list-ref proc 3)))))
@ -569,8 +569,8 @@
(define exit-with-error? #f)
(define (log-error format . args)
(fprintf (current-error-port) "Error ")
(apply fprintf (current-error-port) format args)
(eprintf "Error ")
(apply eprintf format args)
(newline (current-error-port))
(set! exit-with-error? #t))
@ -2472,8 +2472,7 @@
name))
(unless saw-gcing-call
'
(fprintf (current-error-port)
"[SUGGEST] Consider declaring ~a as __xform_nongcing__.\n"
(eprintf "[SUGGEST] Consider declaring ~a as __xform_nongcing__.\n"
name)))
(if (and (not important-conversion?)
(not (and function-name
@ -3463,15 +3462,13 @@
;; local vars taken in the function.
(not (or (ormap (lambda (var)
(and (array-type? (cdr var))
'(fprintf (current-error-port)
"Optwarn [return] ~a in ~a: tail-push blocked by ~s[].\n"
'(eprintf "Optwarn [return] ~a in ~a: tail-push blocked by ~s[].\n"
(tok-line (car func)) (tok-file (car func))
(car var))))
(live-var-info-vars live-vars))
(ormap (lambda (&-var)
(and (assq &-var vars)
'(fprintf (current-error-port)
"Optwarn [return] ~a in ~a: tail-push blocked by &~s.\n"
'(eprintf "Optwarn [return] ~a in ~a: tail-push blocked by &~s.\n"
(tok-line (car func)) (tok-file (car func))
&-var)))
&-vars))))]

2
collects/db/private/generic/common.rkt
View File

@ -87,7 +87,7 @@
(set! DEBUG? debug?))
(define/public (dprintf fmt . args)
(when DEBUG? (apply fprintf (current-error-port) fmt args)))
(when DEBUG? (apply eprintf fmt args)))
))
;; ----------------------------------------

4
collects/deinprogramm/deinprogramm-langs.rkt
View File

@ -1189,8 +1189,8 @@
(if (exn? exn)
(display (exn-message exn) (current-error-port))
(fprintf (current-error-port) "uncaught exception: ~e" exn))
(fprintf (current-error-port) "\n")
(eprintf "uncaught exception: ~e" exn))
(eprintf "\n")
;; need to flush here so that error annotations inserted in next line
;; don't get erased if this output were to happen after the insertion

4
collects/deinprogramm/signature/signature-unit.rkt
View File

@ -135,7 +135,7 @@
(make-signature
name
(lambda (self obj)
;;(write (list 'list obj) (current-error-port)) (newline (current-error-port))
;;(eprintf "~s\n" (list 'list obj))
(let recur ((l obj))
(define (go-on)
@ -153,7 +153,7 @@
obj)
((hash-ref lists-table l #f)
=> (lambda (seen)
;;(write (list 'seen seen (eq? self (car seen))) (current-error-port)) (newline (current-error-port))
;;(eprintf "~s\n" (list 'seen seen (eq? self (car seen))))
(if (eq? self (car seen))
(cdr seen)
(go-on))))

2
collects/drracket/drracket.rkt
View File

@ -132,7 +132,7 @@
(printf "~a\n" msg)
(printf "stdout from compiling ~a:\n~a\n" path out)
(flush-output)
(fprintf (current-error-port) "stderr from compiling ~a:\n~a\n" path err)])))
(eprintf "stderr from compiling ~a:\n~a\n" path err)])))
(flprintf "PLTDRPAR: installing compilation manager\n")
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))])

6
collects/drracket/private/debug.rkt
View File

@ -212,7 +212,7 @@ profile todo:
; (for-each loop (syntax->list stx))]
; [exp
; (set! exps (+ exps 1))]))
; (fprintf (current-error-port) "exps: ~v\nwcms: ~v\n" exps wcms))
; (eprintf "exps: ~v\nwcms: ~v\n" exps wcms))
; stx)
;; make-debug-eval-handler : (sexp -> value) -> sexp -> value
@ -459,8 +459,8 @@ profile todo:
(current-error-port))]
[else
(display "<unsaved editor>" (current-error-port))]))]
[do-line/col (λ () (fprintf (current-error-port) ":~a:~a" line col))]
[do-pos (λ () (fprintf (current-error-port) "::~a" pos))]
[do-line/col (λ () (eprintf ":~a:~a" line col))]
[do-pos (λ () (eprintf "::~a" pos))]
[src-loc-in-defs/ints?
(let ([rep (drracket:rep:current-rep)])
(and rep

3
collects/drracket/private/eval-helpers.rkt
View File

@ -61,8 +61,7 @@
[cpaths (append-map (λ (x) (if (symbol? x) default (list x)))
(prefab-module-settings-collection-paths settings))])
(when (null? cpaths)
(fprintf (current-error-port)
"WARNING: your collection paths are empty!\n"))
(eprintf "WARNING: your collection paths are empty!\n"))
(current-library-collection-paths cpaths))
(compile-context-preservation-enabled (prefab-module-settings-full-trace? settings))

12
collects/drracket/private/language-configuration.rkt
View File

@ -1636,7 +1636,7 @@
(define/override (first-opened)
(not-a-language-message)
(fprintf (current-error-port) "\n"))
(eprintf "\n"))
(define/override (front-end/interaction input settings)
(not-a-language-message)
@ -1720,13 +1720,9 @@
(define o
(case-lambda
[(arg)
(cond
[(string? arg)
(fprintf (current-error-port) arg)]
[(is-a? arg snip%)
(write-special arg (current-error-port))])]
[args (apply fprintf (current-error-port) args)]))
[(arg) (cond [(string? arg) (eprintf arg)]
[(is-a? arg snip%) (write-special arg (current-error-port))])]
[args (apply eprintf args)]))
(define arrow-cursor (make-object cursor% 'arrow))

10
collects/drracket/private/module-language-tools.rkt
View File

@ -166,11 +166,13 @@
; sometimes I get eof here, but I don't know why and can't seem to
;; make it happen outside of DrRacket
(when (eof-object? info-result)
(fprintf (current-error-port) "file ~s produces eof from read-language\n"
(eprintf "file ~s produces eof from read-language\n"
(send this get-filename))
(fprintf (current-error-port) " port-next-location ~s\n" (call-with-values (λ () (port-next-location port)) list))
(fprintf (current-error-port) " str ~s\n" (let ([s (send this get-text)])
(substring s 0 (min 100 (string-length s)))))
(eprintf " port-next-location ~s\n"
(call-with-values (λ () (port-next-location port)) list))
(eprintf " str ~s\n"
(let ([s (send this get-text)])
(substring s 0 (min 100 (string-length s)))))
(set! info-result #f))
(let-values ([(line col pos) (port-next-location port)])
(unless (equal? (get-text 0 pos) hash-lang-language)

2
collects/drracket/private/module-language.rkt
View File

@ -506,7 +506,7 @@
;; raise the exception as normal. (It can happen in some rare cases like
;; having a single empty scheme box in the definitions.)
(unless rep (if exn (raise exn) (error "\nInteractions disabled")))
(when prefix (fprintf (current-error-port) "Module Language: ~a\n" prefix))
(when prefix (eprintf "Module Language: ~a\n" prefix))
(when exn ((error-display-handler) (exn-message exn) exn))
;; these are needed, otherwise the warning can appear before the output
(flush-output (current-output-port))

3
collects/drracket/private/rep.rkt
View File

@ -1319,8 +1319,7 @@ TODO
(set! raised-exn? #t))))
(drracket:language:setup-setup-values))))
(when raised-exn?
(fprintf
(current-error-port)
(eprintf
(string-append
"copied exn raised when setting up snip values"
" (thunk passed as third argume to drracket:language:add-snip-value)\n"))

13
collects/ffi/examples/use-tcl.rkt
View File

@ -5,14 +5,11 @@
(require "tcl.rkt")
(define (tcldemo . strs)
(for-each (lambda (s)
(printf "> ~a\n" s)
(with-handlers ([void (lambda (e)
(display (if (exn? e) (exn-message e) e)
(current-error-port))
(newline (current-error-port)))])
(printf "~a\n" (eval-tcl s))))
strs))
(for ([s (in-list strs)])
(printf "> ~a\n" s)
(with-handlers ([void (lambda (e)
(eprintf "~a\n" (if (exn? e) (exn-message e) e)))])
(printf "~a\n" (eval-tcl s)))))
(tcldemo "puts 123"
"puts $a"

7
collects/framework/splash.rkt
View File

@ -179,7 +179,7 @@
[(or (path? splash-draw-spec)
(string? splash-draw-spec))
(unless (file-exists? splash-draw-spec)
(fprintf (current-error-port) "WARNING: bitmap path ~s not found\n" splash-draw-spec)
(eprintf "WARNING: bitmap path ~s not found\n" splash-draw-spec)
(no-splash))
(set! splash-bitmap (make-object bitmap% splash-draw-spec))]
@ -187,7 +187,7 @@
(set! splash-bitmap splash-draw-spec)])
(unless (send splash-bitmap ok?)
(fprintf (current-error-port) "WARNING: bad bitmap ~s\n" splash-draw-spec)
(eprintf "WARNING: bad bitmap ~s\n" splash-draw-spec)
(no-splash))
(send splash-canvas min-width (send splash-bitmap get-width))
@ -208,8 +208,7 @@
[(not splash-draw-spec)
(no-splash)]
[else
(fprintf (current-error-port)
"WARNING: unknown splash spec: ~s" splash-draw-spec)
(eprintf "WARNING: unknown splash spec: ~s" splash-draw-spec)
(no-splash)])
(refresh-splash)

4
collects/frtime/core/frp.rkt
View File

@ -613,9 +613,7 @@
(list (hash-ref named-dependents sym (lambda () dummy)) val))
(loop)]
[msg
(fprintf (current-error-port)
"frtime engine: msg not understood: ~a\n"
msg)
(eprintf "frtime engine: msg not understood: ~a\n" msg)
(loop)]))
;; enqueue expired timers for execution

6
collects/frtime/lang-core.rkt
View File

@ -91,10 +91,10 @@
(opt-lambda (obj [mem empty])
(with-handlers ((exn:fail?
(lambda (e)
(fprintf
(current-error-port)
(eprintf
"you've encountered a bug in frtime. please send a report to the Racket mailing list.\nexn: ~a\n"
e) #f)))
e)
#f)))
(cond
[(memq obj mem) #f]
[(behavior? obj) #t]

4
collects/frtime/lang-ext.rkt
View File

@ -555,7 +555,7 @@
[proc-k (lambda (evt) (proc emit suspend evt) (set! proc-k #f))])
(let ([thunk (lambda ()
(when (ormap undefined? streams)
;(fprintf (current-error-port) "had an undefined stream\n")
;(eprintf "had an undefined stream\n")
(set! streams (fix-streams streams args)))
(let loop ([streams streams])
(extract (lambda (the-event strs)
@ -776,7 +776,7 @@
(syntax->list #'(exp ...)))])
#'(tag new-exp ...))]
[x (begin
(fprintf (current-error-port) "snapshot-unbound: fell through on ~a\n" #'x)
(eprintf "snapshot-unbound: fell through on ~a\n" #'x)
'())]))))
(syntax-case stx ()

3
collects/games/chat-noir/chat-noir-unit.rkt
View File

@ -59,8 +59,7 @@
[parent f]
[callback (λ (x y) (show-help))]
[label (string-constant help)]))]))]
[else
(fprintf (current-error-port) "never found a window\n")]))))
[else (eprintf "never found a window\n")]))))
;; start up the game

3
collects/games/gcalc/gcalc.rkt
View File

@ -105,9 +105,6 @@
(define 3rd caddr)
(define 4th cadddr)
(define (eprintf . args)
(apply fprintf (current-error-port) args))
(define (read-from-string str)
(with-handlers ([void (lambda (x) #f)])
(let ([obj (read (open-input-string (string-append "(" str ")")))])

21
collects/games/paint-by-numbers/raw-problems/build-hattori.rkt
View File

@ -9,15 +9,12 @@
(define (main-n n)
(let ([grid (calculate-grid (build-path 'up "hattori" (format "~a.gif" n)))])
(display-grid grid)
(pretty-print
(build-problem
n grid))
(pretty-print (build-problem n grid))
(newline)
(newline (current-error-port))
(newline (current-error-port))))
(eprintf "\n\n")))
(define (calculate-grid filename)
(fprintf (current-error-port) "reading ~a\n" filename)
(eprintf "reading ~a\n" filename)
(let* ([bitmap (make-object bitmap% filename)]
[_ (unless (send bitmap ok?)
(error 'bad-bitmap "name: ~a" filename))]
@ -34,12 +31,10 @@
[new-bitmap-height (floor (/ (- puzzle-height 1) pixel-size))])
(begin
(fprintf (current-error-port) "size of picture: ~a x ~a\n" raw-width raw-height)
(fprintf (current-error-port) " size of image: ~a x ~a\n" image-width image-height)
(fprintf (current-error-port) "grid-start (~a, ~a)\n" grid-x-start grid-y-start)
(fprintf (current-error-port) "size of puzzle: ~a x ~a\n"
puzzle-width
puzzle-height))
(eprintf "size of picture: ~a x ~a\n" raw-width raw-height)
(eprintf " size of image: ~a x ~a\n" image-width image-height)
(eprintf "grid-start (~a, ~a)\n" grid-x-start grid-y-start)
(eprintf "size of puzzle: ~a x ~a\n" puzzle-width puzzle-height))
(reverse
(let loop ([j new-bitmap-height])
(cond
@ -62,7 +57,7 @@
(* pixel-size (+ j -1 1/2)))))
'x
'o)])
;(fprintf (current-error-port) "(~a, ~a) is ~a\n" i j pixel-value)
;(eprintf "(~a, ~a) is ~a\n" i j pixel-value)
(cons pixel-value
(loop (- i 1))))])))
(loop (- j 1)))])))))

9
collects/games/paint-by-numbers/raw-problems/build-rows-cols.rkt
View File

@ -5,15 +5,14 @@
(when (equal? (vector) argv)
(error 'build-rows-cols.rkt
"expected an image file on the command-line"))
"expected an image file on the command-line"))
(define image (vector-ref argv 0))
(fprintf (current-error-port) "processing ~a\n" image)
(eprintf "processing ~a\n" image)
(define bitmap (make-object bitmap% image))
(when (send bitmap is-color?)
(fprintf (current-error-port)
"expected a monochrome bitmap -- all non-black spaces will be considered white\n"))
(eprintf "expected a monochrome bitmap -- all non-black spaces will be considered white\n"))
(newline (current-error-port))

8
collects/games/paint-by-numbers/raw-problems/build-solution-sets.rkt
View File

@ -205,10 +205,8 @@ The col and row type specs are in sig.rkt and the solution type is:
(semaphore-wait kill)
(set! sucessful? #f)
(kill-thread k)
(fprintf (current-error-port) "\nsolver raised an exception\n~a\n"
(if (exn? x)
(exn-message x)
x))
(eprintf "\nsolver raised an exception\n~a\n"
(if (exn? x) (exn-message x) x))
(semaphore-post done))])
(solve:solve rows cols set-entry
(lambda (max)
@ -235,7 +233,7 @@ The col and row type specs are in sig.rkt and the solution type is:
(void))))))
(semaphore-wait kill)
(kill-thread t)
(fprintf (current-error-port) "\n memory limit expired.\n")
(eprintf "\n memory limit expired.\n")
(collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
(update-memory-display)
(semaphore-post done)))])

2
collects/games/paint-by-numbers/solve.rkt
View File

@ -451,7 +451,7 @@
old-tries
(let* ([least-difficult
(apply min unmemoized)])
;(fprintf (current-error-port) "guessed tries: ~v\n" least-difficult)
;(eprintf "guessed tries: ~v\n" least-difficult)
(map (lambda (old-try-set block-list board-row)
(cond [(and (number? old-try-set) (= old-try-set least-difficult))
(let ([spaces (spare-spaces block-list line-length)]

18
collects/games/parcheesi/test.rkt
View File

@ -9,9 +9,9 @@
(define (test-results)
(cond
[(= 0 (unbox failure-count))
(fprintf (current-error-port) "All ~a tests passed." (unbox test-count))]
(eprintf "All ~a tests passed." (unbox test-count))]
[else
(fprintf (current-error-port) "~a tests failed, ~a tests total"
(eprintf "~a tests failed, ~a tests total"
(unbox failure-count)
(unbox test-count))]))
@ -23,8 +23,7 @@
(with-handlers ([pred (lambda (x) (void))])
(when show-tests? (printf "> running test ~s\n" line))
(set-box! test-count (+ (unbox test-count) 1))
(fprintf (current-error-port)
"test ~a ~s:\n expected error, got ~a\n\n"
(eprintf "test ~a ~s:\n expected error, got ~a\n\n"
line
'actual
(flatten-list (call-with-values (lambda () actual) list)))
@ -46,9 +45,9 @@
(set-box! test-count (+ (unbox test-count) 1))
(unless (equal? actual-xs expect-xs)
(set-box! failure-count (+ (unbox failure-count) 1))
(fprintf (current-error-port) "test ~a ~s:\ngot:\n" line 'actual)
(eprintf "test ~a ~s:\ngot:\n" line 'actual)
(for-each (lambda (x) (pretty-print x (current-error-port))) actual-xs)
(fprintf (current-error-port) "expected:\n")
(eprintf "expected:\n")
(for-each (lambda (x) (pretty-print x (current-error-port))) expect-xs))))))]))
(define-syntax (test-list stx)
@ -63,11 +62,8 @@
[show-err
(lambda (in not-in val)
(set-box! failure-count (+ (unbox failure-count) 1))
(fprintf (current-error-port) "test ~a ~s found in ~a but not in ~a:\n"
line
'actual
in
not-in)
(eprintf "test ~a ~s found in ~a but not in ~a:\n"
line 'actual in not-in)
(pretty-print val (current-error-port)))])
(set-box! test-count (+ (unbox test-count) 1))
(for-each (lambda (one-actual)

3
collects/games/pousse/counter.rkt
View File

@ -69,8 +69,7 @@
(set! thems (/ thems 2)))
'(when (= depth 2)
(fprintf (current-error-port)
"us: ~a them: ~a u-m:~a t-m: ~a u-l: ~a t-l: ~a u-c: ~a t-c: ~a\n"
(eprintf "us: ~a them: ~a u-m:~a t-m: ~a u-l: ~a t-l: ~a u-c: ~a t-c: ~a\n"
usses thems
middle-usses middle-thems
us-in-line them-in-line

16
collects/games/pousse/robot.rkt
View File

@ -125,7 +125,7 @@
(- (car gf) good-so-far))])
'(when (and (= depth RECURSION-DEPTH))
(fprintf (current-error-port) "Returned goodness: ~a\n" (car move))
(eprintf "Returned goodness: ~a\n" (car move))
(print-board (cadr gf) (current-error-port)))
(let ([g (car move)])
@ -153,7 +153,7 @@
'(when (and (= depth RECURSION-DEPTH))
(for-each (lambda (gf)
(fprintf (current-error-port) "Goodness: ~a\n" (car gf))
(eprintf "Goodness: ~a\n" (car gf))
(print-board (cadr gf) (current-error-port)))
good-futures))
@ -263,9 +263,9 @@
(thread
(lambda ()
(let loop ([iteration 0])
; (fprintf (current-error-port) "Starting iteration ~a\n" iteration)
; (eprintf "Starting iteration ~a\n" iteration)
(set! result (f iteration))
'(fprintf (current-error-port) " [finished iteration depth ~a: ~a~a]\n"
'(eprintf " [finished iteration depth ~a: ~a~a]\n"
iteration (cadr result) (add1 (cddr result)))
(unless (or (pair? (car result)))
(loop (add1 iteration)))))))
@ -282,7 +282,7 @@
(define (go)
'(begin
(fprintf (current-error-port) "Start:\n")
(eprintf "Start:\n")
(print-board board (current-error-port)))
(let* ([go (lambda (i)
(set! RECURSION-DEPTH i)
@ -292,10 +292,8 @@
(go depth)
(use-up-time go))])
'(when (pair? (car result))
(fprintf (current-error-port) "we ~a\n"
(if (= (caar result) LOSER-GOODNESS)
"lose"
"win")))
(eprintf "we ~a\n"
(if (= (caar result) LOSER-GOODNESS) "lose" "win")))
(output-move (cdr result))))
;; Given (cons <side> <index>), returns the move

2
collects/gui-debugger/debug-tool.rkt
View File

@ -942,7 +942,7 @@
(define/public (print-to-console v)
;; ==drscheme eventspace thread==
;; only when a user thread is suspended
(do-in-user-thread (lambda () (fprintf (current-error-port) " ### DEBUGGER: ~s\n" v))))
(do-in-user-thread (lambda () (eprintf " ### DEBUGGER: ~s\n" v))))
(define (frame->end-breakpoint-status frame)
(let/ec k

4
collects/handin-server/private/config.rkt
View File

@ -37,9 +37,7 @@
;; write anything if this is the first read, since the logger
;; is not initialized yet (and if there's an error at this
;; stage, the server will exit)
(fprintf (current-error-port)
(format "reloading configuration from ~a\n"
config-file)))
(eprintf (format "reloading configuration from ~a\n" config-file)))
(let ([c (with-input-from-file config-file read)])
(if (and (list? c)
(andmap (lambda (x)

4
collects/handin-server/private/logger.rkt
View File

@ -9,8 +9,8 @@
;; string to print in one shot, and flushes the output)
(provide log-line)
(define (log-line fmt . args)
(let ([line (format "~a\n" (apply format fmt args))])
(display line (current-error-port))))
(define line (format "~a\n" (apply format fmt args)))
(display line (current-error-port)))
(define (prefix)
(parameterize ([date-display-format 'iso-8601])

4
collects/lang/htdp-langs.rkt
View File

@ -996,8 +996,8 @@
(define (teaching-languages-error-display-handler msg exn)
(if (exn? exn)
(display (get-rewriten-error-message exn) (current-error-port))
(fprintf (current-error-port) "uncaught exception: ~e" exn))
(fprintf (current-error-port) "\n")
(eprintf "uncaught exception: ~e" exn))
(eprintf "\n")
;; need to flush here so that error annotations inserted in next line
;; don't get erased if this output were to happen after the insertion

4
collects/macro-debugger/model/deriv-parser.rkt
View File

@ -164,9 +164,7 @@
[(enter-prim (? Prim) exit-prim return)
(begin
(unless (eq? $3 $4)
(fprintf (current-error-port)
"warning: exit-prim and return differ:\n~s\n~s\n"
$3 $4))
(eprintf "warning: exit-prim and return differ:\n~s\n~s\n" $3 $4))
($2 $1 $3 rs))]
[((? MacroStep) (? EE))
($1 e1 rs $2)])

6
collects/macro-debugger/model/reductions-config.rkt
View File

@ -285,12 +285,10 @@
;; But for now, just drop it to avoid macro stepper error.
;; Only bad effect should be missed subterms (usually at phase1).
(STRICT-CHECKS
(fprintf (current-error-port)
"from:\n~.s\n\nto:\n~.s\n\n"
(eprintf "from:\n~.s\n\nto:\n~.s\n\n"
(stx->datum from)
(stx->datum to))
(fprintf (current-error-port)
"original from:\n~.s\n\noriginal to:\n~.s\n\n"
(eprintf "original from:\n~.s\n\noriginal to:\n~.s\n\n"
(stx->datum from0)
(stx->datum to0))
(error 'add-to-renames-table))

10
collects/macro-debugger/model/reductions-engine.rkt
View File

@ -540,17 +540,13 @@
[expected-datum (stx->datum expected)]
[same-form? (equal? actual-datum expected-datum)])
(if same-form?
(fprintf (current-error-port)
"same form but wrong wrappings:\n~.s\nwrongness:\n~.s\n"
(eprintf "same form but wrong wrappings:\n~.s\nwrongness:\n~.s\n"
actual-datum
(wrongness actual expected))
(fprintf (current-error-port)
"got:\n~.s\n\nexpected:\n~.s\n"
(eprintf "got:\n~.s\n\nexpected:\n~.s\n"
actual-datum
expected-datum))
(for ([d derivs])
(fprintf (current-error-port)
"\n~.s\n" d))
(for ([d derivs]) (eprintf "\n~.s\n" d))
(error function
(if same-form?
"wrong starting point (wraps)!"

2
collects/macro-debugger/model/reductions.rkt
View File

@ -760,7 +760,7 @@
;; lift-error
(define (lift-error sym . args)
(apply fprintf (current-error-port) args)
(apply eprintf args)
(newline (current-error-port))
(when #f
(apply error sym args)))

3
collects/meta/checker.rkt
View File

@ -448,8 +448,7 @@
(if 1st?
(begin
(unless (equal? version v)
(fprintf (current-error-port)
"\nNOTE: bundling a different version from ~a\n\n"
(eprintf "\nNOTE: bundling a different version from ~a\n\n"
"running process"))
(set! version v)
(set! 1st? #f))

2
collects/meta/drdr/plt-build.rkt
View File

@ -137,7 +137,7 @@
(the-process _stdout stdin _stderr)
(parameterize ([subprocess-group-enabled #t])
(apply subprocess
(current-error-port)
(current-error-port)
#f
(current-error-port)
new-command new-args)))

10
collects/meta/drdr/replay.rkt
View File

@ -5,17 +5,15 @@
(define replay-event
(match-lambda
[(struct stdout (bs))
(fprintf (current-output-port) "~a\n" bs)]
[(struct stderr (bs))
(fprintf (current-error-port) "~a\n" bs)]))
[(struct stdout (bs)) (printf "~a\n" bs)]
[(struct stderr (bs)) (eprintf "~a\n" bs)]))
(define (replay-status s)
(for-each replay-event (status-output-log s))
#;(when (timeout? s)
(fprintf (current-error-port) "[replay-log] TIMEOUT!\n"))
(eprintf "[replay-log] TIMEOUT!\n"))
#;(when (exit? s)
(fprintf (current-error-port) "[replay-log] Exit code: ~a\n" (exit-code s)))
(eprintf "[replay-log] Exit code: ~a\n" (exit-code s)))
#;(printf "[replay-log] Took ~a\n"
(format-duration-ms (status-duration s)))
(replay-exit-code s))

2
collects/mrlib/private/aligned-pasteboard/tests/test-macro.rkt
View File

@ -13,5 +13,5 @@
actual)])
(unless (and (not (exn? result))
(test result expected))
(fprintf (current-error-port) "test failed: ~s != ~s\n" result expected))))))
(eprintf "test failed: ~s != ~s\n" result expected))))))
)

2
collects/mzlib/deflate.rkt
View File

@ -64,7 +64,7 @@
(make-gzbytes (gzbytes-bytes v) (+ (gzbytes-offset v) o)))
(define (Trace stderr str . args)
(apply fprintf (current-error-port) str args))
(apply eprintf str args))
(define Tracevv Trace)
(define Tracev Trace)
(define (Tracec test . args)

4
collects/mzlib/restart.rkt
View File

@ -17,8 +17,8 @@
[print-error
(lambda (e)
(if (exn? e)
(fprintf (current-error-port) "~a\n" (exn-message e))
(fprintf (current-error-port) "Exception in init file: ~e\n" e)))]
(eprintf "~a\n" (exn-message e))
(eprintf "Exception in init file: ~e\n" e)))]
[beginize (lambda (l)
(string-append
"(begin "

6
collects/mzlib/zip.rkt
View File

@ -93,7 +93,7 @@
[mark1 #f]
[mark2 #f])
(when (zip-verbose)
(fprintf (current-error-port) "zip: compressing ~a...\n" filename))
(eprintf "zip: compressing ~a...\n" filename))
;; write the contents to the output stream:
(write-int *local-file-header* 4) ; signature
(write-int *required-version* 2) ; version
@ -254,10 +254,10 @@
(zip-one-entry (build-metadata file) seekable?))
files)])
(when (zip-verbose)
(fprintf (current-error-port) "zip: writing headers...\n"))
(eprintf "zip: writing headers...\n"))
(write-central-directory headers))
(when (zip-verbose)
(fprintf (current-error-port) "zip: done.\n"))))
(eprintf "zip: done.\n"))))
;; zip : output-file paths ->
(provide zip)

5
collects/net/qp.rkt
View File

@ -103,10 +103,7 @@
(loop (read-byte in))]))))
(define (warning msg . args)
(when #f
(fprintf (current-error-port)
(apply format msg args))
(newline (current-error-port))))
(when #f (eprintf "~a\n" (apply format msg args))))
(define (hex-digit? i)
(vector-ref hex-values i))

12
collects/parser-tools/private-yacc/table.rkt
View File

@ -158,8 +158,7 @@
(prod-index (reduce-prod current-guess))))
(loop (car rest) (cdr rest)))
((accept? (car rest))
(fprintf (current-error-port)
"accept/reduce or accept/shift conflicts. Check the grammar for useless cycles of productions\n")
(eprintf "accept/reduce or accept/shift conflicts. Check the grammar for useless cycles of productions\n")
(loop current-guess (cdr rest)))
(else (loop current-guess (cdr rest)))))))))
@ -179,13 +178,11 @@
grouped-table)))
(unless suppress
(when (> SR-conflicts 0)
(fprintf (current-error-port)
"~a shift/reduce conflict~a\n"
(eprintf "~a shift/reduce conflict~a\n"
SR-conflicts
(if (= SR-conflicts 1) "" "s")))
(when (> RR-conflicts 0)
(fprintf (current-error-port)
"~a reduce/reduce conflict~a\n"
(eprintf "~a reduce/reduce conflict~a\n"
RR-conflicts
(if (= RR-conflicts 1) "" "s"))))
table))
@ -281,8 +278,7 @@
(unless (string=? file "")
(with-handlers [(exn:fail:filesystem?
(lambda (e)
(fprintf
(current-error-port)
(eprintf
"Cannot write debug output to file \"~a\": ~a\n"
file
(exn-message e))))]

3
collects/parser-tools/yacc.rkt
View File

@ -172,8 +172,7 @@
(when (and yacc-output (not (string=? yacc-output "")))
(with-handlers [(exn:fail:filesystem?
(lambda (e)
(fprintf
(current-error-port)
(eprintf
"Cannot write yacc-output to file \"~a\"\n"
yacc-output)))]
(call-with-output-file yacc-output

2
collects/planet/private/cmdline-tool.rkt
View File

@ -133,7 +133,7 @@ This command does not unpack or install the named .plt file."
(define (verify-package-name pkg)
(unless (regexp-match #rx"\\.plt$" pkg)
(fprintf (current-error-port) "Expected package name to end with '.plt', got: ~a\n" pkg)
(eprintf "Expected package name to end with '.plt', got: ~a\n" pkg)
(exit 1)))

8
collects/planet/util.rkt
View File

@ -434,9 +434,8 @@
(for-each display (reverse announcements))
(newline)
(for-each
(λ (s) (fprintf (current-error-port) "WARNING:\n\t~a\n" s))
(reverse warnings))))
(for-each (λ (s) (eprintf "WARNING:\n\t~a\n" s))
(reverse warnings))))
(simple-form-path archive-name))]))
@ -800,8 +799,7 @@
(unless (directory-exists? path)
(if (file-exists? path)
(error 'add-hard-link "Hard links must point to directories, not files")
(fprintf (current-error-port)
"Warning: directory ~a does not exist\n"
(eprintf "Warning: directory ~a does not exist\n"
(path->string path))))
(add-hard-link! pkg-name (list owner) maj min path))

6
collects/plot/common/deprecation-warning.rkt
View File

@ -11,10 +11,8 @@
(hash-ref! warnings name
(λ ()
(if replacement-name
(fprintf (current-error-port)
"~a is deprecated and may be removed in the future; use ~a instead~n"
(eprintf "~a is deprecated and may be removed in the future; use ~a instead~n"
name replacement-name)
(fprintf (current-error-port)
"~a is deprecated and may be removed in the future"
(eprintf "~a is deprecated and may be removed in the future"
name))
#t))))

3
collects/profile/main.rkt
View File

@ -28,8 +28,7 @@
(loop)))))))
(define (run) (for ([i (in-range rpt)]) (thunk)))
(with-handlers ([void (lambda (e)
(fprintf (current-error-port)
"profiled thunk error: ~a\n"
(eprintf "profiled thunk error: ~a\n"
(if (exn? e)
(exn-message e)
(format "~e" e))))])

3
collects/racket/enter.rkt
View File

@ -61,8 +61,7 @@
(define notify
(if (or (memq '#:verbose flags) (and re? (memq '#:verbose-reload flags)))
(lambda (path)
(fprintf (current-error-port)
" [~aloading ~a]\n" (if re? "re-" "") path))
(eprintf " [~aloading ~a]\n" (if re? "re-" "") path))
void))
(lambda (path name)
(if name

11
collects/raco/all-tools.rkt
View File

@ -23,8 +23,7 @@
(real? (list-ref entry 3))))
(let ([p (hash-ref tools (car entry) #f)])
(when p
(fprintf
(current-error-port)
(eprintf
"warning: tool ~s registered twice: ~e and ~e\n"
(car entry)
(car p)
@ -44,9 +43,7 @@
entry))])
(hash-set! tools (car entry) entry))]
[else
(fprintf
(current-error-port)
"warning: ~s provided bad `raco-commands' spec: ~e\n"
d
entry)]))))
(eprintf "warning: ~s provided bad `raco-commands' spec: ~e\n"
d
entry)]))))
tools))

16
collects/raco/raco.rkt
View File

@ -36,7 +36,7 @@
(equal? (car cmdline) "-h"))
#t]
[(regexp-match? #rx"^-" (car cmdline))
(fprintf (current-error-port) "~a: A flag must follow a command: ~a\n\n"
(eprintf "~a: A flag must follow a command: ~a\n\n"
(find-system-path 'run-file)
(car cmdline))
#f]
@ -45,7 +45,7 @@
=> (lambda (tool)
(if (eq? 'ambiguous tool)
(begin
(fprintf (current-error-port) "~a: Ambiguous command prefix: ~a\n\n"
(eprintf "~a: Ambiguous command prefix: ~a\n\n"
(find-system-path 'run-file)
(car cmdline))
#f)
@ -56,16 +56,15 @@
(exit))))]
[(equal? (car cmdline) "help") #t]
[else
(fprintf (current-error-port) "~a: Unrecognized command: ~a\n\n"
(eprintf "~a: Unrecognized command: ~a\n\n"
(find-system-path 'run-file)
(car cmdline))
#f])])
(fprintf (current-error-port) "Usage: raco <command> <option> ... <arg> ...\n")
(eprintf "Usage: raco <command> <option> ... <arg> ...\n")
(for-each
(lambda (show-all?)
(fprintf (current-error-port) "\n~a commands:\n" (if show-all?
"All available"
"Frequently used"))
(eprintf "\n~a commands:\n"
(if show-all? "All available" "Frequently used"))
(let ([l (sort (hash-map tools (lambda (k v) v))
(if show-all?
(lambda (a b) (string<? (car a) (car b)))
@ -73,8 +72,7 @@
(let ([largest (apply max 0 (map (lambda (v) (string-length (car v))) l))])
(for ([i (in-list l)])
(when (or show-all? (cadddr i))
(fprintf (current-error-port)
" ~a~a~a\n"
(eprintf " ~a~a~a\n"
(car i)
(make-string (- largest -3 (string-length (car i))) #\space)
(caddr i)))))))

14
collects/redex/examples/beginner.rkt
View File

@ -472,11 +472,11 @@ reflects the (broken) spec).
(let* ([failed
(lambda (msg)
(set! failed-tests (+ failed-tests 1))
(fprintf (current-error-port) "FAILED: ~a\n" msg)
(eprintf "FAILED: ~a\n" msg)
(k (void)))]
[got (normalize in failed)])
(unless (equal? got out)
(fprintf (current-error-port) "FAILED: ~s\ngot: ~s\nexpected: ~s\n" in got out)
(eprintf "FAILED: ~s\ngot: ~s\nexpected: ~s\n" in got out)
(set! failed-tests (+ failed-tests 1))))))
(define (test-all step . steps)
@ -488,7 +488,7 @@ reflects the (broken) spec).
[(null? rest)
(unless (null? nexts)
(set! failed-tests (+ failed-tests 1))
(fprintf (current-error-port) "FAILED: ~s\n last step: ~s\n reduced to: ~s\n"
(eprintf "FAILED: ~s\n last step: ~s\n reduced to: ~s\n"
step
this
nexts))]
@ -502,16 +502,14 @@ reflects the (broken) spec).
(cdr rest))
(begin
(set! failed-tests (+ failed-tests 1))
(fprintf (current-error-port)
"FAILED: ~s\n step: ~s\n expected: ~s\n got: ~s\n"
(eprintf "FAILED: ~s\n step: ~s\n expected: ~s\n got: ~s\n"
step
this
(car rest)
next))))]
[else
(set! failed-tests (+ failed-tests 1))
(fprintf (current-error-port)
"FAILED: ~s\n step: ~s\n not single step: ~s\n"
(eprintf "FAILED: ~s\n step: ~s\n not single step: ~s\n"
step
this
nexts)])]))))
@ -550,7 +548,7 @@ reflects the (broken) spec).
[(= failed-tests 0)
(fprintf (current-output-port) "passed all ~a tests\n" total-tests)]
[else
(fprintf (current-error-port) "failed ~a out of ~a tests\n" failed-tests total-tests)]))
(eprintf "failed ~a out of ~a tests\n" failed-tests total-tests)]))
(define-syntax (tests stx)
(syntax-case stx ()

5
collects/redex/examples/r6rs/r6rs-tests.rkt
View File

@ -1971,8 +1971,7 @@ of digits with deconv-base
(let ([got (tc)])
(unless (equal? got expected)
(set! failed-tests (+ failed-tests 1))
(fprintf (current-error-port)
"line ~s failed\nexpected ~s\n got ~s\n"
(eprintf "line ~s failed\nexpected ~s\n got ~s\n"
line
expected
got))))
@ -2099,7 +2098,7 @@ of digits with deconv-base
(if (= 0 failed-tests)
(printf "~a tests, all passed\n" test-count)
(fprintf (current-error-port) "~a tests, ~a tests failed\n" test-count failed-tests))
(eprintf "~a tests, ~a tests failed\n" test-count failed-tests))
(printf "verified that ~a terms are p*\n" verified-terms)))
(when verbose?
(collect-garbage) (collect-garbage) (collect-garbage)

4
collects/redex/examples/r6rs/test.rkt
View File

@ -127,7 +127,7 @@
input
#f)))])
(unless (set-same? got expecteds (test-suite-equal? test-suite))
(fprintf (current-error-port) "line ~a of ~a ~a\n test: ~s\n got: ~s\nexpected: ~s\n\n"
(eprintf "line ~a of ~a ~a\n test: ~s\n got: ~s\nexpected: ~s\n\n"
line
file
name
@ -152,7 +152,7 @@
mv-wrap))])
(unless (same-mz? mz-got mz-expected)
(parameterize ([print-struct #t])
(fprintf (current-error-port) "line ~s of ~a ~a\nMZ test: ~s\n got: ~s\nexpected: ~s\n\n"
(eprintf "line ~s of ~a ~a\nMZ test: ~s\n got: ~s\nexpected: ~s\n\n"
line
file
name

5
collects/redex/tests/test-util.rkt
View File

@ -148,9 +148,8 @@
(unless (and (not (exn? got))
(matches? got expected))
(set! failures (+ 1 failures))
(fprintf (current-error-port)
"test: file ~a line ~a:\n got ~s\nexpected ~s\n\n"
filename
(eprintf "test: file ~a line ~a:\n got ~s\nexpected ~s\n\n"
filename
line
got
expected))))

3
collects/scribble/core.rkt
View File

@ -17,8 +17,7 @@
(let ([ht (collect-info-ht ci)])
(let ([old-val (hash-ref ht key #f)])
(when old-val
(fprintf (current-error-port)
"WARNING: collected information for key multiple times: ~e; values: ~e ~e\n"
(eprintf "WARNING: collected information for key multiple times: ~e; values: ~e ~e\n"
key old-val val))
(hash-set! ht key val))))

3
collects/scribble/html-render.rkt
View File

@ -1129,8 +1129,7 @@
(render-content (element-content e) part ri))))
(begin
(when #f
(fprintf (current-error-port)
"Undefined link: ~s\n"
(eprintf "Undefined link: ~s\n"
(tag-key (link-element-tag e) ri)))
`((font ([class "badlink"])
,@(if (empty-content? (element-content e))

3
collects/scribble/latex-render.rkt
View File

@ -270,8 +270,7 @@
(if dest
(if (list? number)
(format-number number null)
(begin (fprintf (current-error-port)
"Internal tag error: ~s -> ~s\n"
(begin (eprintf "Internal tag error: ~s -> ~s\n"
(link-element-tag e)
dest)
'("!!!")))

3
collects/scribble/private/manual-bind.rkt
View File

@ -142,8 +142,7 @@
;; Call raise-syntax-error to capture error message:
(with-handlers ([exn:fail:syntax?
(lambda (exn)
(fprintf (current-error-port)
"~a\n" (exn-message exn)))])
(eprintf "~a\n" (exn-message exn)))])
(raise-syntax-error
'WARNING
"no declared exporting libraries for definition" id)))

2
collects/setup/scribble.rkt
View File

@ -645,7 +645,7 @@
(not (equal? (any-order defs) (any-order (deserialize (caddr out-v)))))
(info-out-time . > . (current-seconds)))])
(when (and (verbose) need-out-write?)
(fprintf (current-error-port) " [New out ~a]\n" (doc-src-file doc)))
(eprintf " [New out ~a]\n" (doc-src-file doc)))
(gc-point)
(let ([info
(make-info doc

5
collects/setup/setup-unit.rkt
View File

@ -113,7 +113,7 @@
((error-display-handler)
(format "~a\n" (exn->string exn))
exn)
(fprintf (current-error-port) "~a\n" (exn->string exn)))
(eprintf "~a\n" (exn->string exn)))
(append-error cc desc exn out err type))
(define (record-error cc desc go fail-k)
(with-handlers ([exn:fail?
@ -137,8 +137,7 @@
(setup-printf #f "")
(show-errors (current-error-port))
(when (pause-on-errors)
(fprintf (current-error-port)
"INSTALLATION FAILED.\nPress Enter to continue...\n")
(eprintf "INSTALLATION FAILED.\nPress Enter to continue...\n")
(read-line))
(exit 1))
(exit 0))

3
collects/setup/unixstyle-install.rkt
View File

@ -227,8 +227,7 @@
[(mv) (lambda (src dst)
(with-handlers ([exn?
(lambda (e)
(fprintf (current-error-port)
" ** error during undo: ~a\n"
(eprintf " ** error during undo: ~a\n"
(exn-message e))
#f)])
(mv dst src)))]

6
collects/setup/winvers-change.rkt
View File

@ -47,8 +47,7 @@
(rename-file-or-directory file new)
(set! file new)))]
[(regexp-match-positions xxxs dfile)
(fprintf (current-error-port)
"Warning: ~a was not renamed!\n" (full-path))]))
(eprintf "Warning: ~a was not renamed!\n" (full-path))]))
(let-values ([(i o) (open-input-output-file file #:exists 'update)])
(define print? verbose?)
(for ([subst (in-list substitutions)])
@ -66,8 +65,7 @@
(loop (+ pos (cdar m))))])))
(file-position i 0)
(when (regexp-match-positions xxxs i)
(fprintf (current-error-port)
"Warning: ~a still has \"~a\"!\n" (full-path) xxxs))
(eprintf "Warning: ~a still has \"~a\"!\n" (full-path) xxxs))
(close-input-port i)
(close-output-port o)))

3
collects/setup/xref.rkt
View File

@ -41,8 +41,7 @@
(map (lambda (dest)
(lambda ()
(with-handlers ([exn:fail? (lambda (exn)
(fprintf (current-error-port)
"WARNING: ~a\n"
(eprintf "WARNING: ~a\n"
(if (exn? exn)
(exn-message exn)
(format "~e" exn)))

2
collects/sirmail/spell.rkt
View File

@ -165,7 +165,7 @@
[blank-line (read-line ispell-out 'any)]
[_ (debug "< ~s\n" blank-line)])
(unless (equal? blank-line "")
(fprintf (current-error-port) "expected blank line from ispell, got (word ~s):\n~a\nrestarting ispell\n\n"
(eprintf "expected blank line from ispell, got (word ~s):\n~a\nrestarting ispell\n\n"
word
blank-line)
(close-output-port ispell-in)

2
collects/slatex/pdf-slatex-launcher.rkt
View File

@ -13,7 +13,7 @@
(error 'slatex "pdf-slatex not supported under Mac OS Classic")]
[(windows unix macosx)
(when (equal? (vector) argv)
(fprintf (current-error-port) "pdf-slatex: expected a file on the command line\n")
(eprintf "pdf-slatex: expected a file on the command line\n")
(exit 1))
(let* ([filename
(command-line

2
collects/slideshow/cmdline.rkt
View File

@ -52,7 +52,7 @@
(define screen-set? #f)
(define (die name . args)
(fprintf (current-error-port) "~a: ~a\n" name (apply format args))
(eprintf "~a: ~a\n" name (apply format args))
(exit -1))
(define file-to-load

2
collects/stepper/private/annotate.rkt
View File

@ -1023,7 +1023,7 @@
[else (annotate/module-top-level exp)]
#;[else (begin
(fprintf (current-error-port) "~v\n" (syntax->datum exp))
(eprintf "~v\n" (syntax->datum exp))
(error `annotate/top-level "unexpected top-level expression: ~a\n" (syntax->datum exp)))])))

3
collects/string-constants/private/only-once.rkt
View File

@ -9,5 +9,4 @@
;; the output port may no longer be there, in which case
;; we just give up on printing
(with-handlers ([exn:fail? (lambda (x) (void))])
(fprintf (current-error-port) "~a" msg)))))
(eprintf "~a" msg)))))

4
collects/tests/compiler/zo-test.rkt
View File

@ -137,9 +137,9 @@ exec racket -t "$0" -- -s -t 60 -v -R $*
(unless (and (not (care-about-nonserious?)) (not serious?))
(when (or (verbose-mode) (stop-on-first-error))
(fprintf (current-error-port) "~a -- ~a: ~a\n" p phase exn-msg))
(eprintf "~a -- ~a: ~a\n" p phase exn-msg))
(when (stop-on-first-error)
(stop!)))]))
(stop!)))]))
(define timing-thread
(thread

8
collects/tests/drracket/io.rkt
View File

@ -32,10 +32,9 @@ add this test:
(or (equal? (cadr exp) (cadr got))
(and (procedure? (cadr exp))
((cadr exp) (cadr got))))))
expected
expected
got))
(fprintf (current-error-port)
"expected ~s\n got ~s\nfor ~s\n\n"
(eprintf "expected ~s\n got ~s\nfor ~s\n\n"
expected
got
expression)))))
@ -141,8 +140,7 @@ add this test:
(send interactions-text paragraph-end-position
(- (send interactions-text last-paragraph) 1)))))])
(unless (equal? got-value expected-transcript)
(fprintf (current-error-port)
"FAILED: expected: ~s\n got: ~s\n program: ~s\n input: ~s\n"
(eprintf "FAILED: expected: ~s\n got: ~s\n program: ~s\n input: ~s\n"
expected-transcript got-value program input)))))
(clear-definitions drs-frame)

21
collects/tests/drracket/language-test.rkt
View File

@ -1116,8 +1116,7 @@ the settings above should match r5rs
(do-execute drs)
(let* ([got (fetch-output/should-be-tested drs)])
(unless (string=? result got)
(fprintf (current-error-port)
"FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n"
(eprintf "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n"
(language) setting-name expression result got)))))
(define (test-hash-bang)
@ -1130,8 +1129,7 @@ the settings above should match r5rs
(do-execute drs)
(let* ([got (fetch-output/should-be-tested drs)])
(unless (string=? "1" got)
(fprintf (current-error-port)
"FAILED: ~s ~a test\n expected: ~s\n got: ~s\n"
(eprintf "FAILED: ~s ~a test\n expected: ~s\n got: ~s\n"
(language) expression result got)))))
(define (fetch-output/should-be-tested . args)
@ -1172,8 +1170,7 @@ the settings above should match r5rs
(min (string-length line1-expect)
(string-length line1-got))))
(regexp-match line1-expect line1-got)))
(fprintf (current-error-port)
"expected lines: \n ~a\n ~a\ngot lines:\n ~a\n ~a\n"
(eprintf "expected lines: \n ~a\n ~a\ngot lines:\n ~a\n ~a\n"
line0-expect line1-expect
line0-got line1-got)
(error 'language-test.rkt "failed get top of repl test")))))
@ -1255,8 +1252,7 @@ the settings above should match r5rs
(unless (if (procedure? answer)
(answer got)
(whitespace-string=? answer got))
(fprintf (current-error-port)
"FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n"
(eprintf "FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n"
(language) option show-sharing pretty?
(shorten got)
(if (procedure? answer) (answer) answer)))))])
@ -1326,8 +1322,7 @@ the settings above should match r5rs
(send interactions-text paragraph-end-position
(- (send interactions-text last-paragraph) 1)))))])
(unless (equal? got "0")
(fprintf (current-error-port)
"FAILED: test-error-after-definition failed, expected 0, got ~s\n" got))))))
(eprintf "FAILED: test-error-after-definition failed, expected 0, got ~s\n" got))))))
;; test-expression : (union string 'xml 'image (listof (union string 'xml 'image)))
@ -1388,8 +1383,7 @@ the settings above should match r5rs
(when (regexp-match re:out-of-sync got)
(error 'text-expression "got out of sync message"))
(unless (check-expectation defs-expected got)
(fprintf (current-error-port)
(make-err-msg defs-expected)
(eprintf (make-err-msg defs-expected)
'definitions (language) expression defs-expected got)))
(let ([dp (defs-prefix)])
@ -1422,8 +1416,7 @@ the settings above should match r5rs
(when (regexp-match re:out-of-sync got)
(error 'text-expression "got out of sync message"))
(unless (check-expectation repl-expected got)
(fprintf (current-error-port)
(make-err-msg repl-expected)
(eprintf (make-err-msg repl-expected)
'interactions
(language)
expression repl-expected got))))))

8
collects/tests/drracket/no-write-and-frame-leak.rkt
View File

@ -46,13 +46,13 @@
(cond
[(zero? n)
(when (weak-box-value drs-tabb)
(fprintf (current-error-port) "frame leak!\n"))
(eprintf "frame leak!\n"))
(when (weak-box-value drs-frame2b)
(fprintf (current-error-port) "tab leak!\n"))
(eprintf "tab leak!\n"))
(when (weak-box-value tab-nsb)
(fprintf (current-error-port) "tab namespace leak!\n"))
(eprintf "tab namespace leak!\n"))
(when (weak-box-value frame2-nsb)
(fprintf (current-error-port) "frame namespace leak!\n"))]
(eprintf "frame namespace leak!\n"))]
[else
(collect-garbage) (sync (system-idle-evt))
(when (ormap weak-box-value

2
collects/tests/drracket/private/drracket-test-util.rkt
View File

@ -619,7 +619,7 @@
(λ (x)
(if (exn? x)
(orig-display-handler (exn-message x) x)
(fprintf (current-error-port) "uncaught exception ~s\n" x))
(eprintf "uncaught exception ~s\n" x))
(exit 1))))
(run-test)
(exit)))

9
collects/tests/drracket/private/module-lang-test-utils.rkt
View File

@ -83,8 +83,7 @@
(send interactions-text paragraph-start-position 2)
(send interactions-text paragraph-end-position 2))))])
(unless (or (test-all? test) (string=? "> " after-execute-output))
(fprintf (current-error-port)
"FAILED (line ~a): ~a\n ~a\n expected no output after execution, got: ~s\n"
(eprintf "FAILED (line ~a): ~a\n ~a\n expected no output after execution, got: ~s\n"
(test-line test)
(test-definitions test)
(or (test-interactions test) 'no-interactions)
@ -123,8 +122,7 @@
[else 'module-lang-test "bad test value: ~e" r])
r text)))
(unless output-passed?
(fprintf (current-error-port)
"FAILED (line ~a): ~a\n ~a\n expected: ~s\n got: ~s\n"
(eprintf "FAILED (line ~a): ~a\n ~a\n expected: ~s\n got: ~s\n"
(test-line test)
(test-definitions test)
(or (test-interactions test) 'no-interactions)
@ -137,8 +135,7 @@
(let ([error-ranges-expected
((test-error-ranges test) definitions-text interactions-text)])
(unless (equal? error-ranges-expected (send interactions-text get-error-ranges))
(fprintf (current-error-port)
"FAILED (line ~a; ranges): ~a\n expected: ~s\n got: ~s\n"
(eprintf "FAILED (line ~a; ranges): ~a\n expected: ~s\n got: ~s\n"
(test-line test)
(test-definitions test)
error-ranges-expected

14
collects/tests/drracket/private/randomly-click.rkt
View File

@ -105,8 +105,7 @@
(cond
[action
(with-handlers ((exn:fail? (λ (x)
(fprintf (current-error-port)
"\nExecution fail: transcript of ~a clicking follows with seed ~s\n"
(eprintf "\nExecution fail: transcript of ~a clicking follows with seed ~s\n"
(send window get-label)
the-seed)
(apply show-log (cons action actions))
@ -119,17 +118,14 @@
(action))
(loop (- n 1) (cons action actions))]
[else
(fprintf (current-error-port)
"\nExists/Meets window with no button: Bug? seed ~s\n"
(eprintf "\nExists/Meets window with no button: Bug? seed ~s\n"
the-seed)
(apply show-log actions)
(error 'randomly-click.rkt "giving up")]))]))]))))
(define (show-log . actions)
(for ((action (in-list actions)))
(fprintf (current-error-port)
" ~a\n"
(action 'ignored))))
(for ([action (in-list actions)])
(eprintf " ~a\n" (action 'ignored))))
;; the splash screen is in a separate eventspace so wont' show up.
(define (wait-for-first-frame)
@ -163,7 +159,7 @@
(λ (x)
(if (exn? x)
(orig-display-handler (exn-message x) x)
(fprintf (current-error-port) "uncaught exception ~s\n" x))
(eprintf "uncaught exception ~s\n" x))
(exit 1)))
(void

24
collects/tests/drracket/private/repl-test.rkt
View File

@ -1206,13 +1206,11 @@ This produces an ACK message
(cond
[(eq? source-location 'definitions)
(unless defs-focus?
(fprintf (current-error-port)
"FAILED execute test for ~s\n expected definitions to have the focus\n"
(eprintf "FAILED execute test for ~s\n expected definitions to have the focus\n"
program))]
[(eq? source-location 'interactions)
(unless ints-focus?
(fprintf (current-error-port)
"FAILED execute test for ~s\n expected interactions to have the focus\n"
(eprintf "FAILED execute test for ~s\n expected interactions to have the focus\n"
program))]
[defs-focus?
(let ([start (car source-location)]
@ -1225,8 +1223,7 @@ This produces an ACK message
(= (+ (srcloc-position error-range) -1) (loc-offset start))
(= (+ (srcloc-position error-range) -1 (srcloc-span error-range))
(loc-offset finish)))
(fprintf (current-error-port)
"FAILED execute test for ~s\n error-range is ~s\n expected ~s\n"
(eprintf "FAILED execute test for ~s\n error-range is ~s\n expected ~s\n"
program
(and error-range
(list (+ (srcloc-position error-range) -1)
@ -1243,8 +1240,7 @@ This produces an ACK message
(regexp-match execute-answer received-execute)]
[else #f])
(failure)
(fprintf (current-error-port)
"FAILED execute test for ~s (~a)\n expected: ~s\n got: ~s\n"
(eprintf "FAILED execute test for ~s (~a)\n expected: ~s\n got: ~s\n"
program
language-cust
execute-answer received-execute))
@ -1300,8 +1296,7 @@ This produces an ACK message
(regexp-match load-answer received-load)]
[else #f])
(failure)
(fprintf (current-error-port)
"FAILED load test ~a for ~s\n expected: ~s\n got: ~s\n"
(eprintf "FAILED load test ~a for ~s\n expected: ~s\n got: ~s\n"
short-filename
program load-answer received-load)))))])
(load-test tmp-load-short-filename (make-load-answer in-vector language-cust #f))
@ -1314,7 +1309,7 @@ This produces an ACK message
; check for edit-sequence
(when (repl-in-edit-sequence?)
(fprintf (current-error-port) "FAILED: repl in edit-sequence")
(eprintf "FAILED: repl in edit-sequence")
(escape)))))
(define tests 0)
@ -1325,7 +1320,7 @@ This produces an ACK message
(define (final-report)
(if (= 0 failures)
(printf "tests finished: all ~a tests passed\n" tests)
(fprintf (current-error-port) "tests finished: ~a failed out of ~a total\n" failures tests)))
(eprintf "tests finished: ~a failed out of ~a total\n" failures tests)))
(define (run-main-tests language-cust)
(random-seed-test)
@ -1399,7 +1394,7 @@ This produces an ACK message
[expected #rx"reference to undefined identifier: x"])
(unless (regexp-match expected output)
(failure)
(fprintf (current-error-port) "callcc-test: expected something matching ~s, got ~s\n" expected output)))))
(eprintf "callcc-test: expected something matching ~s, got ~s\n" expected output)))))
(define (random-seed-test)
(define expression (format "~s" '(pseudo-random-generator->vector (current-pseudo-random-generator))))
@ -1420,8 +1415,7 @@ This produces an ACK message
(let ([output2 (fetch-output drscheme-frame start2 (- (get-int-pos) 1))])
(unless (equal? output1 output2)
(failure)
(fprintf (current-error-port)
"random-seed-test: expected\n ~s\nand\n ~s\nto be the same"
(eprintf "random-seed-test: expected\n ~s\nand\n ~s\nto be the same"
output1
output2)))))))

3
collects/tests/drracket/private/run-example-tool.rkt
View File

@ -77,7 +77,6 @@
(queue-callback/res (λ () (send (send drs get-definitions-text) get-text))))
(define expected (apply string (reverse (string->list "easter egg\n1\n2\n3"))))
(unless (equal? content expected)
(fprintf (current-error-port)
"example-tool.rkt: test failed;\nexpected ~s\n but got ~s"
(eprintf "example-tool.rkt: test failed;\nexpected ~s\n but got ~s"
expected
content)))))

3
collects/tests/drracket/syncheck-eval-compile-time.rkt
View File

@ -27,8 +27,7 @@
(let ([err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents)))])
(when err
(fprintf (current-error-port)
"FAILED ~s\n error report window is visible:\n ~a\n"
(eprintf "FAILED ~s\n error report window is visible:\n ~a\n"
test
err))))
(define (click-check-syntax-button drs)

17
collects/tests/drracket/syncheck-test.rkt
View File

@ -1142,8 +1142,7 @@
[menu-item
menu-item]
[else
(fprintf (current-error-port)
"syncheck-test.rkt: rename test ~s didn't find menu item named ~s in ~s"
(eprintf "syncheck-test.rkt: rename test ~s didn't find menu item named ~s in ~s"
test
item-name
(map (λ (x) (and (is-a? x labelled-menu-item<%>) (send x get-label)))
@ -1160,8 +1159,7 @@
(define defs (send drs get-definitions-text))
(send defs get-text 0 (send defs last-position)))))
(unless (equal? result (rename-test-output test))
(fprintf (current-error-port)
"syncheck-test.rkt FAILED\n test ~s\n got ~s\n"
(eprintf "syncheck-test.rkt FAILED\n test ~s\n got ~s\n"
test
result)))])))
@ -1233,8 +1231,7 @@
(hash-set! already-checked frm #t)
(let ([ht-ent (hash-ref ht frm (lambda () 'nothing-there))])
(unless (equal? ht-ent to)
(fprintf (current-error-port)
(if expected?
(eprintf (if expected?
"FAILED arrow test ~s from ~s\n expected ~s\n actual ~s\n"
"FAILED arrow test ~s from ~s\n actual ~s\n expected ~s\n")
test-exp
@ -1251,8 +1248,7 @@
[(equal? got expected)
(compare-arrows input arrows arrows-got)]
[else
(fprintf (current-error-port)
"FAILED: ~s\n expected: ~s\n got: ~s\n"
(eprintf "FAILED: ~s\n expected: ~s\n got: ~s\n"
input expected got)])))
;; get-annotate-output : drscheme-frame -> (listof str/ann)
@ -1267,12 +1263,11 @@
(let ([err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents)))])
(when err
(fprintf (current-error-port)
"FAILED ~s\n error report window is visible:\n ~a\n"
(eprintf "FAILED ~s\n error report window is visible:\n ~a\n"
test
err))))
(define (click-check-syntax-button drs)
(test:run-one (lambda () (send (send drs syncheck:get-button) command))))
(main)

8
collects/tests/drracket/teaching-lang-coverage.rkt
View File

@ -107,15 +107,13 @@
(send interactions-text paragraph-start-position 2)
(send interactions-text last-position))])
(unless (regexp-match #rx"^[ \n\t0-9>]*$" result)
(fprintf (current-error-port)
"FAILED line ~a, got ~s for the output, but expected only digits and whitespace"
(eprintf "FAILED line ~a, got ~s for the output, but expected only digits and whitespace"
(test-line t)
result)))
(let ([got (find-uncovered-text (get-annotated-output drr-frame))])
(unless (equal? got (test-uncovered t))
(fprintf (current-error-port)
"FAILED line ~a\n got: ~s\nexpected: ~s\n"
(eprintf "FAILED line ~a\n got: ~s\nexpected: ~s\n"
(test-line t)
got
got
(test-uncovered t)))))))))

4
collects/tests/drracket/teaching-lang-save-file.rkt
View File

@ -26,9 +26,9 @@
(unless (call-with-input-file fn
(λ (p) (regexp-match #rx";;[^\n]*metadata" p)))
(fprintf (current-error-port) "---- saved file, cut here ----\n")
(eprintf "---- saved file, cut here ----\n")
(call-with-input-file fn (λ (p) (copy-port p (current-error-port))))
(fprintf (current-error-port) "---- saved file, cut here ----\n")
(eprintf "---- saved file, cut here ----\n")
(error 'save-teaching-lang-file.rkt
"expected the saved file to contain the word 'metadata' in a comment"))
(do-execute drr-frame)

3
collects/tests/drracket/teaching-lang-sharing-modules.rkt
View File

@ -46,8 +46,7 @@ Of course, other (similar) things can go wrong, too.
[(equal? output first-line-output)
(try-interaction-test drs-frame)]
[else
(fprintf (current-error-port)
"teaching-lang-sharing-modules.rkt: got bad output from execute: ~s"
(eprintf "teaching-lang-sharing-modules.rkt: got bad output from execute: ~s"
output)])))))
(define (try-interaction-test drs-frame)

5
collects/tests/drracket/test-engine-test.rkt
View File

@ -238,10 +238,9 @@
(clear-definitions drs)
(type-in-definitions drs expression)
(do-execute drs)
(let* ([got (fetch-output/should-be-tested drs)])
(let ([got (fetch-output/should-be-tested drs)])
(unless (string=? result got)
(fprintf (current-error-port)
"FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n"
(eprintf "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n"
(language) setting-name expression result got)))))
(define (fetch-output/should-be-tested . args)

8
collects/tests/framework/main.rkt
View File

@ -107,15 +107,15 @@
(exit (cond
[(not (null? jumped-out-tests))
(fprintf (current-error-port) "Test suites ended with exns ~s\n" jumped-out-tests)
(eprintf "Test suites ended with exns ~s\n" jumped-out-tests)
1]
[(null? failed-tests)
(printf "All tests passed.\n")
0]
[else
(fprintf (current-error-port) "FAILED tests:\n")
(eprintf "FAILED tests:\n")
(for-each (lambda (failed-test)
(fprintf (current-error-port) " ~a // ~a\n"
(car failed-test) (cdr failed-test)))
(eprintf " ~a // ~a\n"
(car failed-test) (cdr failed-test)))
failed-tests)
1]))

5
collects/tests/gracket/image-snip-unmarshalling.rkt
View File

@ -37,8 +37,7 @@ and compares a bunch of properties of them
(define copy-is (send t2 find-first-snip))
(define (warn . args)
(fprintf (current-error-port)
(string-append (format "FAILED test-wxme-image-snip-reader.rkt line ~a: " line)
(eprintf (string-append (format "FAILED test-wxme-image-snip-reader.rkt line ~a: " line)
(apply format args))))
(define-syntax-rule (cmp mtd) (cmp/proc (λ (x) (send x mtd)) 'mtd))
@ -92,7 +91,7 @@ and compares a bunch of properties of them
(cond
[(equal? a b) #t]
[else
;(fprintf (current-error-port) "checking ~s, doesn't match\n~s\nvs\n~s\n\n" what a b)
;(eprintf "checking ~s, doesn't match\n~s\nvs\n~s\n\n" what a b)
#f]))
(define (bitmap->bytes bmp alpha?)

9
collects/tests/gracket/item.rkt
View File

@ -2222,13 +2222,12 @@
(define (message-boxes parent)
(define (check expected got)
(unless (eq? expected got)
(fprintf (current-error-port) "bad result: - expected ~e, got ~e\n"
expected got)))
(eprintf "bad result: - expected ~e, got ~e\n" expected got)))
(define (big s)
(format "~a\n~a\n~a\n~a\n" s
(make-string 500 #\x)
(make-string 500 #\x)
(make-string 500 #\x)))
(make-string 500 #\x)
(make-string 500 #\x)
(make-string 500 #\x)))
(check 'ok (message-box "Title" "Message OK!" parent '(ok)))
(check 'ok (message-box "Title" (big "Message OK!") parent '(ok)))

5
collects/tests/gracket/wxme.rkt
View File

@ -30,8 +30,7 @@
(set! test-cnt (add1 test-cnt))
(unless (equal? v v2)
(set! wrong-cnt (add1 wrong-cnt))
(fprintf (current-error-port)
"FAILED: line ~a\nexpected: ~s\n got: ~s\n"
(eprintf "FAILED: line ~a\nexpected: ~s\n got: ~s\n"
line
v2
v)))
@ -40,7 +39,7 @@
(printf "\n~a tests\n" test-cnt)
(if (zero? wrong-cnt)
(printf "all passed\n")
(fprintf (current-error-port) "~s FAILED\n" wrong-cnt)))
(eprintf "~s FAILED\n" wrong-cnt)))
;; ----------------------------------------
;; String snips and lines

4
collects/tests/stepper/test-engine.rkt
View File

@ -100,7 +100,7 @@
(let ([error-has-occurred-box (box #f)])
(test-sequence/many models exp-str expected-steps extra-files error-has-occurred-box)
(if (unbox error-has-occurred-box)
(begin (fprintf (current-error-port) "...Error has occurred during test: ~v\n" name)
(begin (eprintf "...Error has occurred during test: ~v\n" name)
#f)
#t)))
@ -230,7 +230,7 @@
(define (warn error-box who fmt . args)
(set-box! error-box #t)
(fprintf (current-error-port) "~a: ~a\n" who (apply format fmt args)))
(eprintf "~a: ~a\n" who (apply format fmt args)))
;; (-> step-result? sexp? boolean?)

3
collects/texpict/private/mrpict-extra.rkt
View File

@ -426,8 +426,7 @@
[color (or requested-color
(send the-color-database find-color "BLACK"))])
(unless requested-color
(fprintf (current-error-port)
"WARNING: couldn't find color: ~s\n" (cadr x)))
(eprintf "WARNING: couldn't find color: ~s\n" (cadr x)))
(set-pen (find-or-create-pen color (send p get-width) (send p get-style)))
(set-brush (find-or-create-brush color 'solid))
(set-text-foreground color))

2
collects/typed-racket/types/printer.rkt
View File

@ -260,7 +260,7 @@
#;[(Poly-unsafe: n b) (fp "(unsafe-poly ~a ~a ~a)" (Type-seq c) n b)]
[(Poly-names: names body)
#;(fprintf (current-error-port) "POLY SEQ: ~a\n" (Type-seq body))
#;(eprintf "POLY SEQ: ~a\n" (Type-seq body))
(fp "(All ~a ~a)" names body)]
#;
[(PolyDots-unsafe: n b) (fp "(unsafe-polydots ~a ~a ~a)" (Type-seq c) n b)]

6
collects/web-server/dispatchers/dispatch-files.rkt
View File

@ -76,9 +76,9 @@
[range-delimiter-regexp #px#","]
[range-regexp #px#"^([0-9]*)-([0-9]*)$"]
[range-error (lambda (header)
(fprintf (current-error-port)
(format "Bad Range header: ~s. File a Racket bug report!\n"
(header-value header)))
(display (format "Bad Range header: ~s. File a Racket bug report!\n"
(header-value header))
(current-error-port))
#f)])
(lambda (headers)
(let ([header (headers-assq* #"Range" headers)])

11
src/worksp/gc2/make.rkt
View File

@ -3,10 +3,10 @@
(use-compiled-file-paths null)
(require mzlib/restart
mzlib/process)
mzlib/process)
(define (system- s)
(fprintf (current-error-port) "~a\n" s)
(eprintf "~a\n" s)
(system s))
(define backtrace-gc? #f)
@ -86,9 +86,7 @@
(define (check-timestamp t2 dep)
(when (t2 . > . (current-seconds))
(fprintf (current-error-port)
"WARNING: timestamp is in the future: ~e\n"
dep)))
(eprintf "WARNING: timestamp is in the future: ~e\n" dep)))
(define (try src deps dest objdest includes use-precomp extra-compile-flags expand-extra-flags msvc-pch indirect?)
(when (or (not re:only) (regexp-match re:only dest))
@ -108,8 +106,7 @@
(if (file-exists? deps)
(with-input-from-file deps read)
null))))))
(unless (parameterize
([use-compiled-file-paths (list "compiled")])
(unless (parameterize ([use-compiled-file-paths (list "compiled")])
(restart-mzscheme #() (lambda (x) x)
(list->vector
(append