APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1510071181 0 # Tue Nov 07 16:13:01 2017 +0000 # Node ID a4a1ae4830fadfd483403399af7d04b496b72138 # Parent 3130df547aa49dfcff4e7592d62613045471d3aa Correct some test problems revealed by the buildbot, thank you Raymond Toy. tests/ChangeLog addition: 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/format-tests.el: Create a ratio at runtime, not load time, on a build without ratio support. * automated/format-tests.el (slow-integer-to-string): Fix the classical C cannot-make-most-negative-fixnum-positive bug in this function, since we expect it to run on non-bignum builds too. * automated/format-tests.el: (format "%n" pi) can give either wrong-type-argument (if we have bignum support) or syntax-error (if we don't). Check for both. * automated/lisp-tests.el: Operations on not-a-number (the square route of -1, (expt -1 0.5)) can legitimately fail with either range errors or domain errors. We don't really care which, accept both in Check-Error. * automated/lisp-tests.el (with-digits): We can get a useful result for (parse-integer "100000000" :radix 16) without bignum support on 64-bit builds, correct a check for this. * automated/syntax-tests.el (fboundp): Non-DEBUG_XEMACS builds don't have #'syntax-cache-info available, use Skip-Test-Unless to handle this. diff -r 3130df547aa4 -r a4a1ae4830fa tests/ChangeLog --- a/tests/ChangeLog Tue Nov 07 06:45:00 2017 +0000 +++ b/tests/ChangeLog Tue Nov 07 16:13:01 2017 +0000 ＠＠ -1,3 +1,27 ＠＠ +2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/format-tests.el: + Create a ratio at runtime, not load time, on a build without ratio + support. + * automated/format-tests.el (slow-integer-to-string): + Fix the classical C cannot-make-most-negative-fixnum-positive bug + in this function, since we expect it to run on non-bignum builds + too. + * automated/format-tests.el: + (format "%n" pi) can give either wrong-type-argument (if we have + bignum support) or syntax-error (if we don't). Check for both. + * automated/lisp-tests.el: + Operations on not-a-number (the square route of -1, (expt -1 0.5)) + can legitimately fail with either range errors or domain + errors. We don't really care which, accept both in Check-Error. + * automated/lisp-tests.el (with-digits): + We can get a useful result for (parse-integer "100000000" :radix + 16) without bignum support on 64-bit builds, correct a check for + this. + * automated/syntax-tests.el (fboundp): + Non-DEBUG_XEMACS builds don't have #'syntax-cache-info available, + use Skip-Test-Unless to handle this. + 2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/os-tests.el: diff -r 3130df547aa4 -r a4a1ae4830fa tests/automated/format-tests.el --- a/tests/automated/format-tests.el Tue Nov 07 06:45:00 2017 +0000 +++ b/tests/automated/format-tests.el Tue Nov 07 16:13:01 2017 +0000 ＠＠ -218,7 +218,7 ＠＠ (Check-Error 'syntax-error (format "%c" char-code-limit)) (Check-Error 'syntax-error (format "%c" 'a)) (Check-Error 'syntax-error (format "%c" pi)) ;; Newly fails -(Check-Error 'syntax-error (format "%c" '7/5)) +(if (featurep 'ratio) (Check-Error 'syntax-error (format "%c" (read "7/5")))) (Check-Error 'syntax-error (format "%c" (1+ most-positive-fixnum))) (Check-Error 'syntax-error (format "%.20c" ?a)) ;; Newly fails. (Check-Error 'syntax-error (format "%.*c" 20 ?a)) ;; Newly fails. ＠＠ -227,23 +227,27 ＠＠ (check-type integer integer) (check-type radix (integer 2 16)) (loop with minusp = (if (< integer 0) - (prog1 t (setq integer (- integer)))) + "-" + ;; Operate on the negative integer, to avoid the + ;; classical C most-negative-fixnum bug on + ;; non-bignum builds. + (setq integer (- integer)) + nil) with result = nil until (eql integer 0) - do (setf result (cons (cdr (assoc* (mod integer radix) - '((0 . ?0) (1 . ?1) - (2 . ?2) (3 . ?3) - (4 . ?4) (5 . ?5) - (6 . ?6) (7 . ?7) - (8 . ?8) (9 . ?9) - (10 . ?A) (11 . ?B) - (12 . ?C) (13 . ?D) - (14 . ?E) (14 . ?E) - (15 . ?F) (15 . ?F)))) + do (setf result (cons (cdr (assoc* (% integer radix) + '((0 . ?0) (-1 . ?1) + (-2 . ?2) (-3 . ?3) + (-4 . ?4) (-5 . ?5) + (-6 . ?6) (-7 . ?7) + (-8 . ?8) (-9 . ?9) + (-10 . ?A) (-11 . ?B) + (-12 . ?C) (-13 . ?D) + (-14 . ?E) (-14 . ?E) + (-15 . ?F) (-15 . ?F)))) result) integer (/ integer radix)) - finally return (concatenate 'string (if minusp "-") - result))) + finally return (concatenate 'string minusp result))) (defun* slow-ratio-to-string (ratio &optional (radix 10)) (check-type ratio ratio) ＠＠ -690,7 +694,7 ＠＠ (Check-Error syntax-error (format "%I32d" 1)) ;; This used to crash with bignum builds. -(Check-Error wrong-type-argument (format "%n" pi)) +(Check-Error (wrong-type-argument syntax-error) (format "%n" pi)) (Check-Error args-out-of-range (format (concat "%" (number-to-string most-positive-fixnum) diff -r 3130df547aa4 -r a4a1ae4830fa tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Tue Nov 07 06:45:00 2017 +0000 +++ b/tests/automated/lisp-tests.el Tue Nov 07 16:13:01 2017 +0000 ＠＠ -1564,26 +1564,27 ＠＠ (Check-Error range-error (round negative-infinity)) (Check-Error range-error (round positive-infinity 1)) (Check-Error range-error (round negative-infinity 1)) - (Check-Error range-error (ceiling not-a-number)) - (Check-Error range-error (ceiling not-a-number 1)) - (Check-Error range-error (floor not-a-number)) - (Check-Error range-error (floor not-a-number 1)) - (Check-Error range-error (round not-a-number)) - (Check-Error range-error (round not-a-number 1)) + (Check-Error (range-error domain-error) (ceiling not-a-number)) + (Check-Error (range-error domain-error) (ceiling not-a-number 1)) + (Check-Error (range-error domain-error) (floor not-a-number)) + (Check-Error (range-error domain-error) (floor not-a-number 1)) + (Check-Error (range-error domain-error) (round not-a-number)) + (Check-Error (range-error domain-error) (round not-a-number 1)) (Check-Error range-error (coerce positive-infinity 'fixnum)) (Check-Error range-error (coerce negative-infinity 'fixnum)) - (Check-Error range-error (coerce not-a-number 'fixnum)) + (Check-Error (range-error domain-error) (coerce not-a-number 'fixnum)) (Check-Error range-error (coerce positive-infinity 'integer)) (Check-Error range-error (coerce negative-infinity 'integer)) - (Check-Error range-error (coerce not-a-number 'integer)) + (Check-Error (range-error domain-error) (coerce not-a-number 'integer)) (when (ignore-errors (coerce 1 'ratio)) (Check-Error range-error (coerce positive-infinity 'ratio)) (Check-Error range-error (coerce negative-infinity 'ratio)) - (Check-Error range-error (coerce not-a-number 'ratio))) + (Check-Error (range-error domain-error) (coerce not-a-number 'ratio))) (when (ignore-errors (coerce 1 'bigfloat)) (Check-Error range-error (coerce positive-infinity 'bigfloat)) (Check-Error range-error (coerce negative-infinity 'bigfloat)) - (Check-Error range-error (coerce not-a-number 'bigfloat)))) + (Check-Error (range-error domain-error) + (coerce not-a-number 'bigfloat)))) (labels ((cl-floor (x &optional y) (let ((q (floor x y))) ＠＠ -3732,11 +3733,17 ＠＠ '(nil 0))) (Assert (eql (ignore-errors (parse-integer "100000000" :radix 16)) - (if (featurep 'bignum) (lsh 1 32) nil)) + (if (> (integer-length (1+ most-positive-fixnum)) + 30) + (lsh 1 32) + nil)) "checking an overflow bug has been fixed") (Assert (eql (ignore-errors (parse-integer "-100000000" :radix 16)) - (if (featurep 'bignum) (- (lsh 1 32)) nil)) + (if (> (integer-length (1+ most-positive-fixnum)) + 30) + (- (lsh 1 32)) + nil)) "checking an overflow bug has been fixed, negative int") (Assert (eql (ignore-errors (parse-integer (format "%d4/" most-negative-fixnum) diff -r 3130df547aa4 -r a4a1ae4830fa tests/automated/syntax-tests.el --- a/tests/automated/syntax-tests.el Tue Nov 07 06:45:00 2017 +0000 +++ b/tests/automated/syntax-tests.el Tue Nov 07 16:13:01 2017 +0000 ＠＠ -210,85 +210,89 ＠＠ ;; syntax code, and passes with Alan's suggested patch ca. r5545. ;; #### The results of these tests are empirically determined, and will ;; probably change as the syntax cache is documented and repaired. -(with-temp-buffer - ;; buffer->syntax_cache in just-initialized state. - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "just initialized") - (Assert (= 1 (nth 1 sci)) nil "just initialized") - (Assert (= -1 (nth 2 sci)) nil "just initialized") - (Assert (= -1 (nth 3 sci)) nil "just initialized")) - ;; Alan's example uses ?/ not ?, but ?/ has Ssymbol syntax, which would - ;; mean it is treated the same as the letters by forward-sexp. - (insert ",regexp, {") - ;; Insertion updates markers, but not the cache boundaries. - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after main insert") - (Assert (= 11 (nth 1 sci)) nil "after main insert") - (Assert (= -1 (nth 2 sci)) nil "after main insert") - (Assert (= -1 (nth 3 sci)) nil "after main insert")) - ;; #### Interactively inserting in fundamental mode swaps marker positions! - ;; Why? - (insert "}") - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after brace insert") - (Assert (= 12 (nth 1 sci)) nil "after brace insert") - (Assert (= -1 (nth 2 sci)) nil "after brace insert") - (Assert (= -1 (nth 3 sci)) nil "after brace insert")) - ;; Motion that ignores the cache should not update the cache. - (goto-char (point-min)) - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after movement 0") - (Assert (= 12 (nth 1 sci)) nil "after movement 0") - (Assert (= -1 (nth 2 sci)) nil "after movement 0") - (Assert (= -1 (nth 3 sci)) nil "after movement 0")) - ;; Cache should be updated and global since no syntax-table property. - (forward-sexp 1) - (Assert (= (point) 8) nil "after 1st forward-sexp") - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after 1st forward-sexp") - (Assert (= 12 (nth 1 sci)) nil "after 1st forward-sexp") - (Assert (= 1 (nth 2 sci)) nil "after 1st forward-sexp") - (Assert (= 12 (nth 3 sci)) nil "after 1st forward-sexp")) - ;; Adding the text property should invalidate the cache. - (put-text-property 1 2 'syntax-table '(7)) - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after putting property") - (Assert (= 1 (nth 1 sci)) nil "after putting property") - (Assert (= -1 (nth 2 sci)) nil "after putting property") - (Assert (= -1 (nth 3 sci)) nil "after putting property")) - (put-text-property 8 9 'syntax-table '(7)) - (goto-char (point-min)) - ;; Motion that is stopped by a syntax-table property should impose - ;; that property's region on the cache. - (forward-sexp 1) - (Assert (= (point) 9) nil "after 2d forward-sexp") - (let ((sci (syntax-cache-info))) - (Assert (= 8 (nth 0 sci)) nil "after 2d forward-sexp") - (Assert (= 9 (nth 1 sci)) nil "after 2d forward-sexp") - (Assert (= 8 (nth 2 sci)) nil "after 2d forward-sexp") - (Assert (= 9 (nth 3 sci)) nil "after 2d forward-sexp")) - ;; Narrowing warps point but does not affect the cache. - (narrow-to-region 10 12) - (Assert (= 10 (point)) nil "after narrowing") - (let ((sci (syntax-cache-info))) - (Assert (= 8 (nth 0 sci)) nil "after narrowing") - (Assert (= 9 (nth 1 sci)) nil "after narrowing") - (Assert (= 8 (nth 2 sci)) nil "after narrowing") - (Assert (= 9 (nth 3 sci)) nil "after narrowing")) - ;; Motion that is stopped by buffer's syntax table should capture - ;; the largest region known to not contain a change of syntax-table - ;; property. - (forward-sexp 1) - (let ((sci (syntax-cache-info))) - (Assert (= 10 (nth 0 sci)) nil "after 3d forward-sexp") - (Assert (= 12 (nth 1 sci)) nil "after 3d forward-sexp") - (Assert (= 10 (nth 2 sci)) nil "after 3d forward-sexp") - (Assert (= 12 (nth 3 sci)) nil "after 3d forward-sexp")) - (widen) - (goto-char (point-min)) - ;; Check that we still respect the syntax table properties. - (forward-sexp 1) - (Assert (= 9 (point)) nil "after widening")) +(Skip-Test-Unless + (fboundp 'syntax-cache-info) + "#'syntax-cache-info not available in this build" + "Check the syntax cache for consistency." + (with-temp-buffer + ;; buffer->syntax_cache in just-initialized state. + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "just initialized") + (Assert (= 1 (nth 1 sci)) nil "just initialized") + (Assert (= -1 (nth 2 sci)) nil "just initialized") + (Assert (= -1 (nth 3 sci)) nil "just initialized")) + ;; Alan's example uses ?/ not ?, but ?/ has Ssymbol syntax, which would + ;; mean it is treated the same as the letters by forward-sexp. + (insert ",regexp, {") + ;; Insertion updates markers, but not the cache boundaries. + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after main insert") + (Assert (= 11 (nth 1 sci)) nil "after main insert") + (Assert (= -1 (nth 2 sci)) nil "after main insert") + (Assert (= -1 (nth 3 sci)) nil "after main insert")) + ;; #### Interactively inserting in fundamental mode swaps marker positions! + ;; Why? + (insert "}") + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after brace insert") + (Assert (= 12 (nth 1 sci)) nil "after brace insert") + (Assert (= -1 (nth 2 sci)) nil "after brace insert") + (Assert (= -1 (nth 3 sci)) nil "after brace insert")) + ;; Motion that ignores the cache should not update the cache. + (goto-char (point-min)) + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after movement 0") + (Assert (= 12 (nth 1 sci)) nil "after movement 0") + (Assert (= -1 (nth 2 sci)) nil "after movement 0") + (Assert (= -1 (nth 3 sci)) nil "after movement 0")) + ;; Cache should be updated and global since no syntax-table property. + (forward-sexp 1) + (Assert (= (point) 8) nil "after 1st forward-sexp") + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after 1st forward-sexp") + (Assert (= 12 (nth 1 sci)) nil "after 1st forward-sexp") + (Assert (= 1 (nth 2 sci)) nil "after 1st forward-sexp") + (Assert (= 12 (nth 3 sci)) nil "after 1st forward-sexp")) + ;; Adding the text property should invalidate the cache. + (put-text-property 1 2 'syntax-table '(7)) + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after putting property") + (Assert (= 1 (nth 1 sci)) nil "after putting property") + (Assert (= -1 (nth 2 sci)) nil "after putting property") + (Assert (= -1 (nth 3 sci)) nil "after putting property")) + (put-text-property 8 9 'syntax-table '(7)) + (goto-char (point-min)) + ;; Motion that is stopped by a syntax-table property should impose + ;; that property's region on the cache. + (forward-sexp 1) + (Assert (= (point) 9) nil "after 2d forward-sexp") + (let ((sci (syntax-cache-info))) + (Assert (= 8 (nth 0 sci)) nil "after 2d forward-sexp") + (Assert (= 9 (nth 1 sci)) nil "after 2d forward-sexp") + (Assert (= 8 (nth 2 sci)) nil "after 2d forward-sexp") + (Assert (= 9 (nth 3 sci)) nil "after 2d forward-sexp")) + ;; Narrowing warps point but does not affect the cache. + (narrow-to-region 10 12) + (Assert (= 10 (point)) nil "after narrowing") + (let ((sci (syntax-cache-info))) + (Assert (= 8 (nth 0 sci)) nil "after narrowing") + (Assert (= 9 (nth 1 sci)) nil "after narrowing") + (Assert (= 8 (nth 2 sci)) nil "after narrowing") + (Assert (= 9 (nth 3 sci)) nil "after narrowing")) + ;; Motion that is stopped by buffer's syntax table should capture + ;; the largest region known to not contain a change of syntax-table + ;; property. + (forward-sexp 1) + (let ((sci (syntax-cache-info))) + (Assert (= 10 (nth 0 sci)) nil "after 3d forward-sexp") + (Assert (= 12 (nth 1 sci)) nil "after 3d forward-sexp") + (Assert (= 10 (nth 2 sci)) nil "after 3d forward-sexp") + (Assert (= 12 (nth 3 sci)) nil "after 3d forward-sexp")) + (widen) + (goto-char (point-min)) + ;; Check that we still respect the syntax table properties. + (forward-sexp 1) + (Assert (= 9 (point)) nil "after widening"))) ;; #### Add the recipe in <yxzfymklb6p.fsf(a)gimli.holgi.priv&gt; on xemacs-beta. ;; You also need to do a DELETE or type SPC to get the crash in 21.5.24. -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)