Mercurial > hg > xemacs-beta

diff tests/automated/lisp-tests.el @ 5769:ffc0c5a66ab1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}(). src/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea@parhasard.net> * bytecode.c (bytecode_arithcompare): * bytecode.c (bytecode_arithop): Call promote_args_lazy () in these two functions, only converting markers to fixnums if absolutely necessary (since that is ON with large, mule buffers). * data.c (BIGNUM_CASE): * data.c (RATIO_CASE): * data.c (BIGFLOAT_CASE): * data.c (ARITHCOMPARE_MANY): Call promote_args_lazy () here too if WITH_NUMBER_TYPES is defined. We're not doing the equivalent with the non-NUMBER_TYPES code, but that's mostly fine, we are doing it in the bytecode. * number.h: * number.h (NUMBER_TYPES): * number.h (promote_args_lazy): Add this, returning LAZY_MARKER_T if both arguments are markers that point to the same buffer. tests/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test arithmetic comparisons with markers, check the type of the returned values for #'min and #'max.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 15 Dec 2013 10:26:31 +0000
parents 165315eae1ab
children 72a9467f93fc
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Sun Dec 15 09:57:28 2013 +0000
+++ b/tests/automated/lisp-tests.el	Sun Dec 15 10:26:31 2013 +0000
@@ -3041,4 +3041,83 @@
                 (macroexpand '(with-second-arguments)))))
    (with-both-arguments (list))))
 
+;; Test arithmetic comparisons of markers and operations on markers. Most
+;; relevant with Mule, but also worth doing on non-Mule.
+(let ((character (if (featurep 'mule) (decode-char 'ucs #x20ac) ?\xff))
+      (translation (make-char-table 'generic))
+      markers fixnums)
+  (macrolet
+      ((Assert-arith-equivalences (markers context)
+	 `(progn
+	   (Assert (apply #'> markers)
+		   ,(concat "checking #'> correct with long arguments list, "
+		     context))
+	   (Assert 0 ,context)
+	   (Assert (apply #'< (reverse markers))
+		   ,(concat "checking #'< correct with long arguments list, "
+			    context))
+	   (map-plist #'(lambda (object1 object2)
+			  (Assert (> object1 object2)
+				  ,(concat 
+				    "checking markers correctly ordered, >, "
+				    context))
+			  (Assert (< object2 object1)
+				  ,(concat
+				    "checking markers correctly ordered, <, "
+				    context)))
+		      markers)
+	   ;; OK, so up to this point there has been no need for byte-char
+	   ;; conversion. The following requires it, though:
+	   (map-plist #'(lambda (object1 object2)
+			  (Assert
+			   (= (max object1 object2) object1)
+			   ,(concat
+			     "checking max correct, two markers, " context))
+			  (Assert
+			   (= (min object1 object2) object2)
+			   ,(concat
+			     "checking min, correct, two markers, " context))
+			  ;; It is probably reasonable to change this design
+			  ;; decision.
+			  (Assert
+			   (fixnump (max object1 object2))
+			   ,(concat
+			     "checking fixnum conversion as documented, max, "
+			     context))
+			  (Assert
+			   (fixnump (min object1 object2))
+			   ,(concat
+			     "checking fixnum conversion as documented, min, "
+			     context)))
+	              markers))))
+    (with-temp-buffer
+      (princ "hello there, in with-temp-buffer\n" (get-buffer "*scratch*"))
+      (loop for ii from 0 to 100
+	do (progn
+	     (insert " " character " " character " " character " "
+			 character "\n")
+	     (insert character)
+	     (push (copy-marker (1- (point)) t) markers)
+	     (insert ?\x20)
+	     (push (copy-marker (1- (point)) t) markers)))
+      (Assert-arith-equivalences markers "with Euro sign")
+      ;; Save the markers as fixnum character positions:
+      (setq fixnums (mapcar #'marker-position markers))
+      ;; Check that the equivalences work with the fixnums, while we
+      ;; have them:
+      (Assert-arith-equivalences fixnums "fixnums, with Euro sign")
+      ;; Now, transform the characters that may be problematic to ASCII,
+      ;; check our equivalences still hold.
+      (put-char-table character ?\x7f translation)
+      (translate-region (point-min) (point-max) translation)
+      ;; Sigh, restore the markers #### shouldn't the insertion and
+      ;; deletion code do this?!
+      (map nil #'set-marker markers fixnums)
+      (Assert-arith-equivalences markers "without Euro sign")
+      ;; Restore the problematic character.
+      (put-char-table ?\x7f character translation)
+      (translate-region (point-min) (point-max) translation)
+      (map nil #'set-marker markers fixnums)
+      (Assert-arith-equivalences markers "with Euro sign restored"))))
+
 ;;; end of lisp-tests.el