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

fix port line, col, and pos to stay at #f when set to #f

Browse Source
This commit is contained in:
Matthew Flatt 2017-02-23 19:54:34 -07:00
parent 39b2a61700
commit 481dc9b0e8
3 changed files with 40 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkgs/racket-test-core/tests/racket/port.rktl
View File

@ -945,6 +945,29 @@
(test 5 file-position p)
(test "abcde" read-string 5 p))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that lines, columns, and positions stay at #f when set to #f
(let ()
(define (check-srcloc line col pos)
(define stx-port (open-input-string "A\n B"))
(port-count-lines! stx-port)
(set-port-next-location! stx-port line col pos)
(define a (read-syntax #f stx-port))
(define b (read-syntax #f stx-port))
(test line syntax-line a)
(test col syntax-column a)
(test pos syntax-position a)
(test (and line (add1 line)) syntax-line b)
(test (and col 1) syntax-column b)
(test (and pos (+ 3 pos)) syntax-position b))
(check-srcloc #f #f #f)
(check-srcloc #f #f 29)
(check-srcloc 1 #f 29)
(check-srcloc #f 3 29)
(check-srcloc #f 3 #f)
(check-srcloc 1 3 29))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -2048,8 +2048,10 @@ static void post_progress(Scheme_Input_Port *ip)
XFORM_NONGCING static void inc_pos(Scheme_Port *ip, int a)
{
ip->column += a;
ip->readpos += a;
if (ip->column >= 0)
ip->column += a;
if (ip->readpos >= 0)
ip->readpos += a;
ip->charsSinceNewline += a;
ip->utf8state = 0;
}
@ -2081,13 +2083,10 @@ XFORM_NONGCING static void do_count_lines(Scheme_Port *ip, const char *buffer, i
intptr_t i;
int c, degot = 0;
mzAssert(ip->lineNumber >= 0);
mzAssert(ip->column >= 0);
mzAssert(ip->position >= 0);
ip->oldColumn = ip->column; /* works for a single-char read, like `read' */
ip->readpos += got; /* add for CR LF below */
if (ip->readpos >= 0)
ip->readpos += got; /* add for CR LF below */
/* Find start of last line: */
for (i = got, c = 0; i--; c++) {
@ -2125,10 +2124,12 @@ XFORM_NONGCING static void do_count_lines(Scheme_Port *ip, const char *buffer, i
}
mzAssert(n > 0);
ip->lineNumber += n;
if (ip->lineNumber >= 0)
ip->lineNumber += n;
ip->was_cr = (buffer[offset + got - 1] == '\r');
/* Now reset column to 0: */
ip->column = 0;
if (ip->column >= 0)
ip->column = 0;
} else {
ip->charsSinceNewline += c;
}
@ -2157,15 +2158,13 @@ XFORM_NONGCING static void do_count_lines(Scheme_Port *ip, const char *buffer, i
col += n;
degot += ((i - prev_i) - n);
}
ip->column = col;
if (ip->column >= 0)
ip->column = col;
ip->utf8state = state;
}
ip->readpos -= degot;
mzAssert(ip->lineNumber >= 0);
mzAssert(ip->column >= 0);
mzAssert(ip->position >= 0);
if (ip->readpos >= 0)
ip->readpos -= degot;
}
void scheme_port_count_lines(Scheme_Port *ip, const char *buffer, intptr_t offset, intptr_t got)

5
racket/src/racket/src/print.c
View File

@ -3002,11 +3002,12 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
print_utf8_string(pp, SCHEME_BYTE_STR_VAL(stx->srcloc->src), 0, SCHEME_BYTE_STRLEN_VAL(stx->srcloc->src));
print_utf8_string(pp, ":", 0, 1);
}
if (stx->srcloc->line >= 0)
if ((stx->srcloc->line >= 0)
&& (stx->srcloc->col >= 0))
sprintf(quick_buffer,
"%" PRIdPTR ":%" PRIdPTR "",
stx->srcloc->line, stx->srcloc->col-1);
else
else if (stx->srcloc->pos >= 0)
sprintf(quick_buffer, ":%" PRIdPTR "",
stx->srcloc->pos);
print_utf8_string(pp, quick_buffer, 0, -1);