0.pre7.14.flaky4:
[sbcl.git] / tests / float.pure.lisp
1 ;;;; floating-point-related tests with no side effects
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;; 
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
13
14 (cl:in-package :cl-user)
15
16 (dolist (ifnis (list (cons single-float-positive-infinity
17                            single-float-negative-infinity)
18                      (cons double-float-positive-infinity
19                            double-float-negative-infinity)))
20   (destructuring-bind (+ifni . -ifni) ifnis
21     (assert (= (* +ifni 1) +ifni))
22     (assert (= (* +ifni -0.1) -ifni))
23     (assert (= (+ +ifni -0.1) +ifni))
24     (assert (= (- +ifni -0.1) +ifni))
25     (assert (= (sqrt +ifni) +ifni))
26     (assert (= (* -ifni -14) +ifni))
27     (assert (= (/ -ifni 0.1) -ifni))
28     (assert (= (/ -ifni 100/3) -ifni))
29     (assert (not (= +ifni -ifni)))
30     (assert (= -ifni -ifni))
31     (assert (not (= +ifni 100/3)))
32     (assert (not (= -ifni -1.0 -ifni)))
33     (assert (not (= -ifni -17/02 -ifni)))
34     (assert (< -ifni +ifni))
35     (assert (not (< +ifni 100)))
36     (assert (not (< +ifni 100.0)))
37     (assert (not (< +ifni -ifni)))
38     (assert (< 100 +ifni))
39     (assert (< 100.0 +ifni))
40     (assert (>= 100 -ifni))
41     (assert (not (<= 6/7 (* 3 -ifni))))
42     (assert (not (> +ifni +ifni)))))
43
44 ;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if
45 ;;; stream is not a stream associated with a file.
46 ;;;
47 ;;; (Peter Van Eynde's ansi-test suite caught this, and Eric Marsden
48 ;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.)
49 #+nil ; FIXME: Something in sbcl-0.7.pre15 broke this again.
50 (assert (typep (nth-value 1 (ignore-errors (float-radix "notfloat")))
51                'type-error))