annotate tests/gtk/event-stream-tests.el @ 5327:d1b17a33450b

Move the heavy lifting from cl-seq.el to C. src/ChangeLog addition: 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> Move the heavy lifting from cl-seq.el to C, finally making those functions first-class XEmacs citizens, with circularity checking, built-in support for tests other than #'eql, and as much compatibility with current Common Lisp as Paul Dietz' tests require. * fns.c (check_eq_nokey, check_eq_key, check_eql_nokey) (check_eql_key, check_equal_nokey, check_equal_key) (check_equalp_nokey, check_equalp_key, check_string_match_nokey) (check_string_match_key, check_other_nokey, check_other_key) (check_if_nokey, check_if_key, check_match_eq_key) (check_match_eql_key, check_match_equal_key) (check_match_equalp_key, check_match_other_key): New. These are basically to provide function pointers to be used by Lisp functions that take TEST, TEST-NOT and KEY arguments. (get_check_match_function_1, get_check_test_function) (get_check_match_function): These functions work out which of the previous list of functions to use, given the keywords supplied by the user. (count_with_tail): New. This is the bones of #'count. (list_count_from_end, string_count_from_end): Utility functions for #'count. (Fcount): New, moved from cl-seq.el. (list_position_cons_before): New. The implementation of #'member*, and important in implementing various other functions. (FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind) (FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates) (Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst) (Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection) (Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion) (Fset_exclusive_or, Fnset_exclusive_or): New, moved here from cl-seq.el. (position): New. The implementation of #'find and #'position. (list_delete_duplicates_from_end, subst, sublis, nsublis) (tree_equal, mismatch_from_end, mismatch_list_list) (mismatch_list_string, mismatch_list_array) (mismatch_string_array, mismatch_string_string) (mismatch_array_array, get_mismatch_func): Helper C functions for the Lisp-visible functions. (venn, nvenn): New. The implementation of the main Lisp functions that treat lists as sets. lisp/ChangeLog addition: 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 30 Dec 2010 01:59:52 +0000
parents cd167465bf69
children 3889ef128488 b9167d522a9a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
5287
cd167465bf69 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5231
diff changeset
1 ;; event-stream-tests.el --- test the GTK event stream
cd167465bf69 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5231
diff changeset
2 ;;
cd167465bf69 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5231
diff changeset
3 ;; Copyright 2000, 2001 William Perry
cd167465bf69 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5231
diff changeset
4 ;; Seems to be based on the comment at the end of src/event-stream.c.
cd167465bf69 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 5231
diff changeset
5 ;;
4709
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
6 ;; This file is part of XEmacs.
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
7 ;;
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
8 ;; XEmacs is free software; you can redistribute it and/or modify it
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
9 ;; under the terms of the GNU General Public License as published by the
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
10 ;; Free Software Foundation; either version 2, or (at your option) any
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
11 ;; later version.
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
12 ;;
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
13 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
14 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
15 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
16 ;; for more details.
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
17 ;;
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
18 ;; You should have received a copy of the GNU General Public License
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
19 ;; along with XEmacs; see the file COPYING. If not, write to
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
20 ;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
5231
ba07c880114a Fix up FSF's Franklin Street address in many files.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4709
diff changeset
21 ;; Boston, MA 02110-1301, USA. */
4709
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 4021
diff changeset
22
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 ;in *scratch*, type (sit-for 20)^J
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 ;wait a couple of seconds, move cursor to foo, type "a"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 ;a should be inserted in foo. Cursor highlighting should not change in
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 ;the meantime.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29 ;do it with sleep-for. move cursor into foo, then back into *scratch*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30 ;before typing.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 ;repeat also with (accept-process-output nil 20)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 (defun tst ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 (list (condition-case c
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37 (sleep-for 20)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 (quit c))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 (read-char)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 (tst)^Ja^G ==> ((quit) 97) with no signal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42 (tst)^J^Ga ==> ((quit) 97) with no signal
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 ; with sit-for only do the 2nd test.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 ; Do all 3 tests with (accept-proccess-output nil 20)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 Additional test cases for accept-process-output, sleep-for, sit-for.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 Be sure you do all of the above checking for C-g and focus, too!
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 ; Make sure that timer handlers are run during, not after sit-for:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (defun timer-check ()
4021
cef5f57bb9e2 [xemacs-hg @ 2007-06-21 13:39:08 by aidan]
aidan
parents: 462
diff changeset
54 (add-timeout 2 #'(lambda (ignore) (message "timer ran")) nil)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 (sit-for 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 (message "after sit-for"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 ; The first message should appear after 2 seconds, and the final message
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 ; 3 seconds after that.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 ; Make sure that process filters are run during, not after sit-for.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 (defun fubar ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 (message "sit-for = %s" (sit-for 30)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 (add-hook 'post-command-hook 'fubar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 ; Now type M-x shell RET
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68 ; wait for the shell prompt then send: ls RET
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 ; the output of ls should fill immediately, and not wait 30 seconds.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 ; Make sure that recursive invocations return immediately:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 (defmacro test-diff-time (start end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 `(+ (* (- (car ,end) (car ,start)) 65536.0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78 (- (cadr ,end) (cadr ,start))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 (defun testee (ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 (sit-for 10))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 (defun test-them ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 (let ((start (current-time))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 (add-timeout 2 'testee nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 (sit-for 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 (add-timeout 2 'testee nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 (sleep-for 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 (add-timeout 2 'testee nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92 (accept-process-output nil 5)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 (setq end (current-time))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94 (test-diff-time start end)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 (test-them) should sit for 15 seconds.