Handle the `neg' operator in some calc-units functions.
* lisp/calc/calc-units.el (math-units-in-expr-p) (math-single-units-in-expr-p, math-find-compatible-unit-rec) (math-extract-units): Handle the `neg' operator. (Bug#19582) * test/automated/calc-tests.el (calc-tests-equal, calc-tests-simple): New functions. (test-calc-remove-units, test-calc-extract-units) (test-calc-convert-units): New tests.
This commit is contained in:
parent
b577fe28c7
commit
2290000ed6
4 changed files with 77 additions and 4 deletions
|
@ -1,3 +1,9 @@
|
|||
2015-01-15 Wolfgang Jenkner <wjenkner@inode.at>
|
||||
|
||||
* calc/calc-units.el (math-units-in-expr-p)
|
||||
(math-single-units-in-expr-p, math-find-compatible-unit-rec)
|
||||
(math-extract-units): Handle the `neg' operator. (Bug#19582)
|
||||
|
||||
2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/eieio-core.el: Provide support for cl-generic.
|
||||
|
|
|
@ -904,10 +904,12 @@ If COMP or STD is non-nil, put that in the units table instead."
|
|||
(and (consp expr)
|
||||
(if (eq (car expr) 'var)
|
||||
(math-check-unit-name expr)
|
||||
(and (or sub-exprs
|
||||
(memq (car expr) '(* / ^)))
|
||||
(or (math-units-in-expr-p (nth 1 expr) sub-exprs)
|
||||
(math-units-in-expr-p (nth 2 expr) sub-exprs))))))
|
||||
(if (eq (car expr) 'neg)
|
||||
(math-units-in-expr-p (nth 1 expr) sub-exprs)
|
||||
(and (or sub-exprs
|
||||
(memq (car expr) '(* / ^)))
|
||||
(or (math-units-in-expr-p (nth 1 expr) sub-exprs)
|
||||
(math-units-in-expr-p (nth 2 expr) sub-exprs)))))))
|
||||
|
||||
(defun math-only-units-in-expr-p (expr)
|
||||
(and (consp expr)
|
||||
|
@ -924,6 +926,8 @@ If COMP or STD is non-nil, put that in the units table instead."
|
|||
(cond ((math-scalarp expr) nil)
|
||||
((eq (car expr) 'var)
|
||||
(math-check-unit-name expr))
|
||||
((eq (car expr) 'neg)
|
||||
(math-single-units-in-expr-p (nth 1 expr)))
|
||||
((eq (car expr) '*)
|
||||
(let ((u1 (math-single-units-in-expr-p (nth 1 expr)))
|
||||
(u2 (math-single-units-in-expr-p (nth 2 expr))))
|
||||
|
@ -1079,6 +1083,8 @@ If COMP or STD is non-nil, put that in the units table instead."
|
|||
((eq (car-safe expr) '/)
|
||||
(or (math-find-compatible-unit-rec (nth 1 expr) pow)
|
||||
(math-find-compatible-unit-rec (nth 2 expr) (- pow))))
|
||||
((eq (car-safe expr) 'neg)
|
||||
(math-find-compatible-unit-rec (nth 1 expr) pow))
|
||||
((and (eq (car-safe expr) '^)
|
||||
(integerp (nth 2 expr)))
|
||||
(math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr))))
|
||||
|
@ -1497,6 +1503,8 @@ If COMP or STD is non-nil, put that in the units table instead."
|
|||
((memq (car-safe expr) '(* /))
|
||||
(cons (car expr)
|
||||
(mapcar 'math-extract-units (cdr expr))))
|
||||
((eq (car-safe expr) 'neg)
|
||||
(math-extract-units (nth 1 expr)))
|
||||
((eq (car-safe expr) '^)
|
||||
(list '^ (math-extract-units (nth 1 expr)) (nth 2 expr)))
|
||||
((math-check-unit-name expr) expr)
|
||||
|
|
|
@ -1,3 +1,10 @@
|
|||
2015-01-15 Wolfgang Jenkner <wjenkner@inode.at>
|
||||
|
||||
* automated/calc-tests.el (calc-tests-equal, calc-tests-simple):
|
||||
New functions.
|
||||
(test-calc-remove-units, test-calc-extract-units)
|
||||
(test-calc-convert-units): New tests.
|
||||
|
||||
2015-01-15 Wolfgang Jenkner <wjenkner@inode.at>
|
||||
|
||||
* automated/Makefile.in (WRITE_LOG): Use POSIX redirection.
|
||||
|
|
|
@ -27,6 +27,40 @@
|
|||
(require 'cl-lib)
|
||||
(require 'ert)
|
||||
(require 'calc)
|
||||
(require 'calc-ext)
|
||||
(require 'calc-units)
|
||||
|
||||
;; XXX The order in which calc libraries (in particular calc-units)
|
||||
;; are loaded influences whether a calc integer in an expression
|
||||
;; involving units is represented as a lisp integer or a calc float,
|
||||
;; see bug#19582. Until this will be fixed the following function can
|
||||
;; be used to compare such calc expressions.
|
||||
(defun calc-tests-equal (a b)
|
||||
"Like `equal' but allow for different representations of numbers.
|
||||
For example: (calc-tests-equal 10 '(float 1 1)) => t.
|
||||
A and B should be calc expressions."
|
||||
(cond ((math-numberp a)
|
||||
(and (math-numberp b)
|
||||
(math-equal a b)))
|
||||
((atom a)
|
||||
(equal a b))
|
||||
((consp b)
|
||||
;; Can't be dotted or circular.
|
||||
(and (= (length a) (length b))
|
||||
(equal (car a) (car b))
|
||||
(cl-every #'calc-tests-equal (cdr a) (cdr b))))))
|
||||
|
||||
(defun calc-tests-simple (fun string &rest args)
|
||||
"Push STRING on the calc stack, then call FUN and return the new top.
|
||||
The result is a calc (i.e., lisp) expression, not its string representation.
|
||||
Also pop the entire stack afterwards.
|
||||
An existing calc stack is reused, otherwise a new one is created."
|
||||
(calc-eval string 'push)
|
||||
(prog1
|
||||
(ignore-errors
|
||||
(apply fun args)
|
||||
(calc-top-n 1))
|
||||
(calc-pop 0)))
|
||||
|
||||
(ert-deftest test-math-bignum ()
|
||||
;; bug#17556
|
||||
|
@ -34,6 +68,24 @@
|
|||
(should (math-negp n))
|
||||
(should (cl-notany #'cl-minusp (cdr n)))))
|
||||
|
||||
(ert-deftest test-calc-remove-units ()
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m") -1)))
|
||||
|
||||
(ert-deftest test-calc-extract-units ()
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m")
|
||||
'(var m var-m)))
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm")
|
||||
'(* (float 1 -2) (^ (var m var-m) 2)))))
|
||||
|
||||
(ert-deftest test-calc-convert-units ()
|
||||
;; Used to ask for `(The expression is unitless when simplified) Old Units: '.
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" nil "cm")
|
||||
'(* -100 (var cm var-cm))))
|
||||
;; Gave wrong result.
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m"
|
||||
(math-read-expr "1m") "cm")
|
||||
'(* -100 (var cm var-cm)))))
|
||||
|
||||
(provide 'calc-tests)
|
||||
;;; calc-tests.el ends here
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue