X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstep.impure.lisp;h=9b48dc2214b7c044a3a20409cbaf84cc7493a1b2;hb=b2ed34b667665e52609cf431c00179b136be450d;hp=afa328198723e9f4d429f554146b554a07653499;hpb=1a3143cca7d6678c094b6bacc485e8531808ea59;p=sbcl.git diff --git a/tests/step.impure.lisp b/tests/step.impure.lisp index afa3281..9b48dc2 100644 --- a/tests/step.impure.lisp +++ b/tests/step.impure.lisp @@ -14,8 +14,8 @@ (in-package :cl-user) ;; No stepper support on some platforms. -#-(or x86 x86-64 ppc) -(sb-ext:quit :unix-status 104) +#-(or x86 x86-64 ppc sparc mips) +(sb-ext:exit :code 104) (defun fib (x) (declare (optimize debug)) @@ -26,12 +26,14 @@ (defvar *cerror-called* nil) +(define-condition cerror-break (error) ()) + (defun fib-break (x) (declare (optimize debug)) (if (< x 2) (progn (unless *cerror-called* - (cerror "a" "b") + (cerror "a" 'cerror-break) (setf *cerror-called* t)) 1) (+ (fib-break (1- x)) @@ -50,21 +52,35 @@ (defun test-step-into () (let* ((results nil) - (expected '(("(< X 2)" :unknown) - ("(- X 1)" :unknown) - ("(FIB (1- X))" (2)) - ("(< X 2)" :unknown) - ("(- X 1)" :unknown) - ("(FIB (1- X))" (1)) - ("(< X 2)" :unknown) - ("(- X 2)" :unknown) - ("(FIB (- X 2))" (0)) - ("(< X 2)" :unknown) - ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown) - ("(- X 2)" :unknown) - ("(FIB (- X 2))" (1)) - ("(< X 2)" :unknown) - ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown))) + ;; The generic-< VOP on x86oids doesn't emit a full call + (expected + #-(or x86 x86-64) + '(("(< X 2)" :unknown) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (2)) + ("(< X 2)" :unknown) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (1)) + ("(< X 2)" :unknown) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (0)) + ("(< X 2)" :unknown) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (1)) + ("(< X 2)" :unknown) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)) + #+(or x86 x86-64) + '(("(- X 1)" :unknown) + ("(FIB (1- X))" (2)) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (1)) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (0)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (1)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown))) (*stepper-hook* (lambda (condition) (typecase condition (step-form-condition @@ -77,18 +93,31 @@ (defun test-step-next () (let* ((results nil) - (expected '(("(< X 2)" :unknown) - ("(- X 1)" :unknown) - ("(FIB (1- X))" (2)) - ("(< X 2)" :unknown) - ("(- X 1)" :unknown) - ("(FIB (1- X))" (1)) - ("(- X 2)" :unknown) - ("(FIB (- X 2))" (0)) - ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown) - ("(- X 2)" :unknown) - ("(FIB (- X 2))" (1)) - ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown))) + (expected + #-(or x86 x86-64) + '(("(< X 2)" :unknown) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (2)) + ("(< X 2)" :unknown) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (1)) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (0)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (1)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)) + #+(or x86 x86-64) + '(("(- X 1)" :unknown) + ("(FIB (1- X))" (2)) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (1)) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (0)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (1)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown))) (count 0) (*stepper-hook* (lambda (condition) (typecase condition @@ -104,14 +133,24 @@ (defun test-step-out () (let* ((results nil) - (expected '(("(< X 2)" :unknown) - ("(- X 1)" :unknown) - ("(FIB (1- X))" (2)) - ("(< X 2)" :unknown) - ("(- X 2)" :unknown) - ("(FIB (- X 2))" (1)) - ("(< X 2)" :unknown) - ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown))) + (expected + #-(or x86 x86-64) + '(("(< X 2)" :unknown) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (2)) + ("(< X 2)" :unknown) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (1)) + ("(< X 2)" :unknown) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown)) + #+(or x86 x86-64) + '(("(- X 1)" :unknown) + ("(FIB (1- X))" (2)) + ("(- X 1)" :unknown) + ("(FIB (1- X))" (1)) + ("(- X 2)" :unknown) + ("(FIB (- X 2))" (1)) + ("(+ (FIB (1- X)) (FIB (- X 2)))" :unknown))) (count 0) (*stepper-hook* (lambda (condition) (typecase condition @@ -127,14 +166,23 @@ (defun test-step-start-from-break () (let* ((results nil) - (expected '(("(- X 2)" :unknown) - ("(FIB-BREAK (- X 2))" (0)) - ("(< X 2)" :unknown) - ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown) - ("(- X 2)" :unknown) - ("(FIB-BREAK (- X 2))" (1)) - ("(< X 2)" :unknown) - ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown))) + (expected + #-(or x86 x86-64) + '(("(- X 2)" :unknown) + ("(FIB-BREAK (- X 2))" (0)) + ("(< X 2)" :unknown) + ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown) + ("(- X 2)" :unknown) + ("(FIB-BREAK (- X 2))" (1)) + ("(< X 2)" :unknown) + ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown)) + #+(or x86 x86-64) + '(("(- X 2)" :unknown) + ("(FIB-BREAK (- X 2))" (0)) + ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown) + ("(- X 2)" :unknown) + ("(FIB-BREAK (- X 2))" (1)) + ("(+ (FIB-BREAK (1- X)) (FIB-BREAK (- X 2)))" :unknown))) (count 0) (*stepper-hook* (lambda (condition) (typecase condition @@ -144,7 +192,7 @@ results) (invoke-restart 'step-into)))))) (setf *cerror-called* nil) - (handler-bind ((error + (handler-bind ((cerror-break (lambda (c) (sb-impl::enable-stepping) (invoke-restart 'continue)))) @@ -163,7 +211,7 @@ (incf count) (invoke-restart 'step-next))))))) (step (fib 3)) - (assert (= count 6)))) + (assert (= count #-(or x86 x86-64) 6 #+(or x86 x86-64) 5)))) (defun test-step-backtrace () (let* ((*stepper-hook* (lambda (condition)