suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed some bugs revealed by the test suite (and in the test suite ...)

Browse Source 
svn: r3336
This commit is contained in:
Robby Findler 2006-06-11 23:08:04 +00:00
parent 70d764c941
commit 1cd117bd2c
3 changed files with 100 additions and 134 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/drscheme/private/debug.ss
View File

@ -273,7 +273,14 @@ profile todo:
;; prints out the src location information for src-to-display
;; as it would appear in an error message
(define (display-srcloc-in-error src-to-display)
(let ([src (srcloc-source src-to-display)])
(let* ([raw-src (srcloc-source src-to-display)]
[src (if (and (is-a? raw-src editor<%>)
(not (is-a? raw-src drscheme:unit:definitions-text<%>)))
(let* ([b (box #f)]
[fn (send raw-src get-filename b)])
(and (not (unbox b))
fn))
raw-src)])
(when (and (path? src) file-note%)
(let ([note (new file-note%)])
(send note set-callback
@ -296,10 +303,18 @@ profile todo:
;; -> (listof srclocs)
;; finds the source location to display, choosing between
;; the stack trace and the exception record.
;; returns #f if the source isn't a string.
(define (find-src-to-display exn cms)
(let ([has-info?
(λ (srcloc)
(ormap (λ (f) (f srcloc))
(list srcloc-column
srcloc-line
srcloc-position
srcloc-source
#;srcloc-span)))]) ;; don't consider span alone to count as `info'
(cond
[(exn:srclocs? exn)
[(and (exn:srclocs? exn)
(ormap has-info? ((exn:srclocs-accessor exn) exn)))
((exn:srclocs-accessor exn) exn)]
[(pair? cms)
(let ([fst (car cms)])
@ -308,7 +323,7 @@ profile todo:
#f
(cadr fst)
(cddr fst))))]
[else '()]))
[else '()])))
(define (show-syntax-error-context port exn)

4
collects/drscheme/private/rep.ss
View File

@ -173,7 +173,9 @@ TODO
;; the highlighting.
(define (drscheme-error-display-handler msg exn)
(let* ([srclocs-stack
(filter values (map cdr (continuation-mark-set->context (exn-continuation-marks exn))))]
(if (exn? exn)
(filter values (map cdr (continuation-mark-set->context (exn-continuation-marks exn))))
'())]
[stack
(filter
values

87
collects/tests/drscheme/repl-test.ss
View File

@ -56,9 +56,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
;; if this field is not #f, the execute-answer and load-answer fields
;; are expected to be `format'able strings with one ~a in them.
docs-icon? ;; : boolean
;; true if this should have a docs icon in front of the response.
breaking-test? ;; : boolean
;; setup is called before the test case is run.
@ -77,7 +74,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "\"a\""
@ -87,7 +83,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -98,7 +93,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -109,7 +103,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -120,7 +113,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 0 0) (make-loc 0 1 1))
'read
#f
#f
void
void)
(make-test "."
@ -130,7 +122,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 0 0) (make-loc 0 1 1))
'read
#f
#f
void
void)
(make-test "(lambda ())"
@ -139,7 +130,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
#f
(cons (make-loc 0 0 0) (make-loc 0 11 11))
'expand
#t
#f
void
void)
@ -150,7 +140,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 0 0) (make-loc 0 2 2))
#f
#f
#f
void
void)
(make-test "(raise 1)"
@ -160,7 +149,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "(raise #f)"
@ -170,7 +158,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -181,7 +168,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "(list 1 2)"
@ -191,7 +177,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -202,7 +187,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -214,7 +198,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -225,7 +208,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -236,7 +218,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -245,12 +226,11 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
"(module n mzscheme (require-for-syntax m) (provide s) (define-syntax (s stx) e))\n"
"(require n)\n"
"s")
"compile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1"
"compile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1"
#f
(cons (make-loc 1 43 43) (make-loc 1 44 44))
#f
"~acompile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1"
"~acompile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1"
#f
(cons (make-loc 0 43 43) (make-loc 0 44 44))
'expand
#f
void
void)
@ -263,7 +243,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -274,7 +253,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 1 0 10) (make-loc 1 2 12))
#f
#f
#f
void
void)
@ -288,7 +266,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -302,7 +279,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -317,7 +293,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -332,7 +307,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -347,7 +321,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'definitions
#f
#f
#f
void
void)
|#
@ -361,7 +334,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test " (eval '(list 1 2))"
@ -371,7 +343,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test " (eval '(lambda ()))"
@ -381,7 +352,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 4 4) (make-loc 0 23 23))
#f
#f
#f
void
void)
(make-test " (eval 'x)"
@ -391,7 +361,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 4 4) (make-loc 0 13 13))
#f
#f
#f
void
void)
@ -402,7 +371,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -413,7 +381,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -425,7 +392,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 0 0) (make-loc 0 12 12))
#f
#f
#f
void
void)
@ -437,7 +403,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 4 4) (make-loc 0 9 9))
'read
#f
#f
void
void)
(make-test "1 2 . 3 4"
@ -447,7 +412,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 4 4) (make-loc 0 5 5))
'read
#f
#f
void
void)
(make-test "1 2 (lambda ()) 3 4"
@ -456,7 +420,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
#f
(cons (make-loc 0 4 4) (make-loc 0 15 15))
'expand
#t
#f
void
void)
@ -467,7 +430,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 4 4) (make-loc 0 5 5))
#f
#f
#f
void
void)
(make-test "1 2 (raise 1) 3 4"
@ -477,7 +439,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "1 2 (raise #f) 3 4"
@ -487,7 +448,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -502,7 +462,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(make-loc -1 -1 (+ (string-length (path->string tmp-filename)) 36)))
#f
#f
#f
(lambda ()
(call-with-output-file tmp-filename
(lambda (port)
@ -519,7 +478,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
#f
(cons (make-loc 1 0 37) (make-loc 1 2 39))
'expand
#t
#f
void
void)
@ -530,7 +488,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
#f
(cons (make-loc 1 0 44) (make-loc 1 0 46))
'expand
#t
#f
void
void)
@ -543,7 +500,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -558,19 +514,19 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'definitions
#f
#f
#f
void
void)
; fraction snip test
;; this test depends on the state of the 'framework:fraction-snip-style preference
;; make sure this preference is set to the default when running this test.
(make-test 'fraction-sum
"{number 5/6 \"5/6\" mixed}"
"{number 5/6 \"5/6\" mixed}"
"{number 5/6 \"5/6\" improper}"
"{number 5/6 \"5/6\" improper}"
#f
'interactions
#f
#f
#f
void
void)
@ -582,7 +538,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -594,7 +549,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -606,18 +560,16 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "(parameterize ([current-output-port (open-output-string)]) (fprintf (current-error-port) \"~e\" #'foot))"
"#<syntax::79>"
"#<syntax::79>"
"#<syntax:1:96>"
"#<syntax:/Users/robby/svn/plt/collects/tests/drscheme/repl-test-tmp.ss:1:96>"
#f
'interactions
#f
#f
#f
void
void)
@ -628,7 +580,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -642,7 +593,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 99 99) (make-loc 0 104 104))
#f
#f
#f
void
void)
@ -653,7 +603,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
2
(cons (make-loc 0 0 0) (make-loc 0 35 35))
#f
#f
#t
void
void)
@ -664,7 +613,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
2
(cons (make-loc 0 8 8) (make-loc 0 11 11))
#f
#f
#t
void
void)
@ -676,7 +624,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "(define v (vector (call/cc (lambda (x) x))))\n((vector-ref v 0) 2)\nv"
@ -685,7 +632,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
(make-test "(define v (vector (eval '(call/cc (lambda (x) x)))))\n((vector-ref v 0) 2)\nv"
@ -694,7 +640,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -705,7 +650,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 3 7 61) (make-loc 3 12 66))
#f
#f
#f
void
void)
@ -717,7 +661,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
'interactions
#f
#f
#f
void
void)
@ -727,7 +670,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
#f
(cons (make-loc 0 0 0) (make-loc 0 5 5))
'expand
#t
#f
void
void)
@ -740,7 +682,6 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(cons (make-loc 0 26 26) (make-loc 0 27 27))
#f
#f
#f
void
void)))
@ -961,6 +902,14 @@ There shouldn't be any error (but add in a bug that triggers one to be sure!)
(- (send interactions-text last-position) 1))))
(test:keystroke #\return))
; in order to erase the state in the namespace already, we clear (but don't save!)
; the definitions and click execute with the empty buffer
(test:new-window definitions-canvas)
(test:menu-select "Edit" "Select All")
(test:menu-select "Edit" "Delete")
(do-execute drscheme-frame #f)
(wait-for-execute)
; stuff the load command into the REPL
(for-each test:keystroke
(string->list (format "(load ~s)" tmp-load-short-filename)))