...
original commit: 12287f8a0274d981ddf2f64ce5cfdd6dddc8aab0
This commit is contained in:
parent
315e52614a
commit
fda0aca5fd
|
@ -45,7 +45,7 @@
|
|||
(string-append "Are you sure you want to "
|
||||
w
|
||||
"?")]
|
||||
[(user-says) (gui-utils:get-choice message capw "Cancel")])
|
||||
[(user-says) (gui-utils:get-choice message capw "Cancel" "Warning" #f)])
|
||||
user-says)
|
||||
#t))
|
||||
|
||||
|
|
|
@ -1328,10 +1328,11 @@
|
|||
(set-editor position-edit)
|
||||
(stretchable-width #f)
|
||||
(stretchable-height #f))
|
||||
(determine-width "0000:000-0000:000"
|
||||
(determine-width "0000:000-0000:000"
|
||||
position-canvas
|
||||
position-edit)
|
||||
(editor-position-changed)
|
||||
(send position-edit hide-caret #t)
|
||||
(send position-edit lock #t))))
|
||||
|
||||
(define pasteboard-info<%> (interface (info<%>)))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(lambda ()
|
||||
(with-handlers ([eof-result? (lambda (x) 'passed)])
|
||||
(send-sexp-to-mred '(preferences:set 'framework:verify-exit #f))
|
||||
(send-sexp-to-mred '(exit:exit))
|
||||
(send-sexp-to-mred '(begin (exit:exit) (sleep/yield 1)))
|
||||
'failed)))
|
||||
|
||||
(test 'exit/prompt
|
||||
|
@ -65,7 +65,7 @@
|
|||
`(begin
|
||||
(preferences:set 'framework:verify-exit #f)
|
||||
(exit:insert-can?-callback (lambda () (call-with-output-file ,tmp-file void) #t))
|
||||
(exit:exit))))))
|
||||
(begin (exit:exit) (sleep/yield 1)))))))
|
||||
|
||||
(test 'exit-callback-removed
|
||||
(lambda (x) (and (eq? x 'passed) (not (mred-running?))))
|
||||
|
@ -75,7 +75,7 @@
|
|||
`(begin
|
||||
(preferences:set 'framework:verify-exit #f)
|
||||
((exit:insert-can?-callback (lambda () (error 'called-exit-callback))))
|
||||
(exit:exit))))))
|
||||
(begin (exit:exit) (sleep/yield 1)))))))
|
||||
|
||||
(test 'exit-callback-stops-exit
|
||||
(lambda (x) (eq? x 'passed))
|
||||
|
|
|
@ -142,24 +142,18 @@
|
|||
ov))))])
|
||||
(pretty-print sexp)
|
||||
(newline)))])
|
||||
(printf "1~n")
|
||||
(unless (and in-port
|
||||
out-port
|
||||
(or (not (char-ready? in-port))
|
||||
(not (eof-object? (peek-char in-port)))))
|
||||
(restart-mred))
|
||||
(printf " ~a // ~a: sending to mred:~n" section-name test-name)
|
||||
(printf "2~n")
|
||||
(show-text sexp)
|
||||
(printf "3~n")
|
||||
(write sexp out-port)
|
||||
(printf "4~n")
|
||||
(newline out-port)
|
||||
(printf "5~n")
|
||||
(let ([answer
|
||||
(with-handlers ([(lambda (x) #t)
|
||||
(lambda (x)
|
||||
(printf "8 ~a~n" (exn-message x))
|
||||
(list 'cant-read
|
||||
(string-append
|
||||
(exn-message x)
|
||||
|
@ -168,18 +162,17 @@
|
|||
string
|
||||
(let loop ()
|
||||
(if (char-ready? in-port)
|
||||
(cons (read-char in-port)
|
||||
(loop))
|
||||
(let ([char (read-char in-port)])
|
||||
(if (eof-object? char)
|
||||
null
|
||||
(cons char (loop))))
|
||||
null))))))])
|
||||
(printf "6~n")
|
||||
(read in-port))])
|
||||
(unless (or (eof-object? answer)
|
||||
(and (list? answer)
|
||||
(= 2 (length answer))))
|
||||
(error 'send-sexp-to-mred "unpected result from mred: ~s~n" answer))
|
||||
|
||||
(printf "7~n")
|
||||
|
||||
(if (eof-object? answer)
|
||||
(raise (make-eof-result))
|
||||
(case (car answer)
|
||||
|
@ -210,7 +203,6 @@
|
|||
(sexp/proc)
|
||||
(begin0 (send-sexp-to-mred sexp/proc)
|
||||
(send-sexp-to-mred ''check-for-errors)))])
|
||||
|
||||
(not (passed? result))))])
|
||||
(when failed
|
||||
(printf "FAILED ~a: ~a~n" failed test-name)
|
||||
|
|
Loading…
Reference in New Issue
Block a user