From eb7f38102fa81b2f1c5a4c1f3aecb02ee4a420f2 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 5 Dec 2005 15:45:26 +0000 Subject: [PATCH] fixed a bug in IO where port-next-location went into a busy loop before any io had happened svn: r1526 original commit: 4f8054f125e7c0bf83d43fb5b3a5fdede5707730 --- collects/framework/private/text.ss | 10 ++++++---- collects/framework/test.ss | 4 +++- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 12b9400e..82094f94 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -1655,9 +1655,7 @@ WARNING: printf is rebound in the body of the unit to always [resp-chan (cdr pr)]) (set! positioners (cons pr positioners)) (loop)))) - (if position - (apply choice-evt (map service-positioner positioners)) - never-evt) + (apply choice-evt (map service-positioner positioners)) (handle-evt read-chan (λ (ent) @@ -1748,7 +1746,11 @@ WARNING: printf is rebound in the body of the unit to always [resp-evt (cdr pr)]) (handle-evt (choice-evt nack-evt - (channel-put-evt resp-evt position)) + (channel-put-evt resp-evt (or position + + ;; a bogus position for when + ;; nothing has happened yet. + (list 1 0 1)))) (let ([sent-position position]) (λ (_) (set! positioners (remq pr positioners)) diff --git a/collects/framework/test.ss b/collects/framework/test.ss index 8c564e35..ea47ed50 100644 --- a/collects/framework/test.ss +++ b/collects/framework/test.ss @@ -905,7 +905,9 @@ (if (method-in-interface? 'on-event (object-interface window)) (send window on-event event) (error mouse-tag "focused window does not have on-event"))] - [(send (car l) on-subwindow-event window event) #f] + [(and (is-a? (car l) window<%>) + (send (car l) on-subwindow-event window event)) + #f] [else (loop (cdr l))])))) ;;