Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • tests/fd-streams.lisp
    ... ... @@ -17,6 +17,7 @@
    17 17 
     (eval-when (:load-toplevel)
    18 18 
       (ensure-directories-exist *test-path* :verbose t))
    19 19
    20 
    +#+nil
    20 21 
     (define-test clear-output-1
    21 22 
       (:tag :trac)
    22 23 
       (assert-eql
    ... ... @@ -34,3 +35,20 @@
    34 35 
     	  (setf s (open *test-file*))
    35 36 
     	  (file-length s))
    36 37 
          (delete-file *test-file*))))
    38 
    +
    39 
    +(define-test clear-output-1
    40 
    +  (:tag :trac)
    41 
    +  (assert-eql
    42 
    +   0
    43 
    +   (ext:with-temporary-file (test-file)
    44 
    +     (let ((s (open test-file
    45 
    +		    :direction :output
    46 
    +		    :if-exists :supersede)))
    47 
    +       ;; Write a character to the (fully buffered) output
    48 
    +       ;; stream. Clear the output and close the file. Nothing
    49 
    +       ;; should have been written to the file.
    50 
    +       (write-char #\a s)
    51 
    +       (clear-output s)
    52 
    +       (close s)
    53 
    +       (setf s (open test-file))
    54 
    +       (file-length s)))))

  • tests/trac.lisp
    ... ... @@ -123,6 +123,7 @@
    123 123 
           (assert-equal (values #\H 8)
    124 124 
     		    (bug :utf32)))))
    125 125
    126 
    +#+nil
    126 127 
     (define-test trac.36
    127 128 
       (:tag :trac)
    128 129 
       (flet ((bug (&optional (format :utf16))
    ... ... @@ -137,6 +138,24 @@
    137 138 
         (assert-equal (values #\H 8)
    138 139 
     		  (bug :utf32))))
    139 140
    141 
    +(define-test trac.36
    142 
    +    (:tag :trac)
    143 
    +    (flet ((bug (&optional (format :utf16))
    144 
    +	     (ext:with-temporary-file (path)
    145 
    +	       (with-open-file (s path
    146 
    +				  :direction :output
    147 
    +				  :external-format format)
    148 
    +		 (format s "Hello~%"))
    149 
    +	       (with-open-file (s path
    150 
    +				  :direction :input
    151 
    +				  :external-format format)
    152 
    +		 (let ((ch (read-char s)))
    153 
    +		   (values ch (file-position s)))))))
    154 
    +      (assert-equal (values #\H 4)
    155 
    +		    (bug :utf16))
    156 
    +      (assert-equal (values #\H 8)
    157 
    +		    (bug :utf32)))))
    158 
    +
    140 159 
     #+nil
    141 160 
     (define-test trac.43
    142 161 
       (:tag :trac)
    ... ... @@ -157,6 +176,7 @@
    157 176 
     		(let ((p0* (file-position stream)))
    158 177 
     		  (eql p0* p0)))))))))
    159 178
    179 
    +#+nil
    160 180 
     (define-test trac.43
    161 181 
         (:tag :trac)
    162 182 
       (assert-true
    ... ... @@ -174,11 +194,25 @@
    174 194 
     	 (let ((p0* (file-position stream)))
    175 195 
     	   (eql p0* p0)))))))
    176 196
    197 
    +(define-test trac.43
    198 
    +    (:tag :trac)
    199 
    +  (assert-true
    200 
    +   (ext:with-temporary-stream (stream :direction :io :external-format :utf-8)
    201 
    +     (dotimes (i 1000)
    202 
    +       (write-char (code-char #x1234) stream))
    203 
    +     (file-position stream 0)
    204 
    +     (let ((p0 (file-position stream))
    205 
    +	   (ch (read-char stream)))
    206 
    +       (unread-char ch stream)
    207 
    +       (let ((p0* (file-position stream)))
    208 
    +	 (eql p0* p0))))))
    209 
    +
    177 210 
     (define-test trac.50
    178 211 
       (:tag :trac)
    179 212 
       (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))"
    180 213 
     		(princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b")))))
    181 214
    215 
    +#+nil
    182 216 
     (define-test trac.58
    183 217 
       (:tag :trac)
    184 218 
       (assert-false
    ... ... @@ -198,6 +232,23 @@
    198 232 
     	    failures)
    199 233 
            (delete-file path)))))
    200 234
    235 
    +(define-test trac.58
    236 
    +    (:tag :trac)
    237 
    +  (assert-false
    238 
    +   (let (failures)
    239 
    +     (ext:with-temporary-file (path)
    240 
    +       (with-open-file (s path :direction :output :external-format :utf-16)
    241 
    +	 (dotimes (i 300)
    242 
    +	   (write-char (code-char i) s)))
    243 
    +
    244 
    +       (with-open-file (s path :direction :input :external-format :utf-16)
    245 
    +	 (dotimes (i 300)
    246 
    +	   (let ((ch (read-char s nil nil)))
    247 
    +	     (unless (= i (char-code ch))
    248 
    +	       (push (list i ch (char-code ch)) failures)))))
    249 
    +       failures))
    250 
    +   failures))
    251 
    +
    201 252 
     (define-test trac.63
    202 253 
       (:tag :trac)
    203 254 
       (assert-eql
    ... ... @@ -282,6 +333,7 @@
    282 333 
       (assert-equal "A1234AAAA"
    283 334 
     		(subseq (trac.70-test *trac.70* "a12345") 0 9)))
    284 335
    336 
    +#+nil
    285 337 
     (define-test trac.79
    286 338 
       (:tag :trac)
    287 339 
       ;; Create a temp file full of latin1 characters.
    ... ... @@ -301,12 +353,29 @@
    301 353 
     		      (file-position s)))))
    302 354 
            (delete-file path)))))
    303 355
    356 
    +(define-test trac.79
    357 
    +  (:tag :trac)
    358 
    +  ;; Create a temp file full of latin1 characters.
    359 
    +  (assert-equal
    360 
    +   '(0 1)
    361 
    +   (ext:with-temporary-file (path)
    362 
    +     (with-open-file (s path :direction :output :if-exists :supersede
    363 
    +			     :external-format :latin1)
    364 
    +       (dotimes (k 255)
    365 
    +	 (write-char (code-char k) s)))
    366 
    +     (with-open-file (s path :direction :input :external-format :latin1)
    367 
    +       (list (file-position s)
    368 
    +	     (progn
    369 
    +	       (read-char s)
    370 
    +	       (file-position s)))))))
    371 
    +
    304 372 
     (define-test trac.80
    305 373 
       (:tag :trac)
    306 374 
       ;; The following formats should not signal an error.
    307 375 
       (assert-true (ignore-errors (format nil "~ve" 21 5d-234)))
    308 376 
       (assert-true (ignore-errors (format nil "~ve" 100 5d-234))))
    309 377
    378 
    +#+nil
    310 379 
     (define-test trac.87.output
    311 380 
       (:tag :trac)
    312 381 
       ;; Test that run-program accepts :element-type and produces the
    ... ... @@ -330,6 +399,27 @@
    330 399 
     	      octets)))
    331 400 
           (delete-file path))))
    332 401
    402 
    +(define-test trac.87.output
    403 
    +  (:tag :trac)
    404 
    +  ;; Test that run-program accepts :element-type and produces the
    405 
    +  ;; correct output.
    406 
    +  (let ((string "Hello"))
    407 
    +    (ext:with-temporary-file (path)
    408 
    +      (with-open-file (s path :direction :output :if-exists :supersede
    409 
    +			      :external-format :latin1)
    410 
    +	(write-string string s))
    411 
    +      (let* ((expected (stream:string-to-octets string :external-format :latin1))
    412 
    +	     (octets (make-array (length expected)
    413 
    +				 :element-type '(unsigned-byte 8)))
    414 
    +	     (proc (ext:run-program "/bin/cat" (list path)
    415 
    +				    :output :stream
    416 
    +				    :element-type '(unsigned-byte 8))))
    417 
    +	(read-sequence octets (ext:process-output proc))
    418 
    +	(assert-equalp
    419 
    +	 expected
    420 
    +	 octets)))))
    421 
    +
    422 
    +#+nil
    333 423 
     (define-test trac.87.input
    334 424 
       (:tag :trac)
    335 425 
       ;; Test that run-program accepts :element-type and produces the
    ... ... @@ -354,6 +444,28 @@
    354 444 
     	      octets
    355 445 
     	      output)))
    356 446 
           (delete-file path))))
    447 
    +
    448 
    +(define-test trac.87.input
    449 
    +  (:tag :trac)
    450 
    +  ;; Test that run-program accepts :element-type and produces the
    451 
    +  ;; correct input (and output).
    452 
    +  (let ((string "Hello"))
    453 
    +    (ext:with-temporary-file (path)
    454 
    +      (with-open-file (s path :direction :output :if-exists :supersede
    455 
    +			      :external-format :latin1)
    456 
    +	(write-string string s))
    457 
    +      (let ((octets (stream:string-to-octets string :external-format :latin1))
    458 
    +	    (output (make-array (length string)
    459 
    +				:element-type '(unsigned-byte 8)))
    460 
    +	    (proc (ext:run-program "/bin/cat" (list path)
    461 
    +				   :input :stream
    462 
    +				   :output :stream
    463 
    +				   :element-type '(unsigned-byte 8))))
    464 
    +	(write-sequence octets (ext:process-input proc))
    465 
    +	(read-sequence output (ext:process-output proc))
    466 
    +	(assert-equalp
    467 
    +	 octets
    468 
    +	 output)))))
    357 469
    358 470 
     (define-test trac.92
    359 471 
       (:tag :trac)
    ... ... @@ -413,6 +525,7 @@
    413 525 
     ;; Not quite what ticket 101 is about, but it came up in investigating
    414 526 
     ;; CLEAR-OUTPUT on a Gray stream.  Verify CLEAR-OUTPUT actually
    415 527 
     ;; does. Previously, it did nothing.
    528 
    +#+nil
    416 529 
     (define-test trac.101
    417 530 
       (:tag :trac)
    418 531 
       (assert-eql
    ... ... @@ -430,6 +543,20 @@
    430 543 
            (close s)
    431 544 
            (delete-file *test-file*)))))
    432 545
    546 
    +(define-test trac.101
    547 
    +  (:tag :trac)
    548 
    +  (assert-eql
    549 
    +   0
    550 
    +   (ext:with-temporary-file (test-file)
    551 
    +     (let ((s (open test-file
    552 
    +		    :direction :output
    553 
    +		    :if-exists :supersede)))
    554 
    +       (write-char #\a s)
    555 
    +       (clear-output s)
    556 
    +       (close s)
    557 
    +       (setf s (open test-file))
    558 
    +       (file-length s)))))
    559 
    +
    433 560 
     (defun read-string-fn (str)
    434 561 
          (handler-case
    435 562 
            (let ((acc nil))

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