Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/code/fd-stream.lisp
    ... ... @@ -1764,7 +1764,8 @@
    1764 1764 
     		   (progn
    1765 1765 
     		     (format t "in-buffer-length = ~D~%" in-buffer-length)
    1766 1766 
     		     (format t "in-length = ~D~%" (fd-stream-in-length stream))
    1767 
    -		     (format t "fd-stream-in-index = ~D~%" (fd-stream-in-index stream)))
    1767 
    +		     (format t "fd-stream-in-index = ~D~%" (fd-stream-in-index stream))
    1768 
    +		     (format t "posn = ~A~%" posn))
    1768 1769 
     		   (decf posn (- (fd-stream-in-length stream)
    1769 1770 
     				 (fd-stream-in-index stream))))
    1770 1771 
     		 #+nil
    ... ... @@ -1795,9 +1796,14 @@
    1795 1796 
     	(setf (fd-stream-unread stream) nil) ;;@@
    1796 1797 
     	#+unicode
    1797 1798 
     	(progn
    1799 
    +	  ;; Clear out any pending input from the string buffer
    1798 1800 
     	  (setf (fd-stream-last-char-read-size stream) 0)
    1799 1801 
     	  (setf (fd-stream-string-index stream)
    1800 1802 
     		(fd-stream-string-buffer-len stream)))
    1803 
    +	;; Mark the in-buffer as empty.
    1804 
    +	(setf (fd-stream-in-index stream)
    1805 
    +	      (fd-stream-in-length stream))
    1806 
    +	;; Mark the ibuf as empty.
    1801 1807 
     	(setf (fd-stream-ibuf-head stream) 0)
    1802 1808 
     	(setf (fd-stream-ibuf-tail stream) 0)
    1803 1809 
     	;; Trash cached value for listen, so that we check next time.

  • tests/fd-streams.lisp
    ... ... @@ -34,3 +34,59 @@
    34 34 
     	  (setf s (open *test-file*))
    35 35 
     	  (file-length s))
    36 36 
          (delete-file *test-file*))))
    37 
    +
    38 
    +(define-test file-position.1
    39 
    +    (:tag :issues)
    40 
    +  ;; Create a short test file
    41 
    +  (let ((test-file (merge-pathnames #p"file-pos.txt" *test-path*)))
    42 
    +    (with-open-file (s test-file
    43 
    +		       :direction :output
    44 
    +		       :if-exists :supersede)
    45 
    +      (write-string "aaaaaa" s)
    46 
    +      (write-char #\newline s))
    47 
    +    (with-open-file (s test-file)
    48 
    +      (read-line s)
    49 
    +      (assert-true (file-position s 0))
    50 
    +      (assert-equal (file-position s) 0))))
    51 
    +
    52 
    +(define-test file-position.2
    53 
    +    (:tag :issues)
    54 
    +  ;; Create a test file just longer than the internal in-buffer length
    55 
    +  ;; and the first line is more than 512 characters long.
    56 
    +  (let ((test-file (merge-pathnames #p"file-pos.txt" *test-path*)))
    57 
    +    (with-open-file (s test-file
    58 
    +		       :direction :output
    59 
    +		       :if-exists :supersede)
    60 
    +      (write-string (make-string 512 :initial-element #\a) s)
    61 
    +      (write-char #\newline s)
    62 
    +      (write-string "zzzzz" s)
    63 
    +      (write-char #\newline s))
    64 
    +    (with-open-file (s test-file)
    65 
    +      (read-line s)
    66 
    +      (assert-true (file-position s 0))
    67 
    +      (assert-equal (file-position s) 0))))
    68 
    +
    69 
    +(define-test file-position.3
    70 
    +    (:tag :issues)
    71 
    +  ;; Create a test file just longer than the internal in-buffer
    72 
    +  ;; length.  This tests the case where the in-buffer does not have
    73 
    +  ;; enough octets to form a complete character.  (See comment in
    74 
    +  ;; fd-stream-file-position.
    75 
    +  (let ((test-file (merge-pathnames #p"file-pos.txt" *test-path*)))
    76 
    +    (with-open-file (s test-file
    77 
    +		       :external-format :utf-8
    78 
    +		       :direction :output
    79 
    +		       :if-exists :supersede)
    80 
    +      (write-char #\a s)
    81 
    +      ;; STR is a string consisting of the single codepoint #x11000
    82 
    +      ;; which is 4 octets when encoded using utf-8.
    83 
    +      (let ((str (lisp::codepoints-string '(#x11000))))
    84 
    +	(dotimes (k 128)
    85 
    +	  (write-string str s)))
    86 
    +      (write-char #\newline s)
    87 
    +      (write-string "zzzzz" s)
    88 
    +      (write-char #\newline s))
    89 
    +    (with-open-file (s test-file :external-format :utf-8)
    90 
    +      (read-line s)
    91 
    +      (assert-true (file-position s 0))
    92 
    +      (assert-equal (file-position s) 0))))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help