file-position: repair for OS pipe after peek

Closes #2419
This commit is contained in:
Matthew Flatt 2018-12-09 12:16:10 -07:00
parent db2ac559a7
commit 24aeea28c1
2 changed files with 17 additions and 1 deletions

View File

@ -921,6 +921,20 @@
(delete-file path))
;; Check `file-position`, OS-level pipes, and peek
(when (and (memq (system-type) '(unix macosx))
(file-exists? "/bin/cat"))
(define-values (sp stdout-in stdin-out no-stderr) (subprocess #f #f (current-error-port) "/bin/cat"))
(write-bytes #"abcd\n" stdin-out)
(close-output-port stdin-out)
(test 0 file-position stdout-in)
(test #"abc" peek-bytes 3 0 stdout-in)
(test 0 file-position stdout-in)
(test #\a read-char stdout-in)
(test 1 file-position stdout-in)
(close-input-port stdout-in)
(subprocess-wait sp))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check reader error-message formatting for a struct port

View File

@ -4202,6 +4202,7 @@ do_file_position(const char *who, int argc, Scheme_Object *argv[], int can_false
return scheme_void;
} else {
mzlonglong pll;
int already_ungot = 0;
if (f) {
pll = BIG_OFF_T_IZE(ftello)(f);
} else if (fd) {
@ -4210,6 +4211,7 @@ do_file_position(const char *who, int argc, Scheme_Object *argv[], int can_false
sz = rktio_get_file_position(scheme_rktio, fd);
if (!sz) {
pll = do_tell(argv[0], 0);
already_ungot = 1;
} else {
pll = *sz;
free(sz);
@ -4247,7 +4249,7 @@ do_file_position(const char *who, int argc, Scheme_Object *argv[], int can_false
}
/* Back up for un-gotten & peeked chars: */
if (SCHEME_INPUT_PORTP(argv[0])) {
if (!already_ungot && SCHEME_INPUT_PORTP(argv[0])) {
Scheme_Input_Port *ip;
ip = scheme_input_port_record(argv[0]);
pll -= ip->ungotten_count;