From 3a345b50628cd700031121ad1b2ac1b7fae7f920 Mon Sep 17 00:00:00 2001 From: Wolfgang Jenkner Date: Thu, 22 Jan 2015 03:25:01 +0100 Subject: [PATCH 1/2] 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. --- lisp/ChangeLog | 7 +++++ lisp/calc/calc-units.el | 16 ++++++++--- test/ChangeLog | 8 ++++++ test/automated/calc-tests.el | 52 ++++++++++++++++++++++++++++++++++++ 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 + + * 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 (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 + + * 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 * 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 From 81fb8ab036d1755038d11a0a1a305a6062cc20a2 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 23 Jan 2015 02:50:15 +0200 Subject: [PATCH 2/2] Backport: Fix package tests when TMPDIR is in HOME Fixes: debbugs:19657 * test/automated/package-test.el (with-package-test): Bind `abbreviated-home-dir' to nil. (package-test-describe-package, package-test-signed): Expect abbreviated directory names. (cherry picked from commit f02406c74a0a91b29073101912a4b80736a69581) --- test/ChangeLog | 8 ++++++++ test/automated/package-test.el | 7 +++---- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/test/ChangeLog b/test/ChangeLog index 3f2d761dadd..ede6bd6476b 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,11 @@ +2015-01-23 Dmitry Gutov + + Fix package tests when TMPDIR is in HOME. (Bug#19657) + * automated/package-test.el (with-package-test): + Bind `abbreviated-home-dir' to nil. + (package-test-describe-package, package-test-signed): + Expect abbreviated directory names. + 2015-01-22 Wolfgang Jenkner * automated/calc-tests.el (calc-tests-equal, calc-tests-simple): diff --git a/test/automated/package-test.el b/test/automated/package-test.el index c550dd03aca..383af842d94 100644 --- a/test/automated/package-test.el +++ b/test/automated/package-test.el @@ -95,6 +95,7 @@ (package-archives `(("gnu" . ,package-test-data-dir))) (old-yes-no-defn (symbol-function 'yes-or-no-p)) (default-directory package-test-file-dir) + abbreviated-home-dir package--initialized package-alist ,@(if update-news @@ -321,8 +322,7 @@ Must called from within a `tar-mode' buffer." (goto-char (point-min)) (should (search-forward "simple-single is an installed package." nil t)) (should (search-forward - (format "Status: Installed in `%s/' (unsigned)." - (expand-file-name "simple-single-1.3" package-user-dir)) + "Status: Installed in `~/simple-single-1.3/' (unsigned)." nil t)) (should (search-forward "Version: 1.3" nil t)) (should (search-forward "Summary: A single-file package with no dependencies" @@ -391,8 +391,7 @@ Must called from within a `tar-mode' buffer." (goto-char (point-min)) (should (search-forward "signed-good is an installed package." nil t)) (should (search-forward - (format "Status: Installed in `%s/'." - (expand-file-name "signed-good-1.0" package-user-dir)) + "Status: Installed in `~/signed-good-1.0/'." nil t)))))) (provide 'package-test)