memory-ports.k (3479B)
1 ;; check.k & test-helpers.k should be loaded 2 ;; 3 ;; Tests of string and bytevector port features. 4 ;; 5 6 ;; (R7RS 3rd draft, section 6.7.1) open-input-string 7 ;; TODO: char-ready? 8 ;; TODO: unicode input 9 ;; TODO: closing 10 ;; 11 ($let ((p (open-input-string ""))) 12 ($check-predicate (port? p)) 13 ($check-predicate (input-port? p)) 14 ($check-not-predicate (output-port? p)) 15 ($check-predicate (textual-port? p)) 16 ($check-not-predicate (binary-port? p)) 17 ($check-predicate (port-open? p)) 18 ($check-predicate (eof-object? (peek-char p))) 19 ($check-predicate (eof-object? (read-char p)))) 20 21 ($let ((p (open-input-string "abc"))) 22 ($check equal? (read-char p) #\a) 23 ($check equal? (peek-char p) #\b) 24 ($check equal? (read-char p) #\b) 25 ($check equal? (read-char p) #\c) 26 ($check-predicate (eof-object? (read-char p)))) 27 28 ($let ((p (open-input-string "(1 2 #ignore) \"x\""))) 29 ($check equal? (read p) (list 1 2 #ignore)) 30 ($check equal? (read p) "x") 31 ($check-predicate (eof-object? (read p)))) 32 33 ;; (R7RS 3rd draft, section 6.7.1) open-output-string get-output-string 34 ;; TODO: newline 35 ;; 36 ($let ((p (open-output-string))) 37 ($check-predicate (port? p)) 38 ($check-predicate (output-port? p)) 39 ($check-not-predicate (input-port? p)) 40 ($check-predicate (textual-port? p)) 41 ($check-not-predicate (binary-port? p)) 42 ($check-predicate (port-open? p)) 43 ($check equal? (get-output-string p) "") 44 ($check-no-error (write-char #\a p)) 45 ($check equal? (get-output-string p) "a") 46 ($check-no-error (display "bc" p)) 47 ($check equal? (get-output-string p) "abc") 48 ($check-no-error (write (list 1 "2" 3) p)) 49 ($check equal? (get-output-string p) "abc(1 \"2\" 3)")) 50 51 ($check-error (get-output-string (get-current-input-port))) 52 ($check-error (get-output-string (get-current-output-port))) 53 54 ($let ((p (open-output-string))) 55 ($check-no-error (display (make-string 100 #\a) p)) 56 ($check-no-error (display (make-string 1000 #\b) p)) 57 ($check-no-error (display (make-string 10000 #\c) p)) 58 ($check equal? (string-length (get-output-string p)) 11100) 59 ($check equal? (string-ref (get-output-string p) 11001) #\c)) 60 61 ;; (R7RS 3rd draft, section 6.7.1) open-input-bytevector 62 ;; TODO: u8-ready? 63 ;; TODO: closing 64 ;; 65 ($let ((p (open-input-bytevector (make-bytevector 0)))) 66 ($check-predicate (port? p)) 67 ($check-predicate (input-port? p)) 68 ($check-not-predicate (output-port? p)) 69 ($check-predicate (binary-port? p)) 70 ($check-not-predicate (textual-port? p)) 71 ($check-predicate (eof-object? (peek-u8 p))) 72 ($check-predicate (eof-object? (read-u8 p)))) 73 74 ($let* 75 ((v (make-bytevector 3 0)) 76 (p ($sequence 77 (bytevector-u8-set! v 0 2) 78 (bytevector-u8-set! v 1 129) 79 (open-input-bytevector v)))) 80 ($check equal? (read-u8 p) 2) 81 ($check equal? (peek-u8 p) 129) 82 ($check equal? (read-u8 p) 129) 83 ($check equal? (read-u8 p) 0) 84 ($check-predicate (eof-object? (read-u8 p)))) 85 86 ;; (R7RS 3rd draft, section 6.7.1) open-output-bytevector get-output-bytevector 87 88 ($let ((p (open-output-bytevector))) 89 ($check equal? (bytevector-length (get-output-bytevector p)) 0) 90 ($check-no-error (write-u8 1 p)) 91 ($check equal? (bytevector-length (get-output-bytevector p)) 1) 92 ($check-no-error (write-u8 10 p)) 93 ($check-no-error (write-u8 129 p)) 94 ($let ((v (get-output-bytevector p))) 95 ($check equal? (bytevector-length v) 3) 96 ($check equal? (bytevector-u8-ref v 0) 1) 97 ($check equal? (bytevector-u8-ref v 1) 10) 98 ($check equal? (bytevector-u8-ref v 2) 129)))