3 new commits in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/3bfcdeb65578/ Changeset: 3bfcdeb65578 User: kehoea Date: 2013-12-15 10:57:28 Summary: Return a fixnum as documented with marker arg, #'max, #'min 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * data.c (Fmax): * data.c (Fmin): When an argument is a marker or a character, and WITH_NUMBER_TYPES is defined, return a fixnum in these functions as is documented and as the non-NUMBER_TYPES code does. Affected #: 2 files diff -r 4e69b24a23011918b25ad7a1ed3d38f6f22c6704 -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,11 ＠＠ +2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * data.c (Fmax): + * data.c (Fmin): + When an argument is a marker or a character, and WITH_NUMBER_TYPES + is defined, return a fixnum in these functions as is documented + and as the non-NUMBER_TYPES code does. + 2013-09-10 Stephen J. Turnbull <stephen(a)xemacs.org&gt; * font-mgr.c: Fix a bunch of comments and reformat some docstrings. diff -r 4e69b24a23011918b25ad7a1ed3d38f6f22c6704 -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 src/data.c --- a/src/data.c +++ b/src/data.c ＠＠ -1891,7 +1891,6 ＠＠ { #ifdef WITH_NUMBER_TYPES REGISTER int i, maxindex = 0; - Lisp_Object comp1, comp2; while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0]))) args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); ＠＠ -1901,33 +1900,33 ＠＠ args[0] = make_fixnum (marker_position (args[0])); for (i = 1; i < nargs; i++) { - comp1 = args[maxindex]; - comp2 = args[i]; - switch (promote_args (&comp1, &comp2)) + switch (promote_args (args + maxindex, args + i)) { case FIXNUM_T: - if (XREALFIXNUM (comp1) < XREALFIXNUM (comp2)) + if (XREALFIXNUM (args[maxindex]) < XREALFIXNUM (args[i])) maxindex = i; break; #ifdef HAVE_BIGNUM case BIGNUM_T: - if (bignum_lt (XBIGNUM_DATA (comp1), XBIGNUM_DATA (comp2))) + if (bignum_lt (XBIGNUM_DATA (args[maxindex]), + XBIGNUM_DATA (args[i]))) maxindex = i; break; #endif #ifdef HAVE_RATIO case RATIO_T: - if (ratio_lt (XRATIO_DATA (comp1), XRATIO_DATA (comp2))) + if (ratio_lt (XRATIO_DATA (args[maxindex]), XRATIO_DATA (args[i]))) maxindex = i; break; #endif case FLOAT_T: - if (XFLOAT_DATA (comp1) < XFLOAT_DATA (comp2)) + if (XFLOAT_DATA (args[maxindex]) < XFLOAT_DATA (args[i])) maxindex = i; break; #ifdef HAVE_BIGFLOAT case BIGFLOAT_T: - if (bigfloat_lt (XBIGFLOAT_DATA (comp1), XBIGFLOAT_DATA (comp2))) + if (bigfloat_lt (XBIGFLOAT_DATA (args[maxindex]), + XBIGFLOAT_DATA (args[i]))) maxindex = i; break; #endif ＠＠ -1988,7 +1987,6 ＠＠ { #ifdef WITH_NUMBER_TYPES REGISTER int i, minindex = 0; - Lisp_Object comp1, comp2; while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0]))) args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); ＠＠ -1998,33 +1996,34 ＠＠ args[0] = make_fixnum (marker_position (args[0])); for (i = 1; i < nargs; i++) { - comp1 = args[minindex]; - comp2 = args[i]; - switch (promote_args (&comp1, &comp2)) + switch (promote_args (args + minindex, args + i)) { case FIXNUM_T: - if (XREALFIXNUM (comp1) > XREALFIXNUM (comp2)) + if (XREALFIXNUM (args[minindex]) > XREALFIXNUM (args[i])) minindex = i; break; #ifdef HAVE_BIGNUM case BIGNUM_T: - if (bignum_gt (XBIGNUM_DATA (comp1), XBIGNUM_DATA (comp2))) + if (bignum_gt (XBIGNUM_DATA (args[minindex]), + XBIGNUM_DATA (args[i]))) minindex = i; break; #endif #ifdef HAVE_RATIO case RATIO_T: - if (ratio_gt (XRATIO_DATA (comp1), XRATIO_DATA (comp2))) + if (ratio_gt (XRATIO_DATA (args[minindex]), + XRATIO_DATA (args[i]))) minindex = i; break; #endif case FLOAT_T: - if (XFLOAT_DATA (comp1) > XFLOAT_DATA (comp2)) + if (XFLOAT_DATA (args[minindex]) > XFLOAT_DATA (args[i])) minindex = i; break; #ifdef HAVE_BIGFLOAT case BIGFLOAT_T: - if (bigfloat_gt (XBIGFLOAT_DATA (comp1), XBIGFLOAT_DATA (comp2))) + if (bigfloat_gt (XBIGFLOAT_DATA (args[minindex]), + XBIGFLOAT_DATA (args[i]))) minindex = i; break; #endif https://bitbucket.org/xemacs/xemacs/commits/ffc0c5a66ab1/ Changeset: ffc0c5a66ab1 User: kehoea Date: 2013-12-15 11:26:31 Summary: Be lazy converting markers to integers, bytecode_{arithcompare,arithop}(). src/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * automated/lisp-tests.el: Test arithmetic comparisons with markers, check the type of the returned values for #'min and #'max. Affected #: 6 files diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,25 ＠＠ +2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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. + 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * data.c (Fmax): diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/bytecode.c --- a/src/bytecode.c +++ b/src/bytecode.c ＠＠ -287,25 +287,32 ＠＠ bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2) { #ifdef WITH_NUMBER_TYPES - switch (promote_args (&obj1, &obj2)) + switch (promote_args_lazy (&obj1, &obj2)) { - case FIXNUM_T: + case LAZY_FIXNUM_T: { EMACS_INT ival1 = XREALFIXNUM (obj1), ival2 = XREALFIXNUM (obj2); return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; } #ifdef HAVE_BIGNUM - case BIGNUM_T: + case LAZY_BIGNUM_T: return bignum_cmp (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); #endif #ifdef HAVE_RATIO - case RATIO_T: + case LAZY_RATIO_T: return ratio_cmp (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); #endif #ifdef HAVE_BIGFLOAT - case BIGFLOAT_T: + case LAZY_BIGFLOAT_T: return bigfloat_cmp (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); #endif + case LAZY_MARKER_T: + { + Bytebpos ival1 = byte_marker_position (obj1); + Bytebpos ival2 = byte_marker_position (obj2); + return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; + } + default: /* FLOAT_T */ { double dval1 = XFLOAT_DATA (obj1), dval2 = XFLOAT_DATA (obj2); ＠＠ -320,7 +327,19 ＠＠ if (FIXNUMP (obj1)) ival1 = XFIXNUM (obj1); else if (CHARP (obj1)) ival1 = XCHAR (obj1); - else if (MARKERP (obj1)) ival1 = marker_position (obj1); + else if (MARKERP (obj1)) + { + /* Handle markers specially, since #'marker-position can be O(N): */ + if (MARKERP (obj2) + && (XMARKER (obj1)->buffer == XMARKER (obj2)->buffer)) + { + Bytebpos ival1 = byte_marker_position (obj1); + Bytebpos ival2 = byte_marker_position (obj2); + return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; + } + + ival1 = marker_position (obj1); + } else goto arithcompare_float; if (FIXNUMP (obj2)) ival2 = XFIXNUM (obj2); ＠＠ -365,9 +384,29 ＠＠ bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode) { #ifdef WITH_NUMBER_TYPES - switch (promote_args (&obj1, &obj2)) + switch (promote_args_lazy (&obj1, &obj2)) { - case FIXNUM_T: + case LAZY_MARKER_T: + { + switch (opcode) + { + case Bmax: + return make_fixnum (marker_position + ((byte_marker_position (obj1) + < byte_marker_position (obj2)) ? + obj2 : obj1)); + case Bmin: + return make_fixnum (marker_position + ((byte_marker_position (obj1) + > byte_marker_position (obj2)) ? + obj2 : obj1)); + default: + obj1 = make_fixnum (marker_position (obj1)); + obj2 = make_fixnum (marker_position (obj2)); + /* FALLTHROUGH */ + } + } + case LAZY_FIXNUM_T: { EMACS_INT ival1 = XREALFIXNUM (obj1), ival2 = XREALFIXNUM (obj2); switch (opcode) ＠＠ -395,7 +434,7 ＠＠ return make_integer (ival1); } #ifdef HAVE_BIGNUM - case BIGNUM_T: + case LAZY_BIGNUM_T: switch (opcode) { case Bplus: ＠＠ -426,7 +465,7 ＠＠ return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); #endif #ifdef HAVE_RATIO - case RATIO_T: + case LAZY_RATIO_T: switch (opcode) { case Bplus: ＠＠ -453,7 +492,7 ＠＠ return make_ratio_rt (scratch_ratio); #endif #ifdef HAVE_BIGFLOAT - case BIGFLOAT_T: + case LAZY_BIGFLOAT_T: bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (obj1), XBIGFLOAT_GET_PREC (obj2))); switch (opcode) diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/data.c --- a/src/data.c +++ b/src/data.c ＠＠ -899,7 +899,7 ＠＠ #ifdef HAVE_BIGNUM #define BIGNUM_CASE(op) \ - case BIGNUM_T: \ + case LAZY_BIGNUM_T: \ if (!bignum_##op (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))) \ return Qnil; \ break; ＠＠ -909,7 +909,7 ＠＠ #ifdef HAVE_RATIO #define RATIO_CASE(op) \ - case RATIO_T: \ + case LAZY_RATIO_T: \ if (!ratio_##op (XRATIO_DATA (obj1), XRATIO_DATA (obj2))) \ return Qnil; \ break; ＠＠ -919,7 +919,7 ＠＠ #ifdef HAVE_BIGFLOAT #define BIGFLOAT_CASE(op) \ - case BIGFLOAT_T: \ + case LAZY_BIGFLOAT_T: \ if (!bigfloat_##op (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))) \ return Qnil; \ break; ＠＠ -936,24 +936,33 ＠＠ { \ obj1 = args[i - 1]; \ obj2 = args[i]; \ - switch (promote_args (&obj1, &obj2)) \ + switch (promote_args_lazy (&obj1, &obj2)) \ { \ - case FIXNUM_T: \ - if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \ + case LAZY_FIXNUM_T: \ + if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \ return Qnil; \ break; \ BIGNUM_CASE (op) \ RATIO_CASE (op) \ - case FLOAT_T: \ + case LAZY_FLOAT_T: \ if (!(XFLOAT_DATA (obj1) c_op XFLOAT_DATA (obj2))) \ return Qnil; \ break; \ BIGFLOAT_CASE (op) \ + case LAZY_MARKER_T: \ + if (!(byte_marker_position (obj1) c_op \ + byte_marker_position (obj2))) \ + return Qnil; \ + break; \ } \ } \ return Qt; \ } #else /* !WITH_NUMBER_TYPES */ +/* We don't convert markers lazily here, although we could. It's more + important that we do this lazily in bytecode, which is the case; see + bytecode_arithcompare(). + */ #define ARITHCOMPARE_MANY(c_op,op) \ { \ int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \ diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/number.h --- a/src/number.h +++ b/src/number.h ＠＠ -373,11 +373,42 ＠＠ EXFUN (Fcanonicalize_number, 1); -enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T}; +#define NUMBER_TYPES(prefix) prefix##FIXNUM_T, prefix##BIGNUM_T, \ + prefix##RATIO_T, prefix##FLOAT_T, prefix##BIGFLOAT_T + +enum number_type { NUMBER_TYPES() }; +enum lazy_number_type { NUMBER_TYPES(LAZY_), LAZY_MARKER_T }; + +#undef NUMBER_TYPES extern enum number_type get_number_type (Lisp_Object); extern enum number_type promote_args (Lisp_Object *, Lisp_Object *); +/* promote_args() *always* converts a marker argument to a fixnum. + + Unfortunately, for a marker with byte position N, getting the (character) + marker position is O(N). Getting the character position isn't necessary + for bytecode_arithcompare() if two markers being compared are in the same + buffer, comparing the byte position is enough. + + Similarly, min and max don't necessarily need to have their arguments + converted from markers, though we have always promised up to this point + that the result is a fixnum rather than a marker, and that's what we're + continuing to do. */ + +DECLARE_INLINE_HEADER ( +enum lazy_number_type +promote_args_lazy (Lisp_Object *obj1, Lisp_Object *obj2)) +{ + if (MARKERP (*obj1) && MARKERP (*obj2) && + XMARKER (*obj1)->buffer == XMARKER (*obj2)->buffer) + { + return LAZY_MARKER_T; + } + + return (enum lazy_number_type) promote_args (obj1, obj2); +} + #ifdef WITH_NUMBER_TYPES DECLARE_INLINE_HEADER ( int diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,9 ＠＠ +2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Test arithmetic comparisons with markers, check the type of the + returned values for #'min and #'max. + 2013-09-15 Mats Lidell <matsl(a)xemacs.org&gt; * automated/files-tests.el: New file. Test new states in diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el +++ b/tests/automated/lisp-tests.el ＠＠ -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 https://bitbucket.org/xemacs/xemacs/commits/f22989bb7632/ Changeset: f22989bb7632 User: kehoea Date: 2013-12-15 11:38:19 Summary: Check (featurep 'font-mgr) before calling fontconfig functions, tests tests/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/face-tests.el: Only test fontconfig if the font-mgr feature is available, avoid errors when it isn't. Affected #: 2 files diff -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 -r f22989bb76320d7d68b84212f765e77d01567b11 tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,9 ＠＠ +2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/face-tests.el: + Only test fontconfig if the font-mgr feature is available, avoid + errors when it isn't. + 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: diff -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 -r f22989bb76320d7d68b84212f765e77d01567b11 tests/automated/face-tests.el --- a/tests/automated/face-tests.el +++ b/tests/automated/face-tests.el ＠＠ -29,76 +29,74 ＠＠ ;; Test fontconfig -(let* ((test-name-parts - '("Bitstream Vera Sans Mono-16" - "familylang=en" - "style=Roman" - "stylelang=en" - "fullname=Bitstream Vera Sans Mono" - "fullnamelang=en" - "slant=0" - "weight=80" - "width=100" - "pixelsize=21.3174" - "spacing=100" - "foundry=bitstream" - "antialias=True" - "hintstyle=3" - "hinting=True" - "verticallayout=False" - "autohint=False" - "globaladvance=True" - "file=/usr/X11/lib/X11/fonts/TTF/VeraMono.ttf" - "index=0" - "outline=True" - "scalable=True" - "dpi=95.9282" - "rgba=0" - "scale=1" - "minspace=False" - "charset= |>^1!|>^1!P0oWQ |>^1!|>^1!|>^1!!!!%#gfN8.!!B7%ggR6OF3y?4!!K?& !!!)$ 9;*f! !!!.% !!!)$!!!!# !!#0GM>RAd#y#fx !!!W5 !!#3H !!!!& !!#6I<UKaX!!!?+!!!%#!!!!X !!#AL !!!1& !!+u{!!!!) " - "lang=aa|ay|bi|br|ch|co|da|de|en|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gv|ho|ia|id|ie|io|is|it|lb|mg|nb|nds|nl|nn|no|nr|nso|oc|om|pt|rm|sma|smj|so|sq|ss|st|sv|sw|tl|tn|tr|ts|uz|vo|vot|wa|xh|yap|zu|an|crh|fil|ht|jv|kj|ku-tr|kwm|li|ms|ng|pap-an|pap-aw|rn|rw|sc|sg|sn|su|za" - "fontversion=131072" - "fontformat=TrueType" - "embolden=False" - "embeddedbitmap=True" - "decorative=False" - "lcdfilter=1" - "namelang=en" - "prgname=xemacs" - "hash=sha256\\:da4281dc7db17a3dfce64a62ced92875c5895340055ec8ba24a3914eb97b349d" - "postscriptname=BitstreamVeraSansMono-Roman")) - (test-name-degenerate "") - (test-name-trivial (nth 0 test-name-parts)) - (test-name-short - (concat (nth 0 test-name-parts) ":" (nth 26 test-name-parts))) - (test-name-long (mapconcat #'identity - (append (subseq test-name-parts 0 26) - (subseq test-name-parts 27)) - ":")) - (test-name-full (mapconcat #'identity test-name-parts ":")) - ) - (labels ((try (fontname) - (fc-name-unparse (fc-name-parse fontname))) - (try-harder (fontname) - (fc-name-unparse (fc-name-parse-harder fontname)))) - (Assert (string= test-name-degenerate (try test-name-degenerate))) - (Assert (string= test-name-degenerate (try-harder test-name-degenerate))) - (Assert (string= test-name-trivial (try test-name-trivial))) - (Assert (string= test-name-trivial (try-harder test-name-trivial))) - ;; Note when the `try' form fails, the `try-harder' form returns a - ;; shorter name. - (Check-Error 'invalid-argument - (string= test-name-short (try test-name-short))) - (Assert (string= test-name-trivial (try-harder test-name-short))) - (Assert (string= test-name-long (try test-name-long))) - (Assert (string= test-name-long (try-harder test-name-long))) - ;; Note when the `try' form fails, the `try-harder' form returns a - ;; shorter name. - (Check-Error 'invalid-argument - (string= test-name-full (try test-name-full))) - (Assert (string= test-name-long (try-harder test-name-full))) - ) ; labels - ) ; let +(when (featurep 'font-mgr) + (let* ((test-name-parts + '("Bitstream Vera Sans Mono-16" + "familylang=en" + "style=Roman" + "stylelang=en" + "fullname=Bitstream Vera Sans Mono" + "fullnamelang=en" + "slant=0" + "weight=80" + "width=100" + "pixelsize=21.3174" + "spacing=100" + "foundry=bitstream" + "antialias=True" + "hintstyle=3" + "hinting=True" + "verticallayout=False" + "autohint=False" + "globaladvance=True" + "file=/usr/X11/lib/X11/fonts/TTF/VeraMono.ttf" + "index=0" + "outline=True" + "scalable=True" + "dpi=95.9282" + "rgba=0" + "scale=1" + "minspace=False" + "charset= |>^1!|>^1!P0oWQ |>^1!|>^1!|>^1!!!!%#gfN8.!!B7%ggR6OF3y?4!!K?& !!!)$ 9;*f! !!!.% !!!)$!!!!# !!#0GM>RAd#y#fx !!!W5 !!#3H !!!!& !!#6I<UKaX!!!?+!!!%#!!!!X !!#AL !!!1& !!+u{!!!!) " + "lang=aa|ay|bi|br|ch|co|da|de|en|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gv|ho|ia|id|ie|io|is|it|lb|mg|nb|nds|nl|nn|no|nr|nso|oc|om|pt|rm|sma|smj|so|sq|ss|st|sv|sw|tl|tn|tr|ts|uz|vo|vot|wa|xh|yap|zu|an|crh|fil|ht|jv|kj|ku-tr|kwm|li|ms|ng|pap-an|pap-aw|rn|rw|sc|sg|sn|su|za" + "fontversion=131072" + "fontformat=TrueType" + "embolden=False" + "embeddedbitmap=True" + "decorative=False" + "lcdfilter=1" + "namelang=en" + "prgname=xemacs" + "hash=sha256\\:da4281dc7db17a3dfce64a62ced92875c5895340055ec8ba24a3914eb97b349d" + "postscriptname=BitstreamVeraSansMono-Roman")) + (test-name-degenerate "") + (test-name-trivial (nth 0 test-name-parts)) + (test-name-short + (concat (nth 0 test-name-parts) ":" (nth 26 test-name-parts))) + (test-name-long (mapconcat #'identity + (append (subseq test-name-parts 0 26) + (subseq test-name-parts 27)) + ":")) + (test-name-full (mapconcat #'identity test-name-parts ":"))) + (labels ((try (fontname) + (fc-name-unparse (fc-name-parse fontname))) + (try-harder (fontname) + (fc-name-unparse (fc-name-parse-harder fontname)))) + (Assert (string= test-name-degenerate (try test-name-degenerate))) + (Assert (string= test-name-degenerate (try-harder test-name-degenerate))) + (Assert (string= test-name-trivial (try test-name-trivial))) + (Assert (string= test-name-trivial (try-harder test-name-trivial))) + ;; Note when the `try' form fails, the `try-harder' form returns a + ;; shorter name. + (Check-Error 'invalid-argument + (string= test-name-short (try test-name-short))) + (Assert (string= test-name-trivial (try-harder test-name-short))) + (Assert (string= test-name-long (try test-name-long))) + (Assert (string= test-name-long (try-harder test-name-long))) + ;; Note when the `try' form fails, the `try-harder' form returns a + ;; shorter name. + (Check-Error 'invalid-argument + (string= test-name-full (try test-name-full))) + (Assert (string= test-name-long (try-harder test-name-full)))))) ;;; end face-tests.el Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches