Mercurial > hg > xemacs-beta
comparison tests/automated/lisp-tests.el @ 5769:ffc0c5a66ab1
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 |
comparison
equal
deleted
inserted
replaced
| 5768:3bfcdeb65578 | 5769:ffc0c5a66ab1 |
|---|---|
| 3039 (append form | 3039 (append form |
| 3040 (macroexpand '(with-first-arguments)) | 3040 (macroexpand '(with-first-arguments)) |
| 3041 (macroexpand '(with-second-arguments))))) | 3041 (macroexpand '(with-second-arguments))))) |
| 3042 (with-both-arguments (list)))) | 3042 (with-both-arguments (list)))) |
| 3043 | 3043 |
| 3044 ;; Test arithmetic comparisons of markers and operations on markers. Most | |
| 3045 ;; relevant with Mule, but also worth doing on non-Mule. | |
| 3046 (let ((character (if (featurep 'mule) (decode-char 'ucs #x20ac) ?\xff)) | |
| 3047 (translation (make-char-table 'generic)) | |
| 3048 markers fixnums) | |
| 3049 (macrolet | |
| 3050 ((Assert-arith-equivalences (markers context) | |
| 3051 `(progn | |
| 3052 (Assert (apply #'> markers) | |
| 3053 ,(concat "checking #'> correct with long arguments list, " | |
| 3054 context)) | |
| 3055 (Assert 0 ,context) | |
| 3056 (Assert (apply #'< (reverse markers)) | |
| 3057 ,(concat "checking #'< correct with long arguments list, " | |
| 3058 context)) | |
| 3059 (map-plist #'(lambda (object1 object2) | |
| 3060 (Assert (> object1 object2) | |
| 3061 ,(concat | |
| 3062 "checking markers correctly ordered, >, " | |
| 3063 context)) | |
| 3064 (Assert (< object2 object1) | |
| 3065 ,(concat | |
| 3066 "checking markers correctly ordered, <, " | |
| 3067 context))) | |
| 3068 markers) | |
| 3069 ;; OK, so up to this point there has been no need for byte-char | |
| 3070 ;; conversion. The following requires it, though: | |
| 3071 (map-plist #'(lambda (object1 object2) | |
| 3072 (Assert | |
| 3073 (= (max object1 object2) object1) | |
| 3074 ,(concat | |
| 3075 "checking max correct, two markers, " context)) | |
| 3076 (Assert | |
| 3077 (= (min object1 object2) object2) | |
| 3078 ,(concat | |
| 3079 "checking min, correct, two markers, " context)) | |
| 3080 ;; It is probably reasonable to change this design | |
| 3081 ;; decision. | |
| 3082 (Assert | |
| 3083 (fixnump (max object1 object2)) | |
| 3084 ,(concat | |
| 3085 "checking fixnum conversion as documented, max, " | |
| 3086 context)) | |
| 3087 (Assert | |
| 3088 (fixnump (min object1 object2)) | |
| 3089 ,(concat | |
| 3090 "checking fixnum conversion as documented, min, " | |
| 3091 context))) | |
| 3092 markers)))) | |
| 3093 (with-temp-buffer | |
| 3094 (princ "hello there, in with-temp-buffer\n" (get-buffer "*scratch*")) | |
| 3095 (loop for ii from 0 to 100 | |
| 3096 do (progn | |
| 3097 (insert " " character " " character " " character " " | |
| 3098 character "\n") | |
| 3099 (insert character) | |
| 3100 (push (copy-marker (1- (point)) t) markers) | |
| 3101 (insert ?\x20) | |
| 3102 (push (copy-marker (1- (point)) t) markers))) | |
| 3103 (Assert-arith-equivalences markers "with Euro sign") | |
| 3104 ;; Save the markers as fixnum character positions: | |
| 3105 (setq fixnums (mapcar #'marker-position markers)) | |
| 3106 ;; Check that the equivalences work with the fixnums, while we | |
| 3107 ;; have them: | |
| 3108 (Assert-arith-equivalences fixnums "fixnums, with Euro sign") | |
| 3109 ;; Now, transform the characters that may be problematic to ASCII, | |
| 3110 ;; check our equivalences still hold. | |
| 3111 (put-char-table character ?\x7f translation) | |
| 3112 (translate-region (point-min) (point-max) translation) | |
| 3113 ;; Sigh, restore the markers #### shouldn't the insertion and | |
| 3114 ;; deletion code do this?! | |
| 3115 (map nil #'set-marker markers fixnums) | |
| 3116 (Assert-arith-equivalences markers "without Euro sign") | |
| 3117 ;; Restore the problematic character. | |
| 3118 (put-char-table ?\x7f character translation) | |
| 3119 (translate-region (point-min) (point-max) translation) | |
| 3120 (map nil #'set-marker markers fixnums) | |
| 3121 (Assert-arith-equivalences markers "with Euro sign restored")))) | |
| 3122 | |
| 3044 ;;; end of lisp-tests.el | 3123 ;;; end of lisp-tests.el |