summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWolfgang Jenkner <wjenkner@inode.at>2015-01-22 03:25:01 +0100
committerWolfgang Jenkner <wjenkner@inode.at>2015-01-22 03:29:23 +0100
commit3a345b50628cd700031121ad1b2ac1b7fae7f920 (patch)
treee630dc512ef5e2ba01f4b2bce049660564aca67a
parent8ee825c35b62768e28fe825163dea90d3ab46022 (diff)
downloademacs-3a345b50628cd700031121ad1b2ac1b7fae7f920.tar.gz
Backport: 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.
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/calc/calc-units.el16
-rw-r--r--test/ChangeLog8
-rw-r--r--test/automated/calc-tests.el52
4 files changed, 79 insertions, 4 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 280f6022007..a2467e6b00f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2015-01-22 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)
+ [Backport]
+
2015-01-21 Daniel Koning <dk@danielkoning.com> (tiny change)
* subr.el (posnp): Correct docstring of `posnp'.
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 26a644a29ba..05950864a52 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -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)
diff --git a/test/ChangeLog b/test/ChangeLog
index c31367c6b1a..3f2d761dadd 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,11 @@
+2015-01-22 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.
+ [Backport]
+
2014-12-30 Michael Albinus <michael.albinus@gmx.de>
* automated/tramp-tests.el (tramp--test-smb-or-windows-nt-p):
diff --git a/test/automated/calc-tests.el b/test/automated/calc-tests.el
index 331e01e4640..d5252ea62a9 100644
--- a/test/automated/calc-tests.el
+++ b/test/automated/calc-tests.el
@@ -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