reencode-output: flush buffer on encoding error, so that the port can be closed

svn: r9528

collects/mzlib/port.ss

@@ -1428,7 +1428,7 @@
 		  (set! ready-start 0)
 		  (set! ready-end (- (bytes-length error-bytes) cnt))
 		  cnt))
-	      (decode-error "decoding error in input stream"
+              (decode-error "decoding error in input stream"
                             port)))
         
 	(unless c
@@ -1733,7 +1733,7 @@
 			(set! ready-end (bytes-length error-bytes)))
 		      ;; Raise an exception:
 		      (begin
-			(set! out-start (add1 out-start))
+			(set! out-start out-end) ;; flush buffer so close can work
 			(decode-error
 			 "error decoding output to stream"
 			 port))))))))
@@ -1756,7 +1756,7 @@
 	 write-it
 	 (lambda ()
 	   ;; Flush output
-	   (write-it #"" 0 0 #f #f)
+           (write-it #"" 0 0 #f #f)
 	   (when close?
 	     (close-output-port port))
 	   (bytes-close-converter c))

collects/tests/r6rs/io/ports.ss

@@ -340,7 +340,8 @@
               (test b1 #xFF)
               (test (get-u8 p) #xFE)
               (test (get-u8 p) 97)
-              (test (get-u8 p) 0)))))
+              (test (get-u8 p) 0))))
+      (test/unspec (close-port p)))
 
     (let ([bytevector->string-via-file
            (lambda (bv tr)
@@ -358,7 +359,7 @@
                                              'block tr)])
                (dynamic-wind
                    (lambda () 'ok)
-                   (lambda () (put-string p str))
+                   (lambda () (put-string p str) (flush-output-port p))
                    (lambda () (close-port p))))
              (let ([p (open-file-input-port "io-tmp1")])
                (let ([v (get-bytevector-all p)])
@@ -415,8 +416,7 @@
                                           (make-transcoder (utf-8-codec)))])
       (test (get-string-n p 10) "berrapple")
       (test/unspec (close-port p)))
-    
-    
+
     (test/unspec (delete-file "io-tmp1"))
     
     ;; ----------------------------------------
@@ -702,5 +702,9 @@
     ;; ----------------------------------------
     
     ;;
-    ))
+    )
+
+  (run-io-ports-tests)
+  (report-test-results)
+  )
 

src/mzscheme/src/port.c

@@ -4945,6 +4945,7 @@ fd_close_input(Scheme_Input_Port *port)
   }
   if (!fip->refcount || !*fip->refcount) {
     CloseHandle((HANDLE)fip->fd);
+    --scheme_file_open_count;
   }
 #else
   if (!fip->refcount || !*fip->refcount) {
@@ -4952,10 +4953,9 @@ fd_close_input(Scheme_Input_Port *port)
     do {
       cr = close(fip->fd);
     } while ((cr == -1) && (errno == EINTR));
+    --scheme_file_open_count;
   }
 #endif
-
-  --scheme_file_open_count;
 }
 
 static void
@@ -6173,6 +6173,7 @@ fd_close_output(Scheme_Output_Port *port)
   }
   if (!fop->refcount || !*fop->refcount) {
     CloseHandle((HANDLE)fop->fd);
+    --scheme_file_open_count;
   }
 #else
   if (!fop->refcount || !*fop->refcount) {
@@ -6180,10 +6181,9 @@ fd_close_output(Scheme_Output_Port *port)
     do {
       cr = close(fop->fd);
     } while ((cr == -1) && (errno == EINTR));
+    --scheme_file_open_count;
   }
 #endif
-
-  --scheme_file_open_count;
 }
 
 static int fd_output_buffer_mode(Scheme_Port *p, int mode)