cgit.sxemacs.org Git - sxemacs/blob - tests/automated/ase-neighbourhood-tests.el

   1 ;;;  ase-tests.el -- Tests for ASE
   2 ;; Copyright (C) 2006, 2007 Sebastian Freundt
   3 ;;
   4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
   5 ;; Keywords: tests
   6 ;;
   7 ;; This file is part of SXEmacs.
   8 ;;
   9 ;; Redistribution and use in source and binary forms, with or without
  10 ;; modification, are permitted provided that the following conditions
  11 ;; are met:
  12 ;;
  13 ;; 1. Redistributions of source code must retain the above copyright
  14 ;;    notice, this list of conditions and the following disclaimer.
  15 ;;
  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.
  19 ;;
  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.
  23 ;;
  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.
  35 ;;
  36 ;;; Synched up with: Not in FSF.
  37 ;;
  38 ;;; Commentary:
  39 ;; - test for conceptionally correct arithmetic
  40 ;; See test-harness.el for instructions on how to run these tests.
  41
  42 (eval-when-compile
  43   (condition-case nil
  44       (require 'test-harness)
  45     (file-error
  46      (push "." load-path)
  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))))
  50
  51 ;;;###eval-me-first
  52 (and (featurep 'modules)
  53      (locate-module "ase-set")
  54      (require 'ase-set))
  55
  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))
  63
  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)))
  70
  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)))
  75
  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)))
  82
  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)))
  89
  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))))
  99
 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)))
 108
 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)))
 120
 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))
 125
 126   ;; testing measures
 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))
 137
 138   )