tests: merge sourceforge reports to reported-bugs
authorDaniel Kochmański <daniel@turtleware.eu>
Tue, 1 Sep 2015 15:19:41 +0000 (17:19 +0200)
committerDaniel Kochmański <daniel@turtleware.eu>
Tue, 1 Sep 2015 15:19:41 +0000 (17:19 +0200)
Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
src/tests/bugs/reported-bugs.lsp [new file with mode: 0644]
src/tests/bugs/sf262--declaim-type-foo-setf-foo.lsp [deleted file]
src/tests/bugs/sf272--style-warning-argument-order.lsp [deleted file]
src/tests/bugs/sf276--write-hash-readably.lsp [deleted file]
src/tests/bugs/sf282--mvb-not-evaled.lsp [deleted file]
src/tests/bugs/sf286.lsp [deleted file]

diff --git a/src/tests/bugs/reported-bugs.lsp b/src/tests/bugs/reported-bugs.lsp
new file mode 100644 (file)
index 0000000..866b1dd
--- /dev/null
@@ -0,0 +1,105 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Daniel Kochmański
+;;;; Created:  Fri Apr 14 11:13:17 CEST 2006
+;;;; Contains: Reported bugs which doesn't belong anywhere
+
+(in-package :cl-test)
+
+\f
+;; sf 282
+(deftest reported-bugs.mvb-not-evaled
+    (assert
+     (eq :ok
+         (block nil
+           (tagbody
+              (return (multiple-value-bind ()
+                          (go :fail) :bad))
+            :fail
+              (return :ok)))))
+  nil)
+
+\f
+;; sf262
+
+(declaim (ftype (function (cons)   t)       foo))
+(declaim (ftype (function (t cons) t) (setf foo)))
+
+(defun foo (cons)
+  (first cons))
+
+(defun (setf foo) (value cons)
+  (setf (first cons) value))
+
+(defvar *c* (cons 'x 'y))
+
+(deftest reported-bugs.declaim-type.1
+    (foo *c*) ;; correctly returns 'x
+  'x)
+
+;; signals an error:
+;; Z is not of type CONS.
+;;   [Condition of type TYPE-ERROR]
+(deftest reported-bugs.declaim-type.2
+    (assert (eq 'z
+                (setf (foo *c*) 'z)))
+  nil)
+
+\f
+;; sf272
+
+(compile nil
+         `(lambda (x)
+            (1+ (the (values integer string)
+                     (funcall x)))))
+
+(deftest reported-bugs.style-warning-argument-order.1
+    (let ((warning nil))
+      (assert
+       (eq :ok
+           (handler-bind
+               ((style-warning
+                 (lambda (c)
+                   (format t "got style-warning: ~s~%" c)
+                   (setf warning c))))
+             (block nil
+               (tagbody
+                  (return (multiple-value-bind () (go :fail) :bad))
+                :fail
+                  (return :ok))))))
+      (assert (not warning)))
+  nil)
+
+\f
+;; sf272
+
+(print 
+  (write-to-string (make-hash-table)
+                   :readably t))
+
+(deftest reported-bugs.write-hash-readable
+    (hash-table-count
+     (read-from-string 
+      (write-to-string (make-hash-table)
+                       :readably t)))
+  0)
+
+\f
+;; sf286
+
+(deftest reported-bugs.find-package.1
+    (assert
+     (let ((string ":cl-user"))
+       (find-package
+        (let ((*package* (find-package :cl)))
+          (read-from-string string)))))
+  nil)
+
+(deftest reported-bugs.find-package.2
+    (assert
+     (let ((string ":cl-user"))
+       (let ((*package* (find-package :cl)))
+         (find-package
+          (read-from-string string)))))
+  nil)
+
+\f
diff --git a/src/tests/bugs/sf262--declaim-type-foo-setf-foo.lsp b/src/tests/bugs/sf262--declaim-type-foo-setf-foo.lsp
deleted file mode 100644 (file)
index 997e74c..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-;; http://sourceforge.net/p/ecls/bugs/262
-
-(declaim (ftype (function (cons)   t)       foo))
-(declaim (ftype (function (t cons) t) (setf foo)))
-
-(defun foo (cons)
-  (first cons))
-
-(defun (setf foo) (value cons)
-  (setf (first cons) value))
-
-(defvar *c* (cons 'x 'y))
-
-(foo *c*) ;; correctly returns 'x
-
-;; signals an error:
-;; Z is not of type CONS.
-;;   [Condition of type TYPE-ERROR]
-(deftest sf262--declaim-type-foo-setf-foo.lsp
-    (assert (eq 'z
-                (setf (foo *c*) 'z)))
-  nil)
diff --git a/src/tests/bugs/sf272--style-warning-argument-order.lsp b/src/tests/bugs/sf272--style-warning-argument-order.lsp
deleted file mode 100644 (file)
index ec14cfa..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-;; https://sourceforge.net/p/ecls/bugs/272
-
-(compile nil
-         `(lambda (x) (1+ (the (values integer string) (funcall x)))))
-
-(deftest sf272--style-warning-argument-order
-    (let ((warning nil))
-      (assert
-       (eq :ok
-           (handler-bind
-               ((style-warning
-                 (lambda (c)
-                   (format t "got style-warning: ~s~%" c)
-                   (setf warning c))))
-             (block nil
-               (tagbody
-                  (return (multiple-value-bind () (go :fail) :bad))
-                :fail
-                  (return :ok))))))
-      (assert (not warning)))
-  nil)
diff --git a/src/tests/bugs/sf276--write-hash-readably.lsp b/src/tests/bugs/sf276--write-hash-readably.lsp
deleted file mode 100644 (file)
index f406dd9..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-; https://sourceforge.net/p/ecls/bugs/276/
-
-
-(print 
-  (write-to-string (make-hash-table)
-                   :readably t))
-
-(deftest sf-276-write-hash-readable
-         (hash-table-count
-         (read-from-string 
-           (write-to-string (make-hash-table)
-                            :readably t)))
-         0)
diff --git a/src/tests/bugs/sf282--mvb-not-evaled.lsp b/src/tests/bugs/sf282--mvb-not-evaled.lsp
deleted file mode 100644 (file)
index cd0bc8e..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-
-;; https://sourceforge.net/p/ecls/bugs/282
-
-(deftest sf282--mvb-not-evaled
-    (assert
-     (eq :ok
-         (block nil
-           (tagbody
-              (return (multiple-value-bind () (go :fail) :bad))
-            :fail
-              (return :ok)))))
-  nil)
diff --git a/src/tests/bugs/sf286.lsp b/src/tests/bugs/sf286.lsp
deleted file mode 100644 (file)
index e5e3c26..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-;; miscompilation - assumed that read-from-string returns a fixnum.
-
-(deftest sf286-a
-    (assert
-     (let ((string ":cl-user"))
-       (find-package
-        (let ((*package* (find-package :cl)))
-          (read-from-string string)))))
-  nil)
-
-(deftest sf286-b
-    (assert
-     (let ((string ":cl-user"))
-       (let ((*package* (find-package :cl)))
-         (find-package
-          (read-from-string string)))))
-  nil)