From a26ebbe68bc916d87ca8f8d52725a08a93b0e7f8 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 29 Feb 2016 22:10:38 -0500 Subject: [PATCH] SB-EVAL: don't use CTYPEP for anything It is conservative, returning 2 values to report uncertainty, and won't call non-foldable SATISFIES predicates. (It's for the compiler.) --- NEWS | 3 +++ src/code/full-eval.lisp | 8 ++++---- tests/eval.impure.lisp | 3 +++ 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index bd2bb7362..df16af430 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,8 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- +changes relative to sbcl-1.3.3: + * bug fix: SB-EVAL does not signal an error for (THE KEYWORD :FOO) + changes in sbcl-1.3.3 relative to sbcl-1.3.2: * enhancement: warn about argument mismatch for functions passed as arguments to other functions (e.g. REDUCE, MAP) at compile-time. diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp index e6433728a..97c1f1915 100644 --- a/src/code/full-eval.lisp +++ b/src/code/full-eval.lisp @@ -933,20 +933,20 @@ (rest (values-type-rest vtype))) ((null vs) (values-list values)) (if rest - (unless (ctypep (car vs) rest) + (unless (%%typep (car vs) rest nil) (error 'type-error :datum (car vs) :expected-type (type-specifier rest))) (error 'type-error :datum vs :expected-type nil)))) (let ((v (car vs)) (type (car ts))) (when vs - (unless (ctypep v type) + (unless (%%typep v type nil) (error 'type-error :datum v :expected-type (type-specifier type))))))) (let ((v (car vs)) (type (car ts))) - (unless (ctypep v type) + (unless (%%typep v type nil) (error 'type-error :datum v :expected-type (type-specifier type)))))) - ((ctypep (car values) vtype) (values-list values)) + ((%%typep (car values) vtype nil) (values-list values)) (t (error 'type-error :datum (car values) :expected-type (type-specifier vtype))))))) (defun eval-unwind-protect (body env) diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp index 476fc63af..17fe7e37a 100644 --- a/tests/eval.impure.lisp +++ b/tests/eval.impure.lisp @@ -308,6 +308,9 @@ (assert-error (eval '(declare (print "foo" *out*)))) (assert (string= (get-output-stream-string *out*) "")))) +(with-test (:name :the-keyword-not-borked) + (assert (the (or integer keyword) :foo))) + ;; If the DEFUN macro produces a style-warning, it needs to perform the ;; effect of defun no matter what. The style-warning comes from an EVAL-WHEN, ;; not as part of the execution-time behavior of %DEFUN because it is neither -- 2.11.4.GIT