X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler-1.impure-cload.lisp;h=5b9c106a8140aff4c7cac3771c0305c5162d4c53;hb=36a59e15bbd951e012297be691a8b7b526fcccf6;hp=8f89da44e9983ecc4dc7e79ac5c851b7176e04aa;hpb=4bc9a2b01540f3a7cbf4499b4689b292fe406139;p=sbcl.git diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index 8f89da4..5b9c106 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -7,7 +7,7 @@ ;;;; While most of SBCL is derived from the CMU CL system, the test ;;;; files (like this one) were written from scratch after the fork ;;;; from CMU CL. -;;;; +;;;; ;;;; This software is in the public domain and is provided with ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. @@ -39,7 +39,7 @@ (declaim (ftype (function (real) (values integer single-float)) valuesify)) (defun valuesify (x) (values (round x) - (coerce x 'single-float))) + (coerce x 'single-float))) (defun exercise-valuesify (x) (multiple-value-bind (i f) (valuesify x) (declare (type integer i)) @@ -65,21 +65,25 @@ (0 "GMT" . "GDT") (-2 "MET" . "MET DST")) "*The string representations of the time zones.") +(declaim (optimize (debug 1) (speed 1) (space 1))) + ;;; The old CMU CL Python compiler assumed that it was safe to infer ;;; function types (including return types) from function definitions -;;; and then use them to optimize code later. This is of course bad -;;; when functions are redefined. The problem was fixed in -;;; sbcl-0.6.12.57. +;;; and then use them to optimize code later [and it was almost +;;; right!]. This is of course bad when functions are redefined. The +;;; problem was fixed in sbcl-0.6.12.57. (defun foo (x) - (if (plusp x) - 1.0 - 0)) -(defun bar (x) - (typecase (foo x) - (fixnum :fixnum) - (real :real) - (string :string) - (t :t))) + (if (plusp x) + 1.0 + 0)) +(eval '(locally + (defun bar (x) + (typecase (foo x) + (fixnum :fixnum) + (real :real) + (string :string) + (t :t))) + (compile 'bar))) (assert (eql (bar 11) :real)) (assert (eql (bar -11) :fixnum)) (setf (symbol-function 'foo) #'identity) @@ -108,9 +112,9 @@ (when (consp (aref x 0)) (aref x 0))) (assert (raises-error? - (array-element-type-handling - (make-array 3 :element-type t :initial-element 0)) - type-error)) + (array-element-type-handling + (make-array 3 :element-type t :initial-element 0)) + type-error)) ;;; bug 220: type check inserted after all arguments in MV-CALL caused ;;; failure of stack analysis