tests: merge sourceforge reports to reported-bugs

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
This commit is contained in:
Daniel Kochmański 2015-09-01 17:19:41 +02:00
parent 2609765524
commit 1173538d85
6 changed files with 105 additions and 85 deletions

View file

@ -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)
;; 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)
;; 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)
;; 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)
;; 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)
;; 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)

View file

@ -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)

View file

@ -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)

View file

@ -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)

View file

@ -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)

View file

@ -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)