/[gcl]/gcl/ansi-tests/misc.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/misc.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.55 by pfdietz, Sun Nov 16 15:06:44 2003 UTC revision 1.56 by pfdietz, Mon Nov 17 14:18:39 2003 UTC
# Line 2929  Line 2929 
2929  ;;; sbcl 0.8.5.40  ;;; sbcl 0.8.5.40
2930  ;;; Different results from exprs containing ROUND  ;;; Different results from exprs containing ROUND
2931    
2932  ;;; (deftest misc.182  (deftest misc.182
2933  ;;;   (let* ((form '(labels ((%f14 (f14-1 f14-2)    (let* ((form '(labels ((%f14 (f14-1 f14-2)
2934  ;;;                            (labels ((%f16                                 (labels ((%f16
2935  ;;;                                      (f16-1 f16-2                                           (f16-1 f16-2
2936  ;;;                                             &optional                                                  &optional
2937  ;;;                                             (f16-3 (setq f14-1 (ash f14-1 (min 77 b)))))                                                  (f16-3 (setq f14-1 (ash f14-1 (min 77 b)))))
2938  ;;;                                      (logandc2 c -100)))                                           (logandc2 c -100)))
2939  ;;;                              (return-from %f14 (* 2 (gcd f14-1 (%f16 c f14-1)))))))                                   (return-from %f14 (* 2 (gcd f14-1 (%f16 c f14-1)))))))
2940  ;;;               (round (%f14 c c)                    (round (%f14 c c)
2941  ;;;                      (max 83 (%f14 (multiple-value-call #'%f14 (values 0 2)) 0)))))                           (max 83 (%f14 (multiple-value-call #'%f14 (values 0 2)) 0)))))
2942  ;;;      (fn1 `(lambda (a b c)           (fn1 `(lambda (a b c)
2943  ;;;              (declare (type (integer 5628 8762) a))                   (declare (type (integer 5628 8762) a))
2944  ;;;              (declare (type (integer 778 33310188747) b))                   (declare (type (integer 778 33310188747) b))
2945  ;;;              (declare (type (integer -6699 4554) c))                   (declare (type (integer -6699 4554) c))
2946  ;;;              (declare (optimize (speed 3)))                   (declare (optimize (speed 3)))
2947  ;;;              (declare (optimize (safety 1)))                   (declare (optimize (safety 1)))
2948  ;;;              (declare (optimize (debug 1)))                   (declare (optimize (debug 1)))
2949  ;;;              ,form))                   ,form))
2950  ;;;      (fn2 `(lambda (a b c)           (fn2 `(lambda (a b c)
2951  ;;;              (declare (notinline values max round gcd * logandc2 min ash))                   (declare (notinline values max round gcd * logandc2 min ash))
2952  ;;;              (declare (optimize (safety 3)))                   (declare (optimize (safety 3)))
2953  ;;;              (declare (optimize (speed 0)))                   (declare (optimize (speed 0)))
2954  ;;;              (declare (optimize (debug 0)))                   (declare (optimize (debug 0)))
2955  ;;;              ,form))                   ,form))
2956  ;;;      (vals '(7395 1602862793 -2384))           (vals '(7395 1602862793 -2384))
2957  ;;;      (cfn1 (compile nil fn1))           (cfn1 (compile nil fn1))
2958  ;;;      (cfn2 (compile nil fn2))           (cfn2 (compile nil fn2))
2959  ;;;      (result1 (multiple-value-list (apply cfn1 vals)))           (result1 (multiple-value-list (apply cfn1 vals)))
2960  ;;;      (result2 (multiple-value-list (apply cfn2 vals))))           (result2 (multiple-value-list (apply cfn2 vals))))
2961  ;;;     (if (equal result1 result2)      (if (equal result1 result2)
2962  ;;;     :good          :good
2963  ;;;       (values result1 result2)))        (values result1 result2)))
2964  ;;;   :good)    :good)
2965    
2966  ;;; sbcl 0.8.5.42  ;;; sbcl 0.8.5.42
2967  ;;; failed AVER: "(NOT POPPING)"  ;;; failed AVER: "(NOT POPPING)"
# Line 3067  Line 3067 
3067     0 0 0)     0 0 0)
3068    0)    0)
3069    
3070    ;;; sbcl 0.8.5.42
3071    ;;; Different results
3072    
3073    (deftest misc.186
3074      (let* ((form '(labels ((%f3 (f3-1 f3-2) f3-1))
3075                      (apply #'%f3 b (catch 'ct8 (throw 'ct8 (logeqv (%f3 c 0)))) nil)))
3076             (vars '(b c))
3077             (fn1 `(lambda ,vars
3078                     (declare (type (integer -2 19) b)
3079                              (type (integer -1520 218978) c)
3080                              (optimize (speed 3) (safety 1) (debug 1)))
3081                     ,form))
3082             (fn2 `(lambda ,vars
3083                     (declare (notinline logeqv apply)
3084                              (optimize (safety 3) (speed 0) (debug 0)))
3085                     ,form))
3086             (cf1 (compile nil fn1))
3087             (cf2 (compile nil fn2))
3088             (result1 (multiple-value-list (funcall cf1 2 18886)))
3089             (result2 (multiple-value-list (funcall cf2 2 18886))))
3090        (if (equal result1 result2)
3091            :good
3092          (values result1 result2)))
3093      :good)
3094    
3095    ;;; cmucl (11/2003 snapshot)
3096    ;;; The assertion (NOT (EQ (C::FUNCTIONAL-KIND C::LEAF) :ESCAPE)) failed.
3097    
3098    (deftest misc.187
3099      (apply
3100       (eval '(function
3101               (lambda (a b c)
3102                 (declare (notinline))
3103                 (declare (optimize (safety 3)))
3104                 (declare (optimize (speed 0)))
3105                 (declare (optimize (debug 0)))
3106                 (flet ((%f7 (&optional (f7-1 (catch (quote ct7) 0)) (f7-2 0))
3107                             c))
3108                   (let ((v8
3109                          (flet ((%f14 (f14-1 &optional (f14-2 (%f7 b)))
3110                                       0))
3111                            0)))
3112                     (%f7 b))))))
3113       '(2374299 70496 -6321798384))
3114      -6321798384)
3115    
3116    ;;; ecl bug
3117    ;;; Segmentation violation
3118    
3119        (deftest misc.188
3120      (funcall
3121       (compile
3122        nil
3123        '(lambda (a b c)
3124              (declare (notinline floor min funcall))
3125              (declare (optimize (safety 3) (speed 0) (debug 0)))
3126              (floor (flet ((%f10 (f10-1 f10-2) b)) (%f10 (%f10 0 0) a))
3127                     (min -37
3128                          (labels ((%f6 (f6-1 f6-2 f6-3) b))
3129                            (funcall #'%f6 b b b))))))
3130       7187592 -3970792748407 -14760)
3131      1 0)
3132    
3133    ;;; Wrong number of arguments passed to an anonymous function
3134    (deftest misc.189
3135      (funcall
3136       (compile
3137        nil
3138        '(lambda (a b c)
3139           (declare (optimize (speed 3) (safety 1) (debug 1)))
3140           (let* ((v7 (labels ((%f13 (f13-1 f13-2 f13-3) 0))
3141                        (multiple-value-call #'%f13 (values a a a)))))
3142             (flet ((%f10 nil v7)) (%f10)))))
3143       1733 3000 1314076)
3144      0)

Legend:
Removed from v.1.55  
changed lines
  Added in v.1.56

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26