[Larceny-users] Ports' type changes unexpectedly

[Derick Eddington]

Closing string input ports or string output ports changes them from
textual to binary and they are no longer considered input or output
ports.  Ikarus, PLT, and Ypsilon don't do this.  I'm not sure what R6RS
requires about this, but this is unexpected and could cause serious
confusion.

I made a portable test program to check ports' state as they change from
initial to EOF to closed.  It's attached, and below is its current
failing output.  I only tested string input and output ports, but the
program is made to easily add more tests for all the different ways of
making various types of ports.


[d at eep:~/t10]-> larceny -r6rs -program ports-state-tests.sps

--------------------------------------------------
Initial: string-input-port := (open-string-input-port "blah")
--------------------------------------------------

(port? string-input-port) => #t ; correct

(textual-port? string-input-port) => #t ; correct

(binary-port? string-input-port) => #f ; correct

(input-port? string-input-port) => #t ; correct

(output-port? string-input-port) => #f ; correct

(port-eof? string-input-port) => #f ; correct

--------------------------------------------------
EOF: string-input-port
--------------------------------------------------

(port? string-input-port) => #t ; correct

(textual-port? string-input-port) => #t ; correct

(binary-port? string-input-port) => #f ; correct

(input-port? string-input-port) => #t ; correct

(output-port? string-input-port) => #f ; correct

(port-eof? string-input-port) => #t ; correct

(port-transcoder string-input-port) => 64 ; correct

(port-has-port-position? string-input-port) => #t ; correct

(port-has-set-port-position!? string-input-port) => #t ; correct

--------------------------------------------------
Closed: string-input-port
--------------------------------------------------

(port? string-input-port) => #t ; correct

(textual-port? string-input-port) => #f ; *** failed ***
 ; expected result: #t

(binary-port? string-input-port) => #t ; *** failed ***
 ; expected result: #f

(input-port? string-input-port) => #f ; *** failed ***
 ; expected result: #t

(output-port? string-input-port) => #f ; correct

(port-transcoder string-input-port) => 64 ; correct

(port-has-port-position? string-input-port) => #t ; correct

(port-has-set-port-position!? string-input-port) => #t ; correct

--------------------------------------------------
Initial: string-output-port := (let-values (((sop get) (open-string-output-port))) sop)
--------------------------------------------------

(port? string-output-port) => #t ; correct

(textual-port? string-output-port) => #t ; correct

(binary-port? string-output-port) => #f ; correct

(input-port? string-output-port) => #f ; correct

(output-port? string-output-port) => #t ; correct

--------------------------------------------------
Closed: string-output-port
--------------------------------------------------

(port? string-output-port) => #t ; correct

(textual-port? string-output-port) => #f ; *** failed ***
 ; expected result: #t

(binary-port? string-output-port) => #t ; *** failed ***
 ; expected result: #f

(input-port? string-output-port) => #f ; correct

(output-port? string-output-port) => #f ; *** failed ***
 ; expected result: #t

(port-transcoder string-output-port) => 64 ; correct

(port-has-port-position? string-output-port) => #t ; correct

(port-has-set-port-position!? string-output-port) => #t ; correct

; *** checks *** : 30 correct, 6 failed. First failed example:

(textual-port? string-input-port) => #f ; *** failed ***
 ; expected result: #t
[d at eep:~/t10]-> 


-- 
: Derick
----------------------------------------------------------------
-------------- next part --------------
#!r6rs
(import
  (rnrs)
  (srfi :78 lightweight-testing))

(define (banner first . rest)
  (define dashes "--------------------------------------------------\n")
  (newline)
  (display dashes)
  (display first)
  (for-each (lambda (x) (display " ") (write x))
            rest)
  (newline)
  (display dashes))

(define-syntax check-state
  (syntax-rules ()
    ((_ var ((proc expect) ...))
     (begin (check (proc var) => expect) ...))
    ((_ var (usual ...) (extra ...))
     (check-state var (usual ... extra ...)))))

(define-syntax check-port
  (syntax-rules (initial: eof: closed:)
    ((_ var expr
        initial: initial-state
        eof: eof-state
        closed: closed-state)
     (let ((var expr))
       (banner "Initial:" 'var ':= 'expr)
       (check-state var initial-state)
       (let ((pt (port-transcoder var))
             (phpp? (port-has-port-position? var))
             (phspp!? (port-has-set-port-position!? var)))
         (when (input-port? var)
           (banner "EOF:" 'var)
           ((if (textual-port? var) get-string-all get-bytevector-all)
            var)
           (check-state var eof-state
                            ((port-transcoder pt)
                             (port-has-port-position? phpp?)
                             (port-has-set-port-position!? phspp!?))))
         (banner "Closed:" 'var)
         (close-port var)
         (check-state var closed-state
                          ((port-transcoder pt)
                           (port-has-port-position? phpp?)
                           (port-has-set-port-position!? phspp!?))))))))


;; TODO: All the different ways of making various types of ports.

;; open-file-input-port
;; open-bytevector-input-port
;; transcoded-port

(check-port string-input-port (open-string-input-port "blah")
            initial: ((port? #T)
                      (textual-port? #T)
                      (binary-port? #F)
                      (input-port? #T)
                      (output-port? #F)
                      (port-eof? #F))
            eof: ((port? #T)
                  (textual-port? #T)
                  (binary-port? #F)
                  (input-port? #T)
                  (output-port? #F)
                  (port-eof? #T))
            closed: ((port? #T)
                     (textual-port? #T)
                     (binary-port? #F)
                     (input-port? #T)
                     (output-port? #F)
                     #;(port-eof? #T)))

;; make-custom-binary-input-port
;; make-custom-textual-input-port
;; open-file-output-port
;; open-bytevector-output-port

(check-port string-output-port (let-values (((sop get)
                                             (open-string-output-port)))
                                 sop)
            initial: ((port? #T)
                      (textual-port? #T)
                      (binary-port? #F)
                      (input-port? #F)
                      (output-port? #T))
            eof: ()
            closed: ((port? #T)
                     (textual-port? #T)
                     (binary-port? #F)
                     (input-port? #F)
                     (output-port? #T)))

;; make-custom-binary-output-port
;; make-custom-textual-output-port
;; open-input-file
;; open-output-file


(check-report)