From 5c3b3f6aaea9a52d45f96fe768f26670c97fb469 Mon Sep 17 00:00:00 2001
From: sasagawa888 <ken-s@tkcnf.or.jp>
Date: Sun, 6 Oct 2024 15:11:17 +0900
Subject: [PATCH] Add test cases in arvyy.lsp

---
 bug.lsp          |  1 -
 tests/bug.lsp    | 88 ++++++++++++++++++++++++++----------------------
 tests/bug3.lsp   | 47 --------------------------
 verify/arvyy.lsp | 17 +++++++++-
 4 files changed, 64 insertions(+), 89 deletions(-)
 delete mode 100644 bug.lsp
 delete mode 100644 tests/bug3.lsp

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 <foo> ()
-    ((bar :reader get-bar :writer set-bar :accessor bar :initarg bar :boundp bar-boundp)))
-
-(defun test1 ()
-    (let ((f (create (class <foo>) 'bar 1)))
-        (get-bar f)
-        (set-bar 2 f)
-        (get-bar f) 2))
-
-;; check inheritance
-(defclass <foo2> (<foo>) ())
-
-(defun test2 ()
-    (let ((f (create (class <foo2>) '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 <integer>) (b <integer>)) (test-print 1))
+(defmethod foo1 (a b) (test-print 3))
+(defmethod foo1 ((a <integer>) (b <integer>))
+    (call-next-method)
+    (test-print 4))
+(defmethod foo1 :after (a b) (test-print 5))
+(defmethod foo1 :after ((a <integer>) (b <integer>)) (test-print 6))
+(defmethod foo1 :around (a b)
+    (call-next-method)
+    (test-print 7))
+(defmethod foo1 :around ((a <integer>) (b <integer>))
+    (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 <FOO>)) 
-     (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 <FOO>))))
-
-(DEFMETHOD SET-BAR (x (y <FOO>)) (SETF (SLOT-VALUE y (QUOTE BAR)) x))
-     
-(IF (NOT (GENERIC-FUNCTION-P (FUNCTION* BAR))) (DEFGENERIC BAR (x)))
-
-(DEFMETHOD BAR ((x <FOO>)) (LET ((y (SLOT-VALUE x (QUOTE BAR)))) (IF (EISL-DUMMYP y) (CERROR "undefined" "accessor")) y))
-
-(DEFMETHOD BAR ((x <NULL>)) (QUOTE BAR))
-
-(IF (NOT (GENERIC-FUNCTION-P (FUNCTION* BAR-BOUNDP))) (DEFGENERIC BAR-BOUNDP (x)))
-
-(DEFMETHOD BAR-BOUNDP ((x <FOO>)) (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 <number>))
+    (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 <integer>) (b <integer>)) (test-print 1))
-(defmethod foo1 (a b) (test-print 3))
-(defmethod foo1 ((a <integer>) (b <integer>))
-    (call-next-method)
-    (test-print 4))
-(defmethod foo1 :after (a b) (test-print 5))
-(defmethod foo1 :after ((a <integer>) (b <integer>)) (test-print 6))
-(defmethod foo1 :around (a b)
-    (call-next-method)
-    (test-print 7))
-(defmethod foo1 :around ((a <integer>) (b <integer>))
-    (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 <number>))
-    (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 <simple-error>) 'format-string "message") t)))
+            (test-print v))))
+|#