diff --git a/bug.lsp b/bug.lsp deleted file mode 100644 index 523e9ce3..00000000 --- a/bug.lsp +++ /dev/null @@ -1 +0,0 @@ -sdfsdfsdfsdf diff --git a/tests/bug.lsp b/tests/bug.lsp index 9e4c2836..a09d1163 100644 --- a/tests/bug.lsp +++ b/tests/bug.lsp @@ -1,41 +1,49 @@ - - -(defclass () - ((bar :reader get-bar :writer set-bar :accessor bar :initarg bar :boundp bar-boundp))) - -(defun test1 () - (let ((f (create (class ) 'bar 1))) - (get-bar f) - (set-bar 2 f) - (get-bar f) 2)) - -;; check inheritance -(defclass () ()) - -(defun test2 () - (let ((f (create (class ) 'bar 2))) - (get-bar f) 2)) - +(import "test") + +(defun test-print (int) + (format-integer (standard-output) int 10) + (format-char (standard-output) #\newline)) + +(defgeneric foo1 (a b)) +(defmethod foo1 :before (a b) (test-print 2)) +(defmethod foo1 :before ((a ) (b )) (test-print 1)) +(defmethod foo1 (a b) (test-print 3)) +(defmethod foo1 ((a ) (b )) + (call-next-method) + (test-print 4)) +(defmethod foo1 :after (a b) (test-print 5)) +(defmethod foo1 :after ((a ) (b )) (test-print 6)) +(defmethod foo1 :around (a b) + (call-next-method) + (test-print 7)) +(defmethod foo1 :around ((a ) (b )) + (call-next-method) + (test-print 8) + a) + +(let ((result (foo1 9 10))) + (test-print result)) + + +;; test setf +;; is it specified in ISLisp ? #| -generate following code automaticaly by defclass -(IF (NOT (GENERIC-FUNCTION-P (FUNCTION* GET-BAR))) (DEFGENERIC GET-BAR (x))) -(DEFMETHOD GET-BAR ((x )) - (LET ((y (SLOT-VALUE x (QUOTE BAR)))) - (IF (EISL-DUMMYP y) - (CERROR "undefined" "reader")) y)) - -(IF (NOT (GENERIC-FUNCTION-P (FUNCTION* SET-BAR)))(DEFGENERIC SET-BAR (x (y )))) - -(DEFMETHOD SET-BAR (x (y )) (SETF (SLOT-VALUE y (QUOTE BAR)) x)) - -(IF (NOT (GENERIC-FUNCTION-P (FUNCTION* BAR))) (DEFGENERIC BAR (x))) - -(DEFMETHOD BAR ((x )) (LET ((y (SLOT-VALUE x (QUOTE BAR)))) (IF (EISL-DUMMYP y) (CERROR "undefined" "accessor")) y)) - -(DEFMETHOD BAR ((x )) (QUOTE BAR)) - -(IF (NOT (GENERIC-FUNCTION-P (FUNCTION* BAR-BOUNDP))) (DEFGENERIC BAR-BOUNDP (x))) - -(DEFMETHOD BAR-BOUNDP ((x )) (NOT (EISL-DUMMYP (SLOT-VALUE x (QUOTE BAR))))) - -|# \ No newline at end of file +(defgeneric (setf foo2) (value a)) +(defmethod (setf foo2) (value a) + (test-print a) + (test-print value)) + +(setf (foo2 10) 11) +|# +;; test no next-method error reporting +(defgeneric foo3 (value)) +(defmethod foo3 ((value )) + (call-next-method)) +(block exit + (with-handler + (lambda (condition) + ;; can't portably test anything about condition + ;; since spec doesn't tell what it exactly should be + (return-from exit nil)) + (foo3 1) + (print "FAIL"))) diff --git a/tests/bug3.lsp b/tests/bug3.lsp deleted file mode 100644 index f0e73fe7..00000000 --- a/tests/bug3.lsp +++ /dev/null @@ -1,47 +0,0 @@ -(defun test-print (int) - (format-integer (standard-output) int 10) - (format-char (standard-output) #\newline)) - -(defgeneric foo1 (a b)) -(defmethod foo1 :before (a b) (test-print 2)) -(defmethod foo1 :before ((a ) (b )) (test-print 1)) -(defmethod foo1 (a b) (test-print 3)) -(defmethod foo1 ((a ) (b )) - (call-next-method) - (test-print 4)) -(defmethod foo1 :after (a b) (test-print 5)) -(defmethod foo1 :after ((a ) (b )) (test-print 6)) -(defmethod foo1 :around (a b) - (call-next-method) - (test-print 7)) -(defmethod foo1 :around ((a ) (b )) - (call-next-method) - (test-print 8) - a) - -(let ((result (foo1 9 10))) - (test-print result)) - - -;; test setf -;; is it specified in ISLisp ? -#| -(defgeneric (setf foo2) (value a)) -(defmethod (setf foo2) (value a) - (test-print a) - (test-print value)) - -(setf (foo2 10) 11) -|# -;; test no next-method error reporting -(defgeneric foo3 (value)) -(defmethod foo3 ((value )) - (call-next-method)) -(block exit - (with-handler - (lambda (condition) - ;; can't portably test anything about condition - ;; since spec doesn't tell what it exactly should be - (return-from exit nil)) - (foo3 1) - (print "FAIL"))) diff --git a/verify/arvyy.lsp b/verify/arvyy.lsp index 8ffad5ad..66a6760c 100644 --- a/verify/arvyy.lsp +++ b/verify/arvyy.lsp @@ -63,4 +63,19 @@ ($test (read-line stream) "de") ($test (read-line stream nil) nil))) -($assert `#(1 ,@(progn '(2 3))) (vector 1 2 3)) \ No newline at end of file +($assert `#(1 ,@(progn '(2 3))) (vector 1 2 3)) + +(defun test-print (str) + (format-object (standard-output) str nil) + (format-char (standard-output) #\newline)) + +#| +(block exit + (with-handler + (lambda (c) + (test-print "OK3.1") + (continue-condition c "OK3.2") + (test-print "FAIL3")) + (let ((v (signal-condition (create (class ) 'format-string "message") t))) + (test-print v)))) +|#