--- /dev/null
+;-*- 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
+++ /dev/null
-;; 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)
+++ /dev/null
-;; 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)
+++ /dev/null
-;; 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)