{"size": 4502, "ext": "rktl", "max_stars_repo_path": "gui-test/tests/gracket/paramz.rktl", "max_stars_repo_name": "jjsimpso/gui", "max_stars_repo_stars_event_min_datetime": "2015-03-17T22:11:52.000Z", "max_stars_repo_stars_event_max_datetime": "2022-03-12T15:09:34.000Z", "max_issues_repo_path": "gui-test/tests/gracket/paramz.rktl", "max_issues_repo_name": "jjsimpso/gui", "max_issues_repo_issues_event_min_datetime": "2015-01-09T15:53:25.000Z", "max_issues_repo_issues_event_max_datetime": "2022-03-31T16:21:29.000Z", "max_forks_repo_path": "gui-test/tests/gracket/paramz.rktl", "max_forks_repo_name": "jjsimpso/gui", "max_forks_repo_forks_event_min_datetime": "2015-01-08T13:03:07.000Z", "max_forks_repo_forks_event_max_datetime": "2022-03-26T21:49:09.000Z"}
{"max_stars_count": 65, "max_issues_count": 231, "max_forks_count": 89, "avg_line_length": 30.4189189189, "max_line_length": 88, "alphanum_fraction": 0.5426477121}

(load-relative "loadtest.rktl")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                             Yield Tests                                    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define s (make-semaphore))
(define v 4)
(queue-callback (lambda () (set! v 5)))
(yield)
(test v 'yield-run 5)
(queue-callback (lambda () (set! v 6)))

(semaphore-post s)
(yield s)
(test v 'yield-wait 5)
(yield)
(test v 'yield-run 6)

(queue-callback (lambda () (set! v 7) (semaphore-post s)))
(yield s)
(test v 'yield-run-post 7)

(queue-callback (lambda () 
		  (set! v 8)
		  (semaphore-post s)
		  (queue-callback
		   (lambda () (set! v 9)))))
(yield s)
(test v 'yield-wait-post 8)
(yield)
(test v 'yield-run 9)

(define d (make-object dialog% "hello"))
(thread (lambda () 
	  (sync (system-idle-evt))
	  (queue-callback (lambda () (set! v 11)))
	  (send d show #f)))
(queue-callback (lambda () (set! v 10)))
(send d show #t)
(test v 'dialog-wait 10)
(yield)
(test v 'dialog-run 11)

(define d (make-object dialog% "Hello"))
(let ([t (thread (lambda ()
		   (send d show #t)))])
  (let loop () (unless (send d is-shown?) (loop)))
  (st #t d is-shown?)
  (thread-suspend t)
  (stv d show #f)
  (st #f d is-shown?)
  (thread-resume t)
  (thread-wait t)
  (st #f d is-shown?)

  (let ([t (thread (lambda ()
                     (send d show #t)))])
    (let loop () (unless (send d is-shown?) (sleep) (loop)))
    (st #t d is-shown?)
    (thread-suspend t)
    (stv d show #f)
    (st #f d is-shown?)
    (let ([t2 (thread (lambda () (send d show #t)))])
      (yield (system-idle-evt))
      (st #t d is-shown?)
      (thread-resume t)
      (yield (system-idle-evt))
      (st #t d is-shown?)
      (test #t 'thread2 (thread-running? t2))
      (stv d show #f)
      (thread-wait t)
      (thread-wait t2)
      (st #f d is-shown?))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                        Parameterization Tests                              ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Killing an eventspace
(define c (make-custodian))
(define e (parameterize ([current-custodian c]) (make-eventspace)))
(define tmr (parameterize ([current-eventspace e]) 
	      (new timer% [notify-callback void])))
(parameterize ([current-eventspace e]) (send (make-object frame% "x" #f 50 50) show #t))
(test #f 'shutdown? (eventspace-shutdown? e))
(custodian-shutdown-all c)
(test #t 'shutdown? (eventspace-shutdown? e))
(define (try-use-es t)
  (test
   'error
   'shutdown-eventspace
   (with-handlers ([(lambda (x)
		      (and (exn:fail? x)
			   (regexp-match "shutdown" (exn-message x))))
		    (lambda (x)
		      (printf "got expected error: ~a\n" (exn-message x))
		      'error)])
     (parameterize ([current-eventspace e]) 
       (t)))))
(try-use-es (lambda () (make-object frame% "x" #f 50 50)))
(try-use-es (lambda () (make-object dialog% "x" #f 50 50)))
(try-use-es (lambda () (make-object timer%)))
(try-use-es (lambda () (queue-callback void)))
(try-use-es (lambda () (send tmr start 100 #t)))

;; ----------------------------------------
;;  Check that breaking an eventspace thread doesn't kill it:

(let ()
  (define o (open-output-bytes))
  (define evtsp (parameterize ([current-error-port o])
                  (make-eventspace)))
  (define evtth (eventspace-handler-thread evtsp))
  
  (sleep 0.1)
  (break-thread evtth)

  (define done (make-semaphore))
  (parameterize ((current-eventspace evtsp))
    (queue-callback (lambda () (semaphore-post done))))

  (unless (sync/timeout 3 done)
    (error "broken thread is really broken")))

;; ----------------------------------------

(let ()
  (define eventspace (make-eventspace #:suspend-to-kill? #t))
  (define c (make-channel))
  (parameterize ([current-eventspace eventspace])
    (queue-callback
     (λ ()
       (channel-put c 0))))
  (test 0 'suspend-to-kill.1 (channel-get c))
  (kill-thread (eventspace-handler-thread eventspace))
  (test #f 'suspend-to-kill.2 (thread-running? (eventspace-handler-thread eventspace)))
  (test #f 'suspend-to-kill.3 (thread-dead? (eventspace-handler-thread eventspace)))
  (thread-resume (eventspace-handler-thread eventspace) (current-custodian))
  (parameterize ([current-eventspace eventspace])
    (queue-callback
     (λ ()
       (channel-put c 1))))
  (test 1 'suspend-to-kill.4 (channel-get c)))

(report-errs)
