fix fd polling in atomic mode
This commit is contained in:
parent
c8fd6f9312
commit
3cd071beb2
59
collects/tests/drracket/random.rkt
Normal file
59
collects/tests/drracket/random.rkt
Normal file
|
@ -0,0 +1,59 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require "private/drracket-test-util.rkt"
|
||||||
|
tests/utils/gui
|
||||||
|
mred
|
||||||
|
framework
|
||||||
|
(prefix-in fw: framework))
|
||||||
|
|
||||||
|
(define (run-test)
|
||||||
|
(define dr (wait-for-drscheme-frame))
|
||||||
|
|
||||||
|
(clear-definitions dr)
|
||||||
|
(insert-in-definitions dr (file->string "/home/mflatt/svn/mflatt/text/expmodel/mm-defs.rkt"))
|
||||||
|
|
||||||
|
(let loop ()
|
||||||
|
(define n (random 100))
|
||||||
|
(cond
|
||||||
|
[(n . < . 10)
|
||||||
|
(test:keystroke #\A)
|
||||||
|
(test:keystroke #\backspace)]
|
||||||
|
[(n . < . 50)
|
||||||
|
(test:keystroke 'left)]
|
||||||
|
[(n . < . 60)
|
||||||
|
(test:keystroke 'up)]
|
||||||
|
[(n . < . 70)
|
||||||
|
(test:keystroke 'down)]
|
||||||
|
[(n . < . 80)
|
||||||
|
(test:keystroke 'right)]
|
||||||
|
[(n . < . 82)
|
||||||
|
(sleep 10)]
|
||||||
|
[(n . < . 83)
|
||||||
|
(test:keystroke 'f5)
|
||||||
|
(test:keystroke #\x '(control))
|
||||||
|
(test:keystroke #\o)]
|
||||||
|
[else
|
||||||
|
(test:keystroke 'left)
|
||||||
|
(test:keystroke 'right)
|
||||||
|
(test:keystroke #\backspace)
|
||||||
|
(test:keystroke #\z '(meta))])
|
||||||
|
(sleep 0.25)
|
||||||
|
(loop)))
|
||||||
|
|
||||||
|
(dynamic-require 'drscheme #f)
|
||||||
|
|
||||||
|
(fw:test:use-focus-table #t)
|
||||||
|
|
||||||
|
(thread (λ ()
|
||||||
|
(let ([orig-display-handler (error-display-handler)])
|
||||||
|
(uncaught-exception-handler
|
||||||
|
(λ (x)
|
||||||
|
(if (exn? x)
|
||||||
|
(orig-display-handler (exn-message x) x)
|
||||||
|
(fprintf (current-error-port) "uncaught exception ~s\n" x))
|
||||||
|
(exit 1))))
|
||||||
|
(run-test)
|
||||||
|
(exit)))
|
||||||
|
(yield (make-semaphore 0))
|
||||||
|
|
||||||
|
|
|
@ -4600,7 +4600,7 @@ void scheme_thread_block(float sleep_time)
|
||||||
skip_sleep = 0;
|
skip_sleep = 0;
|
||||||
if (check_fd_semaphores()) {
|
if (check_fd_semaphores()) {
|
||||||
/* double check whether a semaphore for this thread woke up: */
|
/* double check whether a semaphore for this thread woke up: */
|
||||||
if (p->block_descriptor == GENERIC_BLOCKED) {
|
if (!do_atomic && (p->block_descriptor == GENERIC_BLOCKED)) {
|
||||||
if (p->block_check) {
|
if (p->block_check) {
|
||||||
Scheme_Ready_Fun_FPC f = (Scheme_Ready_Fun_FPC)p->block_check;
|
Scheme_Ready_Fun_FPC f = (Scheme_Ready_Fun_FPC)p->block_check;
|
||||||
Scheme_Schedule_Info sinfo;
|
Scheme_Schedule_Info sinfo;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user