From 2b1d1a8924502ad53f2de1bb0ee88f0e5b27b41c Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 8 Nov 2004 15:27:52 +0000 Subject: [PATCH] 0.8.16.37: fixed #351 * Better error-handling and reporting for malformed LET and LET* forms. --- BUGS | 37 +--------------------- NEWS | 2 ++ src/compiler/ir1-translators.lisp | 61 ++++++++++++++++++++----------------- tests/compiler.pure.lisp | 10 ++++++ version.lisp-expr | 2 +- 5 files changed, 47 insertions(+), 65 deletions(-) diff --git a/BUGS b/BUGS index 0c13efc..2ee474b 100644 --- a/BUGS +++ b/BUGS @@ -1593,40 +1593,5 @@ WORKAROUND: pprinter and only truncated at output? (So that indenting by 1/2 then 3/2 would indent by two spaces, not one?) -350: heap overflow when printing bignums - (reported by Bruno Haible 2004-10-08) - In sbcl-0.8.15.18, - * (DEFPARAMETER *BIG* (ASH 1 1000000)) - *BIG* - * (PRINT *BIG*) - Argh! gc_find_freeish_pages failed (restart_page), nbytes=110152. - It should be straightforward to push the heap overflow threshold - up to much larger bignums; Paul Dietz pointed out it would help to - use a bignum-printing algorithm which bisected the printed number, - rather than stripping off digits one by one, and CSR suggested using - iteration rather than recursion to encourage intermediate results - to be GCed. - 351: suboptimal error handling/reporting when compiling (PUSH (LET ...)) - In sbcl-0.8.15.18, - * (defvar *b*) - *B* - * (defun oops () - (push *b* - (let ((b *b*)) - (aref b 1)))) - causes the compiler to die with a TYPE-ERROR in SB-C::EXTRACT-LET-VARS, - The value #:G4 is not of type LIST. - Since the (LET ...) expression is being misused in PUSH as a - SETFable place, it would be more helpful to fail as in - * (defun oops2 () (setf (let ((b *b*)) (aref b 1)) *b*)) - with compilation errors and warnings like - ; in: LAMBDA NIL - ; ((B *B*)) - ; caught ERROR: - ; illegal function call - and - ; caught WARNING: - ; The function (SETF LET) is undefined, and its name is reserved - ; by ANSI CL so that even if it were defined later, the code - ; doing so would not be portable. + (fixed in 0.8.16.37) diff --git a/NEWS b/NEWS index 245e59f..accc707 100644 --- a/NEWS +++ b/NEWS @@ -16,6 +16,8 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16: * minor incompatible change: SB-C::*COMPILER-ERROR-PRINT-FOO* variables are no longer supported: use SB-EXT:*COMPILER-PRINT-VARIABLE-ALIST* instead. + * fixed bug #351: better error-handlind and reporting for malformed + LET and LET* forms. * fixed bug #350: bignum-printing is now more memory-efficient, allowing printing of very large bignums, eg. (expt 2 10000000). (reported by Bruno Haible) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 7359dc6..6fdb4ac 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -543,23 +543,26 @@ During evaluation of the Forms, bind the Vars to the result of evaluating the Value forms. The variables are bound in parallel after all of the Values are evaluated." - (if (null bindings) - (ir1-translate-locally body start next result) - (multiple-value-bind (forms decls) - (parse-body body :doc-string-allowed nil) - (multiple-value-bind (vars values) (extract-let-vars bindings 'let) - (binding* ((ctran (make-ctran)) - (fun-lvar (make-lvar)) - ((next result) - (processing-decls (decls vars nil next result) - (let ((fun (ir1-convert-lambda-body - forms - vars - :debug-name (debug-namify "LET S" - bindings)))) - (reference-leaf start ctran fun-lvar fun)) - (values next result)))) - (ir1-convert-combination-args fun-lvar ctran next result values)))))) + (cond ((null bindings) + (ir1-translate-locally body start next result)) + ((listp bindings) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil) + (multiple-value-bind (vars values) (extract-let-vars bindings 'let) + (binding* ((ctran (make-ctran)) + (fun-lvar (make-lvar)) + ((next result) + (processing-decls (decls vars nil next result) + (let ((fun (ir1-convert-lambda-body + forms + vars + :debug-name (debug-namify "LET S" + bindings)))) + (reference-leaf start ctran fun-lvar fun)) + (values next result)))) + (ir1-convert-combination-args fun-lvar ctran next result values))))) + (t + (compiler-error "Malformed LET bindings: ~S." bindings)))) (def-ir1-translator let* ((bindings &body body) start next result) @@ -567,17 +570,19 @@ "LET* ({(Var [Value]) | Var}*) Declaration* Form* Similar to LET, but the variables are bound sequentially, allowing each Value form to reference any of the previous Vars." - (multiple-value-bind (forms decls) - (parse-body body :doc-string-allowed nil) - (multiple-value-bind (vars values) (extract-let-vars bindings 'let*) - (processing-decls (decls vars nil start next) - (ir1-convert-aux-bindings start - next - result - forms - vars - values))))) - + (if (listp bindings) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil) + (multiple-value-bind (vars values) (extract-let-vars bindings 'let*) + (processing-decls (decls vars nil start next) + (ir1-convert-aux-bindings start + next + result + forms + vars + values)))) + (compiler-error "Malformed LET* bindings: ~S." bindings))) + ;;; logic shared between IR1 translators for LOCALLY, MACROLET, ;;; and SYMBOL-MACROLET ;;; diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 1f651bf..d36c958 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1638,3 +1638,13 @@ (if (or (eql 0 0) t) 0 (if f10-1 0 0)))) (complex (multiple-value-call #'%f10 (values a c b 0 0)) 0)))) 80043 74953652306 33658947 -63099937105 -27842393))) + +;;; bug #351 -- program-error for malformed LET and LET*, including those +;;; resulting from SETF of LET. +(dolist (fun (list (compile nil '(lambda () (let :bogus-let :oops))) + (compile nil '(lambda () (let* :bogus-let* :oops))) + (compile nil '(lambda (x) (push x (let ((y 0)) y)))))) + (assert (functionp fun)) + (multiple-value-bind (res err) (ignore-errors (funcall fun)) + (assert (not res)) + (assert (typep err 'program-error)))) diff --git a/version.lisp-expr b/version.lisp-expr index c7f4197..54a9c48 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.8.16.36" +"0.8.16.37" -- 1.7.10.4