view tests/automated/region-tests.el @ 4678:b5e1d4f6b66f

Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp. lisp/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (ceiling*, floor*, round*, truncate*): Implement these in terms of the C functions; mark them as obsolete. (mod*, rem*): Use #'nth-value with the C functions, not #'nth with the CL emulation functions. man/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * lispref/numbers.texi (Bigfloat Basics): Correct this documentation (ignoring for the moment that it breaks off in mid-sentence). tests/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test the new Common Lisp-compatible rounding functions available in C. (generate-rounding-output): Provide a function useful for generating the data for the rounding functions tests. src/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES) (CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM) (MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO) (MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT) (MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER): New macros, used in the implementation of the rounding functions. (ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio) (ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat) (ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg) (floor_two_fixnum, floor_two_bignum, floor_two_ratio) (floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat) (floor_two_float, floor_one_mundane_arg, round_two_fixnum) (round_two_bignum_1, round_two_bignum, round_two_ratio) (round_one_bigfloat_1, round_two_bigfloat, round_one_ratio) (round_one_bigfloat, round_two_float, round_one_float) (round_one_mundane_arg, truncate_two_fixnum) (truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat) (truncate_one_ratio, truncate_one_bigfloat, truncate_two_float) (truncate_one_float, truncate_one_mundane_arg): New functions, used in the implementation of the rounding functions. (Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor) (Ffround, Fftruncate): Revise to fully support Common Lisp conventions. This means: -- All functions have optional DIVISOR arguments -- All functions return multiple values; see #'values -- All functions do their arithmetic with the correct number types according to the contamination rules. -- #'round and #'fround always round towards the even number in ambiguous cases. * doprnt.c (emacs_doprnt_1): * number.c (internal_coerce_number): Call Ftruncate with two arguments, not one. * floatfns.c (Ffloat): Correct this, if NUMBER is a bignum. * lisp.h: Declare Ftruncate as taking two arguments. * number.c: Provide scratch_ratio2, init it appropriately. * number.h: Make scratch_ratio2 available. * number.h (BIGFLOAT_ARITH_RETURN): * number.h (BIGFLOAT_ARITH_RETURN1): Correct these functions.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 11 Aug 2009 17:59:23 +0100
parents 43b4a54fbf66
children 189fb67ca31a
line wrap: on
line source

;; Copyright (C) 2005 Adrian Aichner

;; Author: Adrian Aichner <adrian@xemacs.org>
;; Maintainer: XEmacs Beta List <xemacs-beta@xemacs.org>
;; Created: 2005
;; Keywords: tests

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF.

;;; Commentary:

;;; Test region and zmacs-region functionality
;;; See test-harness.el

(condition-case err
    (require 'test-harness)
  (file-error
   (when (and (boundp 'load-file-name) (stringp load-file-name))
     (push (file-name-directory load-file-name) load-path)
     (require 'test-harness))))

;; Active region testing, verifying functionality of
;; http://list-archive.xemacs.org/xemacs-patches/200502/msg00194.html
;; Message-ID: <zmxwtboa.fsf@smtprelay.t-online.de>
(with-temp-buffer
  ;; Using active regions
  (let ((zmacs-regions t)
        (first-buffer (current-buffer)))
    (Silence-Message
     (insert (buffer-name)))
    (Assert (not (region-exists-p)))
    (Assert (not (region-active-p)))
    (Silence-Message
     (mark-whole-buffer))
    (Assert (region-exists-p))
    (Assert (region-active-p))
    ;; Turn off active regions
    (setq zmacs-regions nil)
    ;; Region still exists
    (Assert (region-exists-p))
    ;; Region is no longer active
    (Assert (not (region-active-p)))
    ;; Turn active regions back on
    (setq zmacs-regions t)
    ;; Region still exists
    (Assert (region-exists-p))
    ;; Region is active again
    (Assert (region-active-p))
    (with-temp-buffer
      (Silence-Message
       (insert (buffer-name)))
      ;; Region exists in first buffer, not this second one
      (Assert (not (region-exists-p)))
      ;; Region not active in this second temp buffer
      (Assert (not (region-active-p)))
      ;; Region still active in first temp buffer
      (Assert (eq (zmacs-region-buffer) first-buffer))
      ;; Activate region in second temp buffer
      (Silence-Message
       (mark-whole-buffer))
      ;; Region exists in second temp buffer
      (Assert (region-exists-p))
      ;; Region active in second temp buffer
      (Assert (region-active-p)))
    ;; Second temp buffer no longer exists
    (Assert (null (zmacs-region-buffer)))))