Changeset 384

Timestamp:

Jan 24, 2004, 3:41:56 PM (21 years ago)

Author:

Gary Byers

Message:

Return was-open-p from CLOSE method.

Location:

trunk/ccl/level-1

Files:

• l1-sockets.lisp (modified) (1 diff)
• l1-streams.lisp (modified) (3 diffs)
• l1-sysio.lisp (modified) (2 diffs)

trunk/ccl/level-1/l1-sockets.lisp

@@ -254 +254 @@
   (when (socket-device socket)
     (fd-close (socket-device socket))
-    (setf (socket-device socket) nil)))
+    (setf (socket-device socket) nil)
+    t))
 
 ;; A passive tcp socket just generates connection streams

trunk/ccl/level-1/l1-streams.lisp

@@ -244 +244 @@
 (defmethod close ((stream stream) &key abort)
   (declare (ignore abort))
-  nil)
-
-(defmethod close :after ((stream stream) &key abort)
-  (declare (ignore abort))
-  (unless (slot-value stream 'closed)
-    (set-slot-value stream 'closed :closed)
-    t))
+  (with-slots ((closed closed)) stream
+      (unless closed
+        (setf closed nil))))
+
+
 
 (defmethod open-stream-p ((x t))
@@ -1679 +1677 @@
   ())
 
-
 (defmethod close :after ((stream buffered-stream-mixin) &key abort)
   (declare (ignore abort))
@@ -1686 +1683 @@
       (%ioblock-close ioblock))))
 
-
 (defmethod close :before ((stream buffered-output-stream-mixin) &key abort)
-  (declare (ignore abort))
-  (when (open-stream-p stream)
-    (stream-force-output stream)))
+  (unless abort
+    (when (open-stream-p stream)
+      (stream-force-output stream))))
 
 (defmethod interactive-stream-p ((stream buffered-stream-mixin))

trunk/ccl/level-1/l1-sysio.lisp

@@ -471 +471 @@
           (delete-file original-name)))
       (setq *open-file-streams* (nremove s *open-file-streams*))
-      (call-next-method))))
+      (call-next-method)
+      t)))
 
 (defmethod select-stream-class ((class file-stream) in-p out-p char-p)
@@ -621 +622 @@
 (defun file-string-length (stream object)
   (unless (and (typep stream 'file-stream)
-               (eq 'character (stream-element-type stream)))
+               (let* ((eltype (stream-element-type stream)))
+                 (or (eq 'character eltype)
+                     (eq 'base-char eltype)
+                     (subtypep eltype 'character))))
     (error "~S is not a file stream capable of character output" stream))
   (etypecase object