1 ;;; ase-tests.el -- Tests for ASE
2 ;; Copyright (C) 2006, 2007 Sebastian Freundt
4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 ;; This file is part of SXEmacs.
9 ;; Redistribution and use in source and binary forms, with or without
10 ;; modification, are permitted provided that the following conditions
13 ;; 1. Redistributions of source code must retain the above copyright
14 ;; notice, this list of conditions and the following disclaimer.
16 ;; 2. Redistributions in binary form must reproduce the above copyright
17 ;; notice, this list of conditions and the following disclaimer in the
18 ;; documentation and/or other materials provided with the distribution.
20 ;; 3. Neither the name of the author nor the names of any contributors
21 ;; may be used to endorse or promote products derived from this
22 ;; software without specific prior written permission.
24 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 ;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 ;;; Synched up with: Not in FSF.
39 ;; - test for conceptionally correct arithmetic
40 ;; See test-harness.el for instructions on how to run these tests.
44 (require 'test-harness)
47 (when (and (boundp 'load-file-name) (stringp load-file-name))
48 (push (file-name-directory load-file-name) load-path))
49 (require 'test-harness))))
52 (and (featurep 'modules)
53 (locate-module "ase-set")
56 (when (featurep 'ase-set)
57 (setq n1 (ase-neighbourhood 0 1))
58 (setq n2 (ase-neighbourhood 2 1))
59 (when (featurep 'bigq)
60 (setq n4 (ase-neighbourhood 0 1/3)))
61 (setq n5 (ase-neighbourhood 0 0.0001))
62 (setq n6 (ase-neighbourhood (ase-cartesian* 0 0) 1))
64 (Assert (ase-neighbourhood-contains-p n1 0))
65 (Assert (ase-neighbourhood-contains-p n1 0.5))
66 (Assert (ase-neighbourhood-contains-p n1 -0.5))
67 (Assert (not (ase-neighbourhood-contains-p n1 1)))
68 (Assert (not (ase-neighbourhood-contains-p n1 -1)))
69 (Assert (ase-neighbourhood-contains-p n1 (// (sqrt 2) 2)))
71 (Assert (ase-neighbourhood-contains-p n2 2))
72 (Assert (ase-neighbourhood-contains-p n2 (sqrt 2)))
73 (Assert (ase-neighbourhood-contains-p n2 (sqrt 3)))
74 (Assert (ase-neighbourhood-contains-p n2 (sqrt 4)))
76 (when (featurep 'bigq)
77 (Assert (ase-neighbourhood-contains-p n4 0))
78 (Assert (ase-neighbourhood-contains-p n4 1/4))
79 (Assert (ase-neighbourhood-contains-p n4 -1/5))
80 (Assert (ase-neighbourhood-contains-p n4 1/6))
81 (Assert (ase-neighbourhood-contains-p n4 -0.1)))
83 (Assert (ase-neighbourhood-contains-p n5 0))
84 (Assert (ase-neighbourhood-contains-p n5 0.00001))
85 (Assert (ase-neighbourhood-contains-p n5 -0.000001))
86 (Assert (ase-neighbourhood-contains-p n5 1e-10))
87 (Assert (ase-neighbourhood-contains-p n5 -1e-20))
88 (Assert (not (ase-neighbourhood-contains-p n5 +infinity)))
90 (Assert (not (ase-neighbourhood-contains-p n1 n2)))
91 (Assert (not (ase-neighbourhood-contains-p n2 n1)))
92 (Assert (ase-neighbourhood-contains-p n1 n1))
93 (Assert (ase-neighbourhood-contains-p n1 n5))
94 (when (featurep 'bigq)
95 (Assert (ase-neighbourhood-contains-p n1 n4))
96 (Assert (ase-neighbourhood-contains-p n4 n4))
97 (Assert (ase-neighbourhood-contains-p n4 n5))
98 (Assert (not (ase-neighbourhood-contains-p n5 n4))))
100 (Assert (ase-neighbourhood-< n1 12))
101 (Assert (not (ase-neighbourhood-< n1 -12)))
102 (Assert (ase-neighbourhood-< -12 n1))
103 (Assert (not (ase-neighbourhood-< 12 n1)))
104 (Assert (ase-neighbourhood-< -1 n1))
105 (Assert (ase-neighbourhood-< n1 1))
106 (Assert (not (ase-neighbourhood-< n1 0)))
107 (Assert (not (ase-neighbourhood-> n1 0)))
109 ;; test the problematic cases
110 ;; you know: (= (- 0.2 0.1) 0.1) => t
111 ;; while: (= (- 0.9 0.8) 0.1) => nil
112 (setq n6 (ase-neighbourhood 0.1 0.0001))
113 (setq n7 (ase-neighbourhood 0.1 1e-14))
114 (Assert (ase-neighbourhood-contains-p n6 (- 0.2 0.1)))
115 (Assert (ase-neighbourhood-contains-p n6 (- 0.9 0.8)))
116 (Assert (ase-neighbourhood-contains-p n6 (- -1.1 -1.2)))
117 (Assert (ase-neighbourhood-contains-p n7 (- 0.2 0.1)))
118 (Assert (ase-neighbourhood-contains-p n7 (- 0.9 0.8)))
119 (Assert (ase-neighbourhood-contains-p n7 (- -1.1 -1.2)))
121 (setq n2 (ase-neighbourhood 2 1))
122 (when (featurep 'bigq)
123 (setq n4 (ase-neighbourhood 0 1/3)))
124 (setq n5 (ase-neighbourhood 0 0.0001))
127 (Assert (= (ase-neighbourhood-lebesgue-measure n1) 2))
128 (Assert (= (ase-neighbourhood-lebesgue-measure n2) 2))
129 (when (featurep 'bigq)
130 (Assert (= (ase-neighbourhood-lebesgue-measure n4) 2/3)))
131 (Assert (= (ase-neighbourhood-lebesgue-measure n5) 0.0002))
132 (Assert (= (ase-neighbourhood-rational-measure n1) 1))
133 (Assert (= (ase-neighbourhood-rational-measure n2) 1))
134 (when (featurep 'bigq)
135 (Assert (= (ase-neighbourhood-rational-measure n4) 1)))
136 (Assert (= (ase-neighbourhood-rational-measure n5) 1))