From fe9b90a2508399c517a98d70df9002d90a3f4a46 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sun, 22 Dec 2013 11:09:19 -0800 Subject: [PATCH] Add more tests from trac. --- tests/trac.lisp | 198 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 194 insertions(+), 4 deletions(-) diff --git a/tests/trac.lisp b/tests/trac.lisp index dbe874185..2f9a4ae81 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -56,11 +56,165 @@ (assert-equal " 0.100E+01" (format nil "~11,3,2,0,'*,,'EE" .9999))) +(define-test trac.15 + (:tag :trac) + (assert-true + (funcall (compile nil + (lambda (z tt betain beta) + (declare (double-float z tt betain beta) + (optimize (speed 3) (safety 0))) + (= (* (* (* z tt) betain) beta) z))) + 5.562684646268004d-309 (1+ double-float-epsilon) .5d0 2d0))) + +(define-test trac.24 + (:tag :trac) + (assert-true + (let ((y (expt 2 #c(-0.5d0 0)))) + (and (zerop (imagpart y)) + (<= (abs (- (realpart y) + (sqrt 0.5d0))) + (* 2 double-float-epsilon)))))) + +(define-test trac.25 + (:tag :trac) + (assert-true + (compile nil (lambda () + (declare (optimize (speed 0) (safety 3) (debug 3))) + (loop + (pop *random-stack*) + (return))))) + (assert-true + (compile nil (lambda () + (declare (optimize (safety 3))) + (catch (make-symbol "CMUCL-DEBUG-CATCH-TAG") + (make-string 49)))))) + +(define-test trac.29 + (:tag :trac) + (assert-true + (make-condition (find-class 'error)))) + +(define-test trac.31 + (:tag :trac) + (assert-equal '(:absolute "TMP" "Foo" "bar") + (pathname-directory "/tmp/Foo/BAR/" :case :common))) + +(define-test trac.36 + (:tag :trac) + (let ((path "/tmp/trac.36.bom.txt")) + (flet ((bug (&optional (format :utf16)) + (with-open-file (s path + :direction :output + :if-exists :supersede + :external-format format) + (format s "Hello~%")) + (with-open-file (s path + :direction :input + :external-format format) + (let ((ch (read-char s))) + (values ch (file-position s)))))) + (assert-equal (values #\H 4) + (bug :utf16)) + (assert-equal (values #\H 8) + (bug :utf32))))) + +(define-test trac.43 + (:tag :trac) + (assert-true + (let ((path "/tmp/trac.43.txt")) + (unwind-protect + (progn + (with-open-file (ostream path :direction :output + :external-format :utf-8) + (dotimes (i 1000) + (write-char (code-char #x1234) ostream))) + + (with-open-file (stream path :direction :input + :external-format :utf-8) + (let ((p0 (file-position stream)) + (ch (read-char stream))) + (unread-char ch stream) + (let ((p0* (file-position stream))) + (eql p0* p0))))))))) + (define-test trac.50 (:tag :trac) (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" (princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b"))))) +(define-test trac.58 + (:tag :trac) + (assert-false + (let ((path "/tmp/trac.58.txt") + failures) + (unwind-protect + (progn + (with-open-file (s path :direction :output :external-format :utf-16) + (dotimes (i 300) + (write-char (code-char i) s))) + + (with-open-file (s path :direction :input :external-format :utf-16) + (dotimes (i 300) + (let ((ch (read-char s nil nil))) + (unless (= i (char-code ch)) + (push (list i ch (char-code ch)) faillures))))) + failures) + (delete-file path))))) + +(define-test trac.63 + (:tag :trac) + (assert-eql + 4.999995d11 + (funcall (compile nil + (lambda (x) + (declare (type (and fixnum unsigned-byte) x) + (optimize speed (safety 0))) + (vm::with-cycle-counter + (let ((sum 0d0)) + (declare (double-float sum)) + (dotimes (k x) + (declare (type (and fixnum unsigned-byte) k)) + (incf sum k)) + sum)))) + 1000000))) + +(define-test trac.65 + (:tag :trac) + (assert-false + (let (failures) + (dolist (base '(2 2f0 2d0 2w0 #c(0 1) #c(0f0 1) #c(0d0 1) #c(0w0 1))) + (dolist (power '(2 3 1/2 -2 -3 -1/2 5)) + (dolist (power-type '(rational single-float double-float ext:double-double-float + (complex single-float) (complex double-float) + (complex ext:double-double-float))) + (let* ((pp (coerce power power-type)) + (interp (expt base pp)) + (*compile-print* nil) + (compiled (funcall (compile nil `(lambda (b) + (declare (type ,(type-of base) b)) + (expt b ,pp))) + base))) + (unless (= interp compiled) + (push (list base pp interp compiled) failures)))))) + failures))) + +(define-test trac.67 + (:tag :trac) + (assert-error 'simple-error + (funcall (compile nil + (lambda (s) + (declare (simple-string s)) + (replace s s :start2 100 :end2 105))) + (copy-seq "1234567890")))) + +(define-test trac.69 + (:tag :trac) + (setf (logical-pathname-translations "trac69") + '(("**;*.*.*" "/tmp/**/*.*"))) + (assert-error 'lisp::namestring-parse-error + (let ((*default-pathname-defaults* #p"trac69:")) + (pathname "/tmp/bar.lisp")))) + (defparameter *trac.70* (make-string 40 :initial-element #\A)) (compile 'trac.70-test @@ -68,17 +222,53 @@ (declare (simple-string workspace s)) (replace workspace s :start1 1 :end1 5 :start2 1 :end2 5))) +(define-test trac.71 + (:tag :trac) + (assert-true + (funcall (compile nil + (lambda (x) + (declare (double-float x)) + (expt x 2w0))) + 2d0))) + +(defpackage :cl-haml + (:use :cl)) + +(defparameter *path* cl:*load-pathname*) + +(define-test trac.74 + (:tag :trac) + (assert-true + (let ((path (merge-pathnames "resources/read-insert.lisp" + *path*))) + (compile-file path :external-format :utf8)))) + (define-test trac.76 (:tag :trac) (assert-equal "A1234AAAA" (subseq (trac.70-test *trac.70* "a12345") 0 9))) +(define-test trac.79 + (:tag :trac) + ;; Create a temp file full of latin1 characters. + (assert-equal + '(0 1) + (let ((path "/tmp/trac.70.txt")) + (unwind-protect + (progn + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (dotimes (k 255) + (write-char (code-char k) s))) + (with-open-file (s path :direction :input :external-format :latin1) + (list (file-position s) + (progn + (read-char s) + (file-position s))))) + (delete-file path))))) + (define-test trac.80 (:tag :trac) ;; The following formats should not signal an error. (assert-true (ignore-errors (format nil "~ve" 21 5d-234))) (assert-true (ignore-errors (format nil "~ve" 100 5d-234)))) - - - - \ No newline at end of file -- GitLab