From b35d5f4c386c3e573ff752de1c3770da7d8034f6 Mon Sep 17 00:00:00 2001 From: SANO Masatoshi Date: Wed, 3 Oct 2012 22:11:17 +0300 Subject: [PATCH] fix GC-LOGFILE when none has been set ...and the return value from (SETF GC-LOGFILE). --- NEWS | 2 ++ src/code/gc.lisp | 7 ++++--- tests/gc.impure.lisp | 12 ++++++++++++ 3 files changed, 18 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index f1a556d..abc3e81 100644 --- 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 --- 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 --- 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))) -- 1.7.10.4