fix GC-LOGFILE when none has been set

  ...and the return value from (SETF GC-LOGFILE).

diff --git a/NEWS b/NEWS
index f1a556d..abc3e81 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@ changes relative to sbcl-1.1.0:
     by lexical bindings.
   * bug fix: stack allocation was prevented by high DEBUG declaration in several
     cases.
+  * bug fix: SB-EXT:GC-LOGFILE signaled an error when no logfile was set. (thanks
+    to SANO Masatoshi)
 
 changes in sbcl-1.1.0 relative to sbcl-1.0.58:
   * enhancement: New variable, sb-ext:*disassemble-annotate* for controlling

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index b9d9151..b0f5fbc 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -164,16 +164,17 @@ run in any thread.")
           (old %gc-logfile))
       (setf %gc-logfile new)
       (when old
-        (sb!alien:free-alien old))))
+        (sb!alien:free-alien old))
+      pathname))
   (defun gc-logfile ()
     #!+sb-doc
     "Return the pathname used to log garbage collections. Can be SETF.
 Default is NIL, meaning collections are not logged. If non-null, the
 designated file is opened before and after each collection, and generation
 statistics are appended to it."
-    (let ((val %gc-logfile))
+    (let ((val (cast %gc-logfile c-string)))
       (when val
-        (native-pathname (cast val c-string)))))
+        (native-pathname val))))
   (declaim (inline dynamic-space-size))
   (defun dynamic-space-size ()
     "Size of the dynamic space in bytes."

diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp
index 1c3d9f9..e015ad8 100644 (file)
--- a/tests/gc.impure.lisp
+++ b/tests/gc.impure.lisp
@@ -103,3 +103,15 @@
                        (assert (eql len (* n (length "hi there!"))))))
                  (storage-condition ()
                    :oom))))))
+
+(with-test (:name :gc-logfile)
+  (assert (not (gc-logfile)))
+  (let ((p #p"gc.log"))
+    (assert (not (probe-file p)))
+    (assert (equal p (setf (gc-logfile) p)))
+    (gc)
+    (let ((p2 (gc-logfile)))
+      (assert (equal (truename p2) (truename p))))
+    (assert (not (setf (gc-logfile) nil)))
+    (assert (not (gc-logfile)))
+    (delete-file p)))