Subject: 25.0.50; [PATCH] Calc: glitches with negation of units

From: Wolfgang Jenkner <[email-masked]>
Date: Tue, 13 Jan 2015 15:22:28 +0100

Start Calc (M-x calc).

Try to convert -1m to cm.  Type

'-1m<return>uc

Then Calc asks

`(The expression is unitless when simplified) Old Units:'

This is the first glitch here, but, regardless, answer the question

m<return>

Now, it asks (correctly) for new units, so type

cm<return>

This gives the surprising result `-100 m' on top of the stack.

Now, if you do the same thing with -2 instead of -1, everything works fine.

The reason is that some of the functions in calc-units.el which, in
various ways, test for the presence of units in a given (simplified)
expression forget to handle subexpressions of the form (neg <expr>).

I propose the attached patch, which also contains some modest additions
to test/automated/cl-lib-tests.el.

There's also some math-defsimplify stuff in calc-units.el which fails to
handle the neg operator, but that shouldn't give rise to mathematical
errors and will be done in another patch.

This patch is also needed for (and, in fact, was prompted by) bug#19401.

>From 3b8d9b69374036a353ddfa53733c58da2c799c1a Mon Sep 17 00:00:00 2001
From: Wolfgang Jenkner <[email-masked]>
Date: Thu, 8 Jan 2015 21:13:44 +0100
Subject: [PATCH] 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.
* 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 | 50 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 75 insertions(+), 4 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4985ad1..34136e4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2015-01-08  Wolfgang Jenkner  <[email-masked]>
+
+	* 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.
+
 2015-01-12  Martin Rudalics  <[email-masked]>
 
 	* progmodes/xref.el (xref-marker-stack-empty-p): Add autoload
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 83bb8bf..527338b 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,10 @@
+2015-01-08  Wolfgang Jenkner  <[email-masked]>
+
+	* 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-08  Stefan Monnier  <[email-masked]>
 
 	* automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use
diff --git a/test/automated/calc-tests.el b/test/automated/calc-tests.el
index 331e01e..d134d0a 100644
--- a/test/automated/calc-tests.el
+++ b/test/automated/calc-tests.el
@@ -27,6 +27,38 @@
 (require 'cl-lib)
 (require 'ert)
 (require 'calc)
+(require 'calc-ext)
+(require 'calc-units)
+
+;; XXX Apparently, the representation of numbers is sometimes
+;; influenced by previous results in the same calc stack.  Hence this
+;; function.
+(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 +66,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
 
-- 
2.2.1