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

toward fixed interaction between positions and peek-commits

Browse Source 
When a `port-commit-peeked' succeeds, position information should
(appear to) be updated. This patch synchronizes commits and
position information for primitive ports, but synchronizing
them for user ports remains a problem.
This commit is contained in:
Matthew Flatt 2012-07-26 09:23:21 -06:00
parent 8c10dc1579
commit 1efc894ada
2 changed files with 54 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/tests/racket/portlib.rktl
View File

@ -876,10 +876,15 @@
(test #t list? r)))
;; check proper locking for concurrent access:
(for ([i 100])
(let* ([p (make-limited-input-port
(for ([mk-p (list
(lambda ()
(open-input-string "A\nB\n"))
(lambda ()
(make-limited-input-port
(open-input-string "A\nB\nC\nD\n")
4)]
4)))])
(for ([i 100])
(let* ([p (mk-p)]
[N 6]
[chs (for/list ([i N])
(let ([ch (make-channel)])
@ -887,16 +892,20 @@
(lambda ()
(when (even? i) (sleep))
(channel-put ch (list (sync (read-bytes-line-evt p))
(file-position p)))))
(file-position p)
(let ()
(define-values (l c pos) (port-next-location p))
(sub1 pos))))))
ch))]
[rs (for/list ([ch chs])
(channel-get ch))])
(test 2 apply + (for/list ([r rs]) (if (bytes? (car r)) 1 0)))
(test #t values (for/and ([r rs])
(for ([r rs])
(if (eof-object? (car r))
(eq? (cadr r) 4)
(and (memq (cadr r) '(2 4)) #t))))))
(test 4 cadr r)
(let ([memq? (lambda (a l) (and (memq a l) #t))])
(test #t memq? (cadr r) '(2 4))
(test #t = (cadr r) (caddr r))))))))
(let-values ([(in out) (make-pipe-with-specials)])
(struct str (v)

25
src/racket/src/port.c
View File

@ -2150,11 +2150,11 @@ intptr_t scheme_get_byte_string_unless(const char *who,
while (1) {
SCHEME_USE_FUEL(1);
CHECK_PORT_CLOSED(who, "input", port, ip->closed);
if (ip->input_lock)
scheme_wait_input_allowed(ip, only_avail);
CHECK_PORT_CLOSED(who, "input", port, ip->closed);
if (only_avail == -1) {
/* We might need to break. */
if (scheme_current_thread->external_break) {
@ -3819,6 +3819,15 @@ scheme_need_wakeup (Scheme_Object *port, void *fds)
CHECK_PORT_CLOSED(who, "output", port, ((Scheme_Output_Port *)port)->closed); \
}
static void check_input_port_lock(Scheme_Port *ip)
{
if (SCHEME_INPORTP(ip)) {
Scheme_Input_Port *iip = (Scheme_Input_Port *)ip;
if (iip->input_lock)
scheme_wait_input_allowed(iip, 0);
}
}
intptr_t
scheme_tell (Scheme_Object *port)
{
@ -3827,6 +3836,8 @@ scheme_tell (Scheme_Object *port)
ip = scheme_port_record(port);
check_input_port_lock(ip);
CHECK_IOPORT_CLOSED("get-file-position", ip);
if (!ip->count_lines || (ip->position < 0))
@ -3848,6 +3859,8 @@ scheme_tell_line (Scheme_Object *port)
if (!ip->count_lines || (ip->position < 0))
return -1;
check_input_port_lock(ip);
CHECK_IOPORT_CLOSED("get-file-line", ip);
line = ip->lineNumber;
@ -3866,6 +3879,8 @@ scheme_tell_column (Scheme_Object *port)
if (!ip->count_lines || (ip->position < 0))
return -1;
check_input_port_lock(ip);
CHECK_IOPORT_CLOSED("get-file-column", ip);
col = ip->column;
@ -4015,6 +4030,9 @@ scheme_close_input_port (Scheme_Object *port)
ip = scheme_input_port_record(port);
if (ip->input_lock && scheme_force_port_closed)
scheme_wait_input_allowed(ip, 0);
if (!ip->closed) {
if (ip->close_fun) {
Scheme_Close_Input_Fun f = ip->close_fun;
@ -5100,6 +5118,9 @@ scheme_file_position(int argc, Scheme_Object *argv[])
ip = scheme_input_port_record(argv[0]);
if (ip->input_lock)
scheme_wait_input_allowed(ip, 0);
if (SAME_OBJ(ip->sub_type, file_input_port_type)) {
f = ((Scheme_Input_File *)ip->port_data)->f;
#ifdef MZ_FDS