Moved unstable/cce/port to unstable/port.

This commit is contained in:
Carl Eastlund 2010-05-29 19:08:53 -04:00
parent 4166a0cfe7
commit 402232237c
7 changed files with 56 additions and 85 deletions

View File

@ -0,0 +1,43 @@
#lang racket
(require rackunit rackunit/text-ui unstable/port "helpers.rkt")
(run-tests
(test-suite "port.ss"
(test-suite "read-all"
(test-ok (check-equal? (read-all read (open-input-string "1 2 3"))
(list 1 2 3)))
(test-ok (check-equal?
(parameterize ([current-input-port
(open-input-string "1 2 3")])
(read-all))
(list 1 2 3))))
(test-suite "read-all-syntax"
(test-ok (check-equal?
(syntax->datum
(read-all-syntax read-syntax (open-input-string "1 2 3")))
(list 1 2 3)))
(test-ok (check-equal?
(syntax->datum
(parameterize ([current-input-port
(open-input-string "1 2 3")])
(read-all-syntax)))
(list 1 2 3))))
(test-suite "port->srcloc"
(test-ok (define port (open-input-string "\n x "))
(port-count-lines! port)
(check-equal? (port->srcloc port)
(make-srcloc 'string 1 0 1 0))
(read port)
(check-equal? (port->srcloc port 'here 1)
(make-srcloc 'here 2 2 4 1))))
(test-suite "read-available-bytes"
(test-ok (define-values [in out] (make-pipe))
(check-equal? (read-available-bytes in) #"")
(write-byte (char->integer #\c) out)
(check-equal? (read-available-bytes in) #"c")
(close-output-port out)
(check-equal? (read-available-bytes in) eof)))))

View File

@ -23,8 +23,6 @@
@include-section["exn.scrbl"]
@include-section["port.scrbl"]
@include-section["debug.scrbl"]
@include-section["scribble.scrbl"]

View File

@ -7,7 +7,6 @@
"test-dict.ss"
"test-exn.ss"
"test-planet.ss"
"test-port.ss"
"test-require-provide.ss"
"test-scribble.ss"
"test-set.ss"
@ -21,7 +20,6 @@
dict-suite
exn-suite
planet-suite
port-suite
require-provide-suite
scribble-suite
set-suite

View File

@ -1,52 +0,0 @@
#lang scheme
(require "checks.ss"
"../port.ss")
(provide port-suite)
(define port-suite
(test-suite "port.ss"
(test-suite "eprintf"
(test
(parameterize ([current-error-port (open-output-string)])
(eprintf "Danger, ~a!" "Will Robinson")
(check-equal? (get-output-string (current-error-port))
"Danger, Will Robinson!"))))
(test-suite "read-all"
(test-ok (check-equal? (read-all read (open-input-string "1 2 3"))
(list 1 2 3)))
(test-ok (check-equal?
(parameterize ([current-input-port
(open-input-string "1 2 3")])
(read-all))
(list 1 2 3))))
(test-suite "read-all-syntax"
(test-ok (check-equal?
(syntax->datum
(read-all-syntax read-syntax (open-input-string "1 2 3")))
(list 1 2 3)))
(test-ok (check-equal?
(syntax->datum
(parameterize ([current-input-port
(open-input-string "1 2 3")])
(read-all-syntax)))
(list 1 2 3))))
(test-suite "port->srcloc"
(test-ok (define port (open-input-string "\n x "))
(port-count-lines! port)
(check-equal? (port->srcloc port)
(make-srcloc 'string 1 0 1 0))
(read port)
(check-equal? (port->srcloc port 'here 1)
(make-srcloc 'here 2 2 4 1))))
(test-suite "read-available-bytes"
(test-ok (define-values [in out] (make-pipe))
(check-equal? (read-available-bytes in) #"")
(write-byte (char->integer #\c) out)
(check-equal? (read-available-bytes in) #"c")
(close-output-port out)
(check-equal? (read-available-bytes in) eof)))))

View File

@ -1,9 +1,6 @@
#lang scheme
#lang racket
(require unstable/function "syntax.ss" "private/define-core.ss")
(define-if-unbound (eprintf fmt . args)
(apply fprintf (current-error-port) fmt args))
(require unstable/srcloc)
(define buffer (make-bytes 1024))
@ -44,9 +41,8 @@
(define start (port->srcloc port))
(define terms (read-all reader port))
(define end (port->srcloc port))
(to-syntax #:src (src->list start end) terms)]))
(datum->syntax #f terms (build-source-location-list start end))]))
(provide eprintf)
(provide/contract
[read-all (->* [] [(-> any/c) input-port?] list?)]
[read-all-syntax

View File

@ -1,26 +1,13 @@
#lang scribble/doc
@(require scribble/manual
scribble/eval
"../scribble.ss"
"eval.ss")
@(require (for-label scheme unstable/cce/port))
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/port))
@title[#:style 'quiet #:tag "cce-port"]{Ports}
@title{Ports}
@defmodule[unstable/cce/port]
@defmodule[unstable/port]
This module provides tools for port I/O.
@defproc[(eprintf [fmt string?] [arg any/c] ...) void?]{
Like @scheme[printf], but prints to @scheme[(current-error-port)].
@defexamples[
#:eval (evaluator 'unstable/cce/port)
(eprintf "Danger, ~a!" "Will Robinson")
]
}
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
@defproc[(read-all [reader (-> any/c) read]
[port input-port? (current-input-port)])
@ -31,7 +18,7 @@ This function produces a list of all the values produced by calling
until it produces @scheme[eof].
@defexamples[
#:eval (evaluator 'unstable/cce/port)
#:eval (eval/require 'unstable/port)
(read-all read (open-input-string "1 2 3"))
(parameterize ([current-input-port (open-input-string "a b c")])
(read-all))
@ -49,7 +36,7 @@ is set to @scheme[port], up until it produces @scheme[eof]. The source location
of the result spans the entire portion of the port that was read.
@defexamples[
#:eval (evaluator 'unstable/cce/port)
#:eval (eval/require 'unstable/port)
(define port1 (open-input-string "1 2 3"))
(port-count-lines! port1)
(read-all-syntax read-syntax port1)
@ -72,7 +59,7 @@ missing fields. This function relies on @scheme[port-next-location], so line
counting must be enabled for @scheme[port] to get meaningful results.
@defexamples[
#:eval (evaluator 'unstable/cce/port)
#:eval (eval/require 'unstable/port)
(define port (open-input-string "1 2 3"))
(port-count-lines! port)
(read port)
@ -92,7 +79,7 @@ available but the port may have more input, it produces an empty byte string.
This procedure never blocks to wait for input from the port.
@defexamples[
#:eval (evaluator 'unstable/cce/port)
#:eval (eval/require 'unstable/port)
(define-values [in out] (make-pipe))
(parameterize ([current-input-port in]) (read-available-bytes))
(write-byte (char->integer #\c) out)

View File

@ -80,6 +80,7 @@ Keep documentation and tests up to date.
@include-section["list.scrbl"]
@include-section["net.scrbl"]
@include-section["path.scrbl"]
@include-section["port.scrbl"]
@include-section["pretty.scrbl"]
@include-section["queue.scrbl"]
@include-section["regexp.scrbl"]