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

Fixing an error in the detecting of bad Xexprs and displaying the error prettily

Browse Source 
svn: r15080
This commit is contained in:
Jay McCarthy 2009-06-04 17:25:19 +00:00
parent 818d7cb292
commit e9db334ed0
3 changed files with 23 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/xml/test.ss
View File

@ -123,6 +123,8 @@ END
(test-xexpr? (make-comment "Comment!")) (test-xexpr? (make-comment "Comment!"))
(test-xexpr? (make-pcdata #f #f "quoted <b>")) (test-xexpr? (make-pcdata #f #f "quoted <b>"))
(test-not-xexpr? (list 'a (list (list 'href)) "content"))
(test-not-xexpr? +) (test-not-xexpr? +)
(test-not-xexpr? #f)) (test-not-xexpr? #f))

8
collects/web-server/private/xexpr.ss
View File

@ -23,13 +23,17 @@
(make-exn:pretty (make-exn:pretty
(exn-message exn) (exn-message exn)
marks marks
`(span ,(drop-after "Context:\n" (exn-message exn)) `(span ,(drop-after "Context:\n" (exn-message exn)) "\n"
,(make-cdata #f #f (format-xexpr/errors val))))))]) ,(make-cdata #f #f (format-xexpr/errors val))))))])
(contract xexpr/c val pos neg src-info)))) (contract xexpr/c val pos neg src-info))))
(lambda (v) #t))) (lambda (v) #t)))
(define (drop-after delim str) (define (drop-after delim str)
(substring str 0 (cdr (first (regexp-match-positions (regexp-quote delim) str))))) (match (regexp-match-positions (regexp-quote delim) str)
[(list-rest (list-rest start end) _rst)
(substring str 0 end)]
[_
str]))
; Formating Xexprs ; Formating Xexprs
(define (format-xexpr/errors v) (define (format-xexpr/errors v)

25
collects/xml/private/xexpr.ss
View File

@ -26,11 +26,11 @@
comment? p-i? cdata? pcdata?)) comment? p-i? cdata? pcdata?))
#;(define xexpr/c #;(define xexpr/c
(flat-rec-contract xexpr (flat-rec-contract xexpr
xexpr-datum/c xexpr-datum/c
(cons/c symbol? (cons/c symbol?
(or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr)) (or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr))
(listof xexpr))))) (listof xexpr)))))
(define xexpr/c (define xexpr/c
(make-proj-contract (make-proj-contract
@ -129,13 +129,18 @@
;; True if the list is a list of String,Symbol pairs. ;; True if the list is a list of String,Symbol pairs.
(define (attribute-symbol-string? attr true false) (define (attribute-symbol-string? attr true false)
(if (symbol? (car attr)) (if (symbol? (car attr))
(if (or (string? (cadr attr)) (if (pair? (cdr attr))
(permissive?)) (if (or (string? (cadr attr))
(true) (permissive?))
(true)
(false (make-exn:invalid-xexpr
(format "Expected a string, given ~a" (cadr attr))
(current-continuation-marks)
(cadr attr))))
(false (make-exn:invalid-xexpr (false (make-exn:invalid-xexpr
(format "Expected a string, given ~a" (cadr attr)) (format "Expected an attribute value string for attribute ~a" attr)
(current-continuation-marks) (current-continuation-marks)
(cadr attr)))) attr)))
(false (make-exn:invalid-xexpr (false (make-exn:invalid-xexpr
(format "Expected a symbol, given ~a" (car attr)) (format "Expected a symbol, given ~a" (car attr))
(current-continuation-marks) (current-continuation-marks)