diff --git a/src/cmp/cmptype-assert.lsp b/src/cmp/cmptype-assert.lsp index 72ba6a1a1..d485d6512 100644 --- a/src/cmp/cmptype-assert.lsp +++ b/src/cmp/cmptype-assert.lsp @@ -101,10 +101,17 @@ (c1checked-value (list (values-type-primary-type type) value))) ((and (policy-evaluate-forms) (constantp value *cmp-env*)) - (unless (typep (ext:constant-form-value value *cmp-env*) type) - (cmpwarn "Failed type assertion for value ~A and type ~A" - value type)) - value) + (if (typep (ext:constant-form-value value *cmp-env*) type) + value + (progn + ;; warn and generate error. + (cmpwarn "Failed type assertion for value ~A and type ~A" + value type) + (c1expr `(error 'simple-type-error + :datum ,value + :expected-type ',type + :format-control "The constant value ~S is not a ~S" + :format-arguments (list ,value ',type)))))) ;; Is the form type contained in the test? ((progn (setf form (c1expr value) diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index f52870568..ffebcf959 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -1182,3 +1182,19 @@ (is-eql 10 (f2 10)) (compile 'f2) (is-eql 10 (f2 10)))) + +;;; Date 2017-06-27 +;;; Reported by Fabrizio Fabbri +;;; Description +;;; +;;; Compiled function drop argument type checkin +;;; on constant. +;;; +;;; Bug https://gitlab.com/embeddable-common-lisp/ecl/issues/353 +(test cmp.0053.check-values-type-on-constant + (handler-case + (funcall (compile nil + '(lambda () (rplaca 'A 1)))) + (simple-type-error () t) + (error () nil) + (:no-error (v) (declare (ignore v)) nil)))