Changeset 10166


Ignore:
Timestamp:
10/19/05 16:51:43 (16 years ago)
Author:
piso
Message:

Use RT.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/tests/math-tests.lisp

    r10157 r10166  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: math-tests.lisp,v 1.1 2005-10-18 13:34:21 piso Exp $
     4;;; $Id: math-tests.lisp,v 1.2 2005-10-19 16:51:43 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2020;;; Some of these tests are based on tests in the CLISP test suite.
    2121
    22 ;; SET-FLOATING-POINT-MODES, GET-FLOATING-POINT-MODES
    23 #+abcl
    24 (progn
    25   (ext:set-floating-point-modes :traps nil)
    26   (assert (equal (ext:get-floating-point-modes) '(:traps nil)))
    27   (assert (equal (getf (ext:get-floating-point-modes) :traps) nil))
    28   (ext:set-floating-point-modes :traps '(:overflow))
    29   (assert (equal (ext:get-floating-point-modes) '(:traps (:overflow))))
    30   (assert (equal (getf (ext:get-floating-point-modes) :traps) '(:overflow)))
    31   (ext:set-floating-point-modes :traps '(:underflow))
    32   (assert (equal (ext:get-floating-point-modes) '(:traps (:underflow))))
    33   (assert (equal (getf (ext:get-floating-point-modes) :traps) '(:underflow)))
    34   (ext:set-floating-point-modes :traps '(:overflow :underflow))
    35   (assert (equal (ext:get-floating-point-modes) '(:traps (:overflow :underflow))))
    36   (assert (equal (getf (ext:get-floating-point-modes) :traps) '(:overflow :underflow)))
    37   )
    38 #+sbcl
    39 (progn
    40   (sb-int:set-floating-point-modes :traps nil)
    41   (assert (equal (getf (sb-int:get-floating-point-modes) :traps) nil))
    42   (sb-int:set-floating-point-modes :traps '(:overflow))
    43   (assert (equal (getf (sb-int:get-floating-point-modes) :traps) '(:overflow)))
    44   (sb-int:set-floating-point-modes :traps '(:underflow))
    45   (assert (equal (getf (sb-int:get-floating-point-modes) :traps) '(:underflow)))
    46   (sb-int:set-floating-point-modes :traps '(:overflow :underflow))
    47   (assert (null (set-exclusive-or (getf (sb-int:get-floating-point-modes) :traps)
    48                                   '(:overflow :underflow))))
    49   )
    50 
    51 ;; Restore defaults.
    52 #+abcl
    53 (ext:set-floating-point-modes :traps '(:overflow :underflow))
    54 #+sbcl
    55 (sb-int:set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero))
    56 
    57 #-clisp
    58 (progn
    59   (assert (= most-positive-single-float 3.4028235e+38))
    60   (assert (= least-positive-single-float 1.4012985e-45))
    61 
    62   (assert (= (log most-positive-single-float) 88.72284))
    63   (assert (= (log least-positive-single-float) -103.27893))
    64   )
     22(unless (member "RT" *modules* :test #'string=)
     23  (unless (ignore-errors (logical-pathname-translations "ansi-tests"))
     24    (error "~S is not defined as a logical pathname host." "ansi-tests"))
     25  (load "ansi-tests:rt-package.lsp")
     26  (load #+abcl (compile-file-if-needed "ansi-tests:rt.lsp")
     27        ;; Force compilation to avoid fasl name conflict between SBCL and
     28        ;; Allegro.
     29        #-abcl (compile-file "ansi-tests:rt.lsp"))
     30  (provide "RT"))
     31
     32(regression-test:rem-all-tests)
     33
     34(let ((*package* (find-package '#:regression-test)))
     35  (export (find-symbol (string '#:*expected-failures*))))
     36
     37(setf regression-test:*expected-failures* nil)
     38
     39(unless (find-package '#:test)
     40  (defpackage #:test (:use #:cl #:regression-test)))
     41
     42(in-package #:test)
     43
     44#+(or abcl cmu sbcl)
     45(defmacro set-floating-point-modes (&rest args)
     46  `(funcall #+abcl 'ext:set-floating-point-modes
     47            #+cmu  'ext:set-floating-point-modes
     48            #+sbcl 'sb-int:set-floating-point-modes
     49            ,@args))
     50
     51#+(or abcl cmu sbcl)
     52(defmacro get-floating-point-modes ()
     53  #+abcl `(ext:get-floating-point-modes)
     54  #+cmu  `(ext:get-floating-point-modes)
     55  #+sbcl `(sb-int:get-floating-point-modes))
     56
     57#+(or abcl cmu sbcl)
     58(defun restore-default-floating-point-modes ()
     59  #+abcl
     60  (set-floating-point-modes :traps '(:overflow :underflow))
     61  #+(or cmu sbcl)
     62  (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)))
     63
     64#+(or abcl cmu sbcl)
     65(eval-when (:compile-toplevel :load-toplevel :execute)
     66  (restore-default-floating-point-modes))
     67
     68(deftest most-negative-fixnum.1
     69  (= (/ most-negative-fixnum -1) (- most-negative-fixnum))
     70  t)
     71
     72(deftest most-negative-fixnum.2
     73  (= (abs most-negative-fixnum) (- most-negative-fixnum))
     74  t)
     75
     76#+(or abcl cmu sbcl)
     77(deftest floating-point-modes.1
     78  (unwind-protect
     79      (progn
     80        (set-floating-point-modes :traps nil)
     81        (getf (get-floating-point-modes) :traps))
     82    (restore-default-floating-point-modes))
     83  nil)
     84
     85#+(or abcl cmu sbcl)
     86(deftest floating-point-modes.2
     87  (unwind-protect
     88      (progn
     89        (set-floating-point-modes :traps '(:overflow))
     90        (getf (get-floating-point-modes) :traps))
     91    (restore-default-floating-point-modes))
     92   (:overflow))
     93
     94#+(or abcl cmu sbcl)
     95(deftest floating-point-modes.3
     96  (unwind-protect
     97      (progn
     98        (set-floating-point-modes :traps '(:underflow))
     99        (getf (get-floating-point-modes) :traps))
     100    (restore-default-floating-point-modes))
     101  (:underflow))
     102
     103#+(or abcl cmu sbcl)
     104(deftest floating-point-modes.4
     105  (unwind-protect
     106      (progn
     107        (set-floating-point-modes :traps '(:overflow :underflow))
     108        (set-exclusive-or (getf (get-floating-point-modes) :traps)
     109                          '(:overflow :underflow)))
     110    (restore-default-floating-point-modes))
     111  nil)
     112
     113(deftest most-positive-single-float.1
     114  most-positive-single-float
     115  #-lispworks
     116  3.4028235e+38
     117  #+lispworks
     118  1.7976931348623157E308)
     119
     120(deftest most-positive-single-float.2
     121  (log most-positive-single-float)
     122  #-lispworks 88.72284
     123  #+lispworks 709.782712893384)
     124
     125(deftest least-positive-single-float.1
     126  least-positive-single-float
     127  #-(or clisp lispworks) 1.4012985e-45
     128  #+clisp 1.1754944E-38
     129  #+lispworks 4.9406564584124646E-324)
     130
     131(deftest least-positive-single-float.2
     132  (log least-positive-single-float)
     133  #-(or clisp lispworks) -103.27893
     134  #+clisp -87.33655
     135  #+lispworks -744.4400719213812)
    65136
    66137;; SQRT
    67 #+clisp
    68 (assert (eql (sqrt 0) 0))
    69 #-clisp
    70 (assert (= (sqrt 0) 0.0))
    71 #+clisp
    72 (assert (eql (sqrt 1) 1))
    73 #-clisp
    74 (assert (= (sqrt 1) 1.0))
    75 #+clisp
    76 (assert (eql (sqrt 9) 3))
    77 #-clisp
    78 (assert (= (sqrt 9) 3.0))
    79 #+clisp
    80 (assert (eql (sqrt -9) #c(0 3)))
    81 #-clisp
    82 (assert (eql (sqrt -9) #c(0.0 3.0)))
    83 #+clisp
    84 (assert (eql (sqrt #c(-7 24)) #c(3 4)))
    85 #-clisp
    86 (assert (= (sqrt #c(-7 24)) #c(3.0 4.0)))
    87 
    88 (assert (= (sqrt 1d0) 1.0d0))
    89 (assert (= (sqrt -1) #c(0 1)))
    90 (assert (= (sqrt -1d0) #c(0 1.0d0)))
    91 (assert (= (sqrt #c(0.0 0.0)) #c(0.0 0.0)))
    92 (assert (= (sqrt #c(4.0 0.0)) #c(2.0 0.0)))
    93 (assert (= (sqrt #c(-4.0 0.0)) #c(0.0 2.0)))
    94 (assert (= (sqrt #c(-4.4855622e-7 0.0)) #c(0.0 6.697434e-4)))
    95 
    96 #-clisp
    97 (progn
    98   ;; (sqrt -0.0) => -0.0
    99   (assert (minusp (float-sign (sqrt -0.0))))
    100   (assert (minusp (float-sign (sqrt -0.0d0)))))
     138(deftest sqrt.1
     139  (sqrt 0)
     140  #+clisp 0
     141  #-clisp 0.0)
     142
     143(deftest sqrt.2
     144  (sqrt 1)
     145  #+clisp 1
     146  #-clisp 1.0)
     147
     148(deftest sqrt.3
     149  (sqrt 9)
     150  #+clisp 3
     151  #-clisp 3.0)
     152
     153(deftest sqrt.4
     154  (sqrt -9)
     155  #+clisp #c(0 3)
     156  #-clisp #c(0.0 3.0))
     157
     158(deftest sqrt.5
     159  (sqrt #c(-7 24))
     160  #-(or clisp lispworks) #c(3.0 4.0)
     161  #+clisp #c(3 4)
     162  #+lispworks #c(3.0 3.999999999999999))
     163
     164(deftest sqrt.6
     165  (sqrt 1d0)
     166  1.0d0)
     167
     168(deftest sqrt.7
     169  (sqrt -1)
     170  #+(or clisp) #c(0 1)
     171  #+(or abcl allegro cmu lispworks sbcl) #c(0.0 1.0))
     172
     173(deftest sqrt.8
     174  (sqrt -1d0)
     175  #c(0 1.0d0))
     176
     177(deftest sqrt.9
     178  (sqrt #c(0.0 0.0))
     179  #c(0.0 0.0))
     180
     181(deftest sqrt.10
     182  (sqrt #c(4.0 0.0))
     183  #c(2.0 0.0))
     184
     185(deftest sqrt.11
     186  (sqrt #c(-4.0 0.0))
     187  #c(0.0 2.0))
     188
     189(deftest sqrt.12
     190  (sqrt #c(-4.4855622e-7 0.0))
     191  #-lispworks
     192  #c(0.0 6.697434e-4)
     193  #+lispworks
     194  #c(0.0 6.697433986236818e-4))
     195
     196#+(or abcl cmu lispworks sbcl)
     197(deftest sqrt.13
     198  (float-sign (sqrt -0.0))
     199  -1.0)
     200
     201#+(or abcl cmu lispworks sbcl)
     202(deftest sqrt.13
     203  (float-sign (sqrt -0.0d0))
     204  -1.0d0)
    101205
    102206;; EXP
    103 (assert (= (exp #c(0 0)) 1))
    104 (assert (= (exp #c(0 1)) #c(0.5403023 0.84147096)))
    105 #-clisp
    106 (assert (= (exp #c(1 1)) #c(1.4686939 2.2873552)))
    107 #+clisp
    108 (assert (= (exp #c(1 1)) #c(1.468694 2.2873552)))
    109 (assert (= (exp #c(1 1d0)) #c(1.4686939399158851d0 2.2873552871788423d0)))
    110 (assert (= (exp #c(1d0 1d0)) #c(1.4686939399158851d0 2.2873552871788423d0)))
    111 (assert (= (exp #c(0 1d0)) #c(0.5403023058681398d0 0.8414709848078965d0)))
    112 (assert (= (exp 1) 2.7182817))
    113 (assert (= (exp 1f0) 2.7182817))
    114 (assert (= (exp 1d0) 2.718281828459045d0))
     207(deftest exp.1
     208  (exp #c(0 0))
     209  #+(or abcl allegro cmu lispworks sbcl) 1.0
     210  #+clisp 1)
     211
     212(deftest exp.2
     213  (exp #c(0 1))
     214  #-lispworks #c(0.5403023          0.84147096)
     215  #+lispworks #c(0.5403023058681398 0.8414709848078965))
     216
     217(deftest exp.3
     218  (exp #c(1 1))
     219  #+(or abcl cmu sbcl) #c(1.4686939          2.2873552)
     220  #+(or allegro clisp) #c(1.468694           2.2873552)
     221  #+lispworks          #c(1.4686939399158851 2.2873552871788423))
     222
     223(deftest exp.4
     224  (exp #c(1 1d0))
     225  #c(1.4686939399158851d0 2.2873552871788423d0))
     226
     227(deftest exp.5
     228  (exp #c(1d0 1d0))
     229  #c(1.4686939399158851d0 2.2873552871788423d0))
     230
     231(deftest exp.6
     232  (exp #c(0 1d0))
     233  #c(0.5403023058681398d0 0.8414709848078965d0))
     234
     235(deftest exp.7
     236  (exp 1)
     237  #-lispworks 2.7182817
     238  #+lispworks 2.718281828459045)
     239
     240(deftest exp.8
     241  (exp 1f0)
     242  #-lispworks 2.7182817
     243  #+lispworks 2.718281828459045)
     244
     245(deftest exp.9
     246  (exp 1d0)
     247  2.718281828459045d0)
    115248
    116249;; EXPT
    117 (assert (= (expt -5s0 2s0) #c(25s0 0s0)))
    118 (assert (= (expt -5f0 2f0) #c(25f0 0f0)))
    119 (assert (= (expt -5d0 2d0) #c(25d0 0d0)))
    120 (assert (= (expt -5l0 2l0) #c(25l0 0l0)))
    121 (assert (= (expt -5 2) 25))
    122 (assert (= (expt 5s0 3s0) 125s0))
    123 (assert (= (expt 5f0 3f0) 125f0))
    124 (assert (= (expt 5d0 3d0) 125d0))
    125 (assert (= (expt 5l0 3l0) 125l0))
    126 (assert (= (expt 5 3) 125))
    127 (assert (= (expt #c(10 11) 1) #c(10 11)))
    128 (assert (= (expt 0 1/2) 0))
    129 (assert (= (expt 1 1/2) 1))
    130 (assert (= (expt 9 1/2) 3))
    131 #+clisp
    132 (assert (= (expt -9 1/2) #c(0 3)))
    133 #+(or sbcl cmu)
    134 (assert (= (expt -9 1/2) #c(1.8369095e-16 3.0)))
    135 #+abcl
    136 (assert (= (expt -9 1/2) #c(1.8369701e-16 3.0)))
    137 (assert (- (expt -8 1/3) #c(1.0 1.7320508)))
    138 (assert (= (expt #c(-7 24) 1/2) #c(3 4)))
    139 (assert (= (expt 729 1/6) 3))
    140 (assert (= (expt -3 -1) -1/3))
    141 (assert (= (expt #c(3 4) -1) #c(3/25 -4/25)))
    142 #-clisp
    143 (assert (= (expt 14 #c(1.0 1.0)) #c(-12.269101 6.743085)))
    144 #+clisp
    145 (assert (= (expt 14 #c(1.0 1.0)) #c(-12.269099 6.7430854)))
     250(deftest expt.1
     251  (expt -5f0 2)
     252  25.0)
     253
     254(deftest expt.2
     255  (expt -5f0 2f0)
     256  #+(or abcl cmu sbcl) 25f0
     257  #+allegro            #c(25.0               -6.1230318e-15)
     258  #+clisp              #c(25f0               0f0)
     259  #+lispworks          #c(24.999999999999993 -6.123031769111885e-15))
     260
     261(deftest expt.3
     262  (expt -5d0 2d0)
     263  #+(or abcl cmu sbcl) 25d0
     264  #+allegro            #c(24.999999999999996d0 -6.1230317691118855d-15)
     265  #+clisp              #c(25d0                 0d0))
     266
     267(deftest expt.4
     268  (expt -5 2)
     269  25)
     270
     271(deftest expt.5
     272  (eql (expt 5f0 3f0) (* 5.0 5.0 5.0))
     273  t)
     274
     275(deftest expt.6
     276  (expt 5f0 3f0)
     277  125f0)
     278
     279(deftest expt.7
     280  (expt 5d0 3d0)
     281  125d0)
     282
     283(deftest expt.8
     284  (expt 5 3)
     285  125)
     286
     287(deftest expt.9
     288  (expt #c(10 11) 1)
     289  #c(10 11))
     290
     291(deftest expt.10
     292  (expt 0 1/2)
     293  #+(or allegro clisp lispworks) 0
     294  #+(or abcl cmu sbcl) 0.0)
     295
     296(deftest expt.11
     297  (expt 1 1/2)
     298  #+clisp 1
     299  #-clisp 1.0)
     300
     301(deftest expt.12
     302  (expt 9 1/2)
     303  #+clisp 3
     304  #-clisp 3.0)
     305
     306(deftest expt.13
     307  (expt -9 1/2)
     308  #+clisp
     309  #c(0 3)
     310  #+(or allegro sbcl cmu)
     311  #c(1.8369095e-16 3.0)
     312  #+abcl
     313  #c(1.8369701e-16 3.0))
     314
     315(deftest expt.14
     316  (expt -8 1/3)
     317  #c(1.0 1.7320508))
     318
     319(deftest expt.15
     320  (expt #c(-7 24) 1/2)
     321  #+clisp #c(3 4)
     322  #-clisp #c(3.0 4.0))
     323
     324(deftest expt.16
     325  (expt 729 1/6)
     326  #+clisp 3
     327  #-clisp 3.0)
     328
     329(deftest expt.17
     330  (expt -3 -1)
     331  -1/3)
     332
     333(deftest expt.18
     334  (expt #c(3 4) -1)
     335  #c(3/25 -4/25))
     336
     337(deftest expt.19
     338  (expt 14 #c(1.0 1.0))
     339  #-(or clisp allegro)
     340  #c(-12.269101 6.743085)
     341  #+(or clisp allegro)
     342  #c(-12.269099 6.7430854))
     343
     344(deftest log.1
     345  (typep (log 17d0 10) 'double-float)
     346  t)
     347
     348(deftest log.2
     349  (typep (log 17 10d0) 'double-float)
     350  t)
     351
     352(deftest log.3
     353  (log 17 10)
     354  #+abcl                        1.2304488
     355  #+(or allegro clisp cmu sbcl) 1.230449
     356  #+lispworks                   #.(log 17d0 10d0))
     357
     358(deftest log.4
     359  (log 17.0 10.0)
     360  #+(or abcl cmu sbcl)   1.2304488
     361  #+(or allegro clisp) 1.230449
     362  #+lispworks           #.(log 17d0 10d0))
     363
     364(deftest log.5
     365  (log 17d0 10)
     366  #-(or allegro clisp lispworks) 1.2304489042913307d0
     367  #+(or allegro clisp lispworks) #.(log 17d0 10d0))
     368
     369(deftest log.6
     370  (log 17 10d0)
     371  #-(or allegro clisp lispworks) 1.2304489149763256d0
     372  #+(or allegro clisp lispworks) #.(log 17d0 10d0))
     373
     374(deftest log.7
     375  (log 17d0 10d0)
     376  1.2304489213782739d0)
     377
     378(do-tests)
Note: See TracChangeset for help on using the changeset viewer.