;-*- Mode: Lisp -*-
-;;;; Contains: Some regression tests for ECL
+;;;; Contains: Various regression tests for ECL
(in-package :cl-test)
-
+\f
;;; (EXT:PACKAGE-LOCK) returned the wrong value.
;;; Fixed in 77a267c7e42860affac8eddfcddb8e81fccd44e5
(ext:package-lock "CL-USER" nil)
(ext:package-lock "CL-USER" nil)))
nil t nil)
+
+\f
+;; Bugs from sourceforge
+
+(deftest mixed.0002.mvb-not-evaled
+ (assert
+ (eq :ok
+ (block nil
+ (tagbody
+ (return (multiple-value-bind ()
+ (go :fail) :bad))
+ :fail
+ (return :ok)))))
+ nil)
+
+(declaim (ftype (function (cons) t) mixed.0003.foo))
+(declaim (ftype (function (t cons) t) (setf mixed.0003.foo)))
+
+(defun mixed.0003.foo (cons)
+ (first cons))
+
+(defun (setf mixed.0003.foo) (value cons)
+ (setf (first cons) value))
+
+(defvar mixed.0003.*c* (cons 'x 'y))
+
+(deftest mixed.0003.declaim-type.1
+ (mixed.0003.foo mixed.0003.*c*) ;; correctly returns 'x
+ 'x)
+
+;; signals an error:
+;; Z is not of type CONS.
+;; [Condition of type TYPE-ERROR]
+(deftest mixed.0004.declaim-type.2
+ (assert (eq 'z
+ (setf (foo *c*) 'z)))
+ nil)
+
+(compile nil
+ `(lambda (x)
+ (1+ (the (values integer string)
+ (funcall x)))))
+
+(deftest mixed.0005.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)
+
+(deftest mixed.0006.write-hash-readable
+ (hash-table-count
+ (read-from-string
+ (write-to-string (make-hash-table)
+ :readably t)))
+ 0)
+
+(deftest mixed.0007.find-package.1
+ (assert
+ (let ((string ":cl-user"))
+ (find-package
+ (let ((*package* (find-package :cl)))
+ (read-from-string string)))))
+ nil)
+
+(deftest mixed.0008.find-package.2
+ (assert
+ (let ((string ":cl-user"))
+ (let ((*package* (find-package :cl)))
+ (find-package
+ (read-from-string string)))))
+ nil)
+
+\f
+++ /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
Repositories / ecl.git / commitdiff