mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 23:02:31 -08:00
Code Issues Projects Releases Packages Wiki Activity

tests: merge reported bugs and mixed regressions

Browse source 
Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
This commit is contained in:
Daniel Kochmański 2015-09-01 18:11:55 +02:00
parent 1b39e1fcf5
commit 37bebe172e
2 changed files with 86 additions and 107 deletions
Download patch file Download diff file Expand all files Collapse all files

88
src/tests/bugs/mixed.lsp
View file

@ -1,9 +1,9 @@
;-*- Mode: Lisp -*-
;;;; Contains: Some regression tests for ECL
;;;; Contains: Various regression tests for ECL
(in-package :cl-test)
;;; (EXT:PACKAGE-LOCK) returned the wrong value.
;;; Fixed in 77a267c7e42860affac8eddfcddb8e81fccd44e5
@ -16,3 +16,87 @@
(ext:package-lock "CL-USER" nil)
(ext:package-lock "CL-USER" nil)))
nil t nil)
;; 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)

105
src/tests/bugs/reported-bugs.lsp
View file

@ -1,105 +0,0 @@
;-*- 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)