Raymond Toy pushed to branch master at cmucl / cmucl Commits: 78cb9dbd by Raymond Toy at 2025-05-09T06:55:39-07:00 Fix #401: FILE-POSITION returns correct position after setting it - - - - - 3e8a929d by Raymond Toy at 2025-05-09T06:55:39-07:00 Merge branch 'issue-401-file-position-setter-wrong' into 'master' Fix #401: FILE-POSITION returns correct position after setting it Closes #401 See merge request cmucl/cmucl!290 - - - - - 2 changed files: - src/code/fd-stream.lisp - tests/fd-streams.lisp Changes: ===================================== src/code/fd-stream.lisp ===================================== @@ -1764,7 +1764,8 @@ (progn (format t "in-buffer-length = ~D~%" in-buffer-length) (format t "in-length = ~D~%" (fd-stream-in-length stream)) - (format t "fd-stream-in-index = ~D~%" (fd-stream-in-index stream))) + (format t "fd-stream-in-index = ~D~%" (fd-stream-in-index stream)) + (format t "posn = ~A~%" posn)) (decf posn (- (fd-stream-in-length stream) (fd-stream-in-index stream)))) #+nil @@ -1795,9 +1796,14 @@ (setf (fd-stream-unread stream) nil) ;;@@ #+unicode (progn + ;; Clear out any pending input from the string buffer (setf (fd-stream-last-char-read-size stream) 0) (setf (fd-stream-string-index stream) (fd-stream-string-buffer-len stream))) + ;; Mark the in-buffer as empty. + (setf (fd-stream-in-index stream) + (fd-stream-in-length stream)) + ;; Mark the ibuf as empty. (setf (fd-stream-ibuf-head stream) 0) (setf (fd-stream-ibuf-tail stream) 0) ;; Trash cached value for listen, so that we check next time. ===================================== tests/fd-streams.lisp ===================================== @@ -34,3 +34,59 @@ (setf s (open *test-file*)) (file-length s)) (delete-file *test-file*)))) + +(define-test file-position.1 + (:tag :issues) + ;; Create a short test file + (let ((test-file (merge-pathnames #p"file-pos.txt" *test-path*))) + (with-open-file (s test-file + :direction :output + :if-exists :supersede) + (write-string "aaaaaa" s) + (write-char #\newline s)) + (with-open-file (s test-file) + (read-line s) + (assert-true (file-position s 0)) + (assert-equal (file-position s) 0)))) + +(define-test file-position.2 + (:tag :issues) + ;; Create a test file just longer than the internal in-buffer length + ;; and the first line is more than 512 characters long. + (let ((test-file (merge-pathnames #p"file-pos.txt" *test-path*))) + (with-open-file (s test-file + :direction :output + :if-exists :supersede) + (write-string (make-string 512 :initial-element #\a) s) + (write-char #\newline s) + (write-string "zzzzz" s) + (write-char #\newline s)) + (with-open-file (s test-file) + (read-line s) + (assert-true (file-position s 0)) + (assert-equal (file-position s) 0)))) + +(define-test file-position.3 + (:tag :issues) + ;; Create a test file just longer than the internal in-buffer + ;; length. This tests the case where the in-buffer does not have + ;; enough octets to form a complete character. (See comment in + ;; fd-stream-file-position. + (let ((test-file (merge-pathnames #p"file-pos.txt" *test-path*))) + (with-open-file (s test-file + :external-format :utf-8 + :direction :output + :if-exists :supersede) + (write-char #\a s) + ;; STR is a string consisting of the single codepoint #x11000 + ;; which is 4 octets when encoded using utf-8. + (let ((str (lisp::codepoints-string '(#x11000)))) + (dotimes (k 128) + (write-string str s))) + (write-char #\newline s) + (write-string "zzzzz" s) + (write-char #\newline s)) + (with-open-file (s test-file :external-format :utf-8) + (read-line s) + (assert-true (file-position s 0)) + (assert-equal (file-position s) 0)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e90fa5af893e3d5842b5064... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e90fa5af893e3d5842b5064... You're receiving this email because of your account on gitlab.common-lisp.net.