[Emacs-diffs] master 2290000 2/2: Handle the `neg' operator in some calc-units functions.

[Wolfgang Jenkner]

branch: master
commit 2290000ed69b1157739c280f090e5b60112e83fe
Author: Wolfgang Jenkner <address@hidden>
Commit: Wolfgang Jenkner <address@hidden>

    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.
---
 lisp/ChangeLog               |    6 +++++
 lisp/calc/calc-units.el      |   16 +++++++++---
 test/ChangeLog               |    7 +++++
 test/automated/calc-tests.el |   52 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 77 insertions(+), 4 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b7a38af..150f32f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2015-01-15  Wolfgang Jenkner  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/eieio-core.el: Provide support for cl-generic.
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 26a644a..0595086 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 95d3e54..b3a0494 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,12 @@
 2015-01-15  Wolfgang Jenkner  <address@hidden>
 
+       * 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  <address@hidden>
+
        * automated/Makefile.in (WRITE_LOG): Use POSIX redirection.
 
 2015-01-15  Stefan Monnier  <address@hidden>
diff --git a/test/automated/calc-tests.el b/test/automated/calc-tests.el
index 331e01e..d5252ea 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