From: Juho Snellman Date: Tue, 11 Oct 2005 19:45:14 +0000 (+0000) Subject: 0.9.5.41: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=151d241aa79f2346ae18d179255fc6b5a2013229;p=sbcl.git 0.9.5.41: Give a STYLE-WARNING when the return value of a function like NREVERSE isn't used. (Patch by Kevin Reid on sbcl-devel "Patch: warnings on ignored results of destructive functions", 2005-09-27) --- diff --git a/NEWS b/NEWS index 3a73f5b..148efa8 100644 --- a/NEWS +++ b/NEWS @@ -15,7 +15,10 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5: * bug fix: division by zero in sb-sprof when no samples were collected * bug fix: a race when a slow to arrive sigprof signal killed sbcl * bug fix: asdf-install uses CRLF as required by the HTTP spec. - (thanks to Alexander Kjeldaas) + (thanks to Alexander Kjeldaas) + * new feature: ignoring the return values of destructive functions + like NREVERSE signals a compile-time style-warning. + (thanks to Kevin Reid) * threads ** bug fix: threads stacks belonging to dead threads are freed by the next exiting thread, no need to gc to collect thread stacks anymore diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 2641b48..e330137 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -433,7 +433,7 @@ (defknown reverse (sequence) consed-sequence (flushable) :derive-type (sequence-result-nth-arg 1)) -(defknown nreverse (sequence) sequence () +(defknown nreverse (sequence) sequence (important-result) :derive-type #'result-type-first-arg :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) @@ -537,7 +537,7 @@ (:test-not callable) (:start index) (:end sequence-end) (:count sequence-count) (:key callable)) sequence - (flushable call) + (flushable call important-result) :derive-type (sequence-result-nth-arg 2) :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)) @@ -554,7 +554,7 @@ (callable sequence &key (:from-end t) (:start index) (:end sequence-end) (:count sequence-count) (:key callable)) sequence - (flushable call) + (flushable call important-result) :derive-type (sequence-result-nth-arg 2) :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)) @@ -577,7 +577,7 @@ (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t) (:end sequence-end) (:key callable)) sequence - (unsafely-flushable call) + (unsafely-flushable call important-result) :derive-type (sequence-result-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) @@ -630,6 +630,9 @@ (call) :derive-type (sequence-result-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) +(defknown sb!impl::stable-sort-list (list function function) list + (call important-result) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown sb!impl::sort-vector (vector index index function (or function null)) * ; SORT-VECTOR works through side-effect (call) @@ -638,7 +641,7 @@ (defknown merge (type-specifier sequence sequence callable &key (:key callable)) sequence - (call) + (call important-result) :derive-type (creation-result-type-specifier-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 2 3)) @@ -708,7 +711,7 @@ (defknown sb!impl::nconc2 (list t) t () :destroyed-constant-args (remove-non-constants-and-nils #'butlast)) -(defknown nreconc (list t) t () +(defknown nreconc (list t) t (important-result) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown butlast (list &optional unsigned-byte) list (flushable)) (defknown nbutlast (list &optional unsigned-byte) list () @@ -762,7 +765,7 @@ (defknown (nunion nintersection nset-difference nset-exclusive-or) (list list &key (:key callable) (:test callable) (:test-not callable)) list - (foldable flushable call) + (foldable flushable call important-result) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1 2)) (defknown subsetp @@ -877,6 +880,8 @@ :destroyed-constant-args (nth-constant-args 1)) ;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS +;;; Also, an important-result warning could be provided if the array +;;; is known to be not expressly adjustable. (defknown adjust-array (array (or index list) &key (:element-type type-specifier) (:initial-element t) (:initial-contents t) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 7e83244..f2152d3 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -637,6 +637,14 @@ #!+sb-show (defvar *show-transforms-p* nil) +(defun check-important-result (node info) + (when (and (null (node-lvar node)) + (ir1-attributep (fun-info-attributes info) important-result)) + (let ((*compiler-error-context* node)) + (compiler-style-warn + "The return value of ~A should not be discarded." + (lvar-fun-name (basic-combination-fun node)))))) + ;;; Do IR1 optimizations on a COMBINATION node. (declaim (ftype (function (combination) (values)) ir1-optimize-combination)) (defun ir1-optimize-combination (node) @@ -661,6 +669,7 @@ (when arg (setf (lvar-reoptimize arg) nil))) (when info + (check-important-result node info) (let ((fun (fun-info-destroyed-constant-args info))) (when fun (let ((destroyed-constant-args (funcall fun args))) @@ -682,7 +691,7 @@ (dolist (arg args) (when arg (setf (lvar-reoptimize arg) nil))) - + (check-important-result node info) (let ((fun (fun-info-destroyed-constant-args info))) (when fun (let ((destroyed-constant-args (funcall fun args))) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index cbe6892..4c7ff9c 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -61,6 +61,10 @@ ;; in the safe code. If a function MUST signal errors, then it is ;; not unsafely-flushable even if it is movable or foldable. unsafely-flushable + ;; return value is important, and ignoring it is probably a mistake. + ;; Unlike the other attributes, this is used only for style + ;; warnings and has no effect on optimization. + important-result ;; may be moved with impunity. Has no side effects except possibly ;; consing, and is affected only by its arguments. ;; diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index f6a7848..38de3f6 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -194,6 +194,71 @@ (assert (not (eval `(locally (declare (optimize (safety 3))) (ignore-errors (progn ,form t))))))) +;;; feature: we shall complain if functions which are only useful for +;;; their result are called and their result ignored. +(loop for (form expected-des) in + '(((progn (nreverse (list 1 2)) t) + "The return value of NREVERSE should not be discarded.") + ((progn (nreconc (list 1 2) (list 3 4)) t) + "The return value of NRECONC should not be discarded.") + ((locally + (declare (inline sort)) + (sort (list 1 2) #'<) t) + ;; FIXME: it would be nice if this warned on non-inlined sort + ;; but the current simple boolean function attribute + ;; can't express the condition that would be required. + "The return value of STABLE-SORT-LIST should not be discarded.") + ((progn (sort (vector 1 2) #'<) t) + ;; Apparently, SBCL (but not CL) guarantees in-place vector + ;; sort, so no warning. + nil) + ((progn (delete 2 (list 1 2)) t) + "The return value of DELETE should not be discarded.") + ((progn (delete-if #'evenp (list 1 2)) t) + ("The return value of DELETE-IF should not be discarded.")) + ((progn (delete-if #'evenp (vector 1 2)) t) + ("The return value of DELETE-IF should not be discarded.")) + ((progn (delete-if-not #'evenp (list 1 2)) t) + "The return value of DELETE-IF-NOT should not be discarded.") + ((progn (delete-duplicates (list 1 2)) t) + "The return value of DELETE-DUPLICATES should not be discarded.") + ((progn (merge 'list (list 1 3) (list 2 4) #'<) t) + "The return value of MERGE should not be discarded.") + ((progn (nreconc (list 1 3) (list 2 4)) t) + "The return value of NRECONC should not be discarded.") + ((progn (nunion (list 1 3) (list 2 4)) t) + "The return value of NUNION should not be discarded.") + ((progn (nintersection (list 1 3) (list 2 4)) t) + "The return value of NINTERSECTION should not be discarded.") + ((progn (nset-difference (list 1 3) (list 2 4)) t) + "The return value of NSET-DIFFERENCE should not be discarded.") + ((progn (nset-exclusive-or (list 1 3) (list 2 4)) t) + "The return value of NSET-EXCLUSIVE-OR should not be discarded.")) + for expected = (if (listp expected-des) + expected-des + (list expected-des)) + do + (multiple-value-bind (fun warnings-p failure-p) + (handler-bind ((style-warning (lambda (c) + (if expected + (let ((expect-one (pop expected))) + (assert (search expect-one + (with-standard-io-syntax + (let ((*print-right-margin* nil)) + (princ-to-string c)))) + () + "~S should have warned ~S, but instead warned: ~A" + form expect-one c)) + (error "~S shouldn't give a(nother) warning, but did: ~A" form c))))) + (compile nil `(lambda () ,form))) + (declare (ignore warnings-p)) + (assert (functionp fun)) + (assert (null expected) + () + "~S should have warned ~S, but didn't." + form expected) + (assert (not failure-p)))) + ;;; a bug in the MAP deftransform caused non-VECTOR array specifiers ;;; to cause errors in the compiler. Fixed by CSR in 0.7.8.10 (assert (list (compile nil '(lambda (x) (map 'simple-array 'identity x))))) diff --git a/version.lisp-expr b/version.lisp-expr index 9bebbe2..a613852 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.5.40" +"0.9.5.41"