diff --git a/collects/tests/xml/test.ss b/collects/tests/xml/test.ss index 0da08856ff..5f1490c64f 100644 --- a/collects/tests/xml/test.ss +++ b/collects/tests/xml/test.ss @@ -123,6 +123,8 @@ END (test-xexpr? (make-comment "Comment!")) (test-xexpr? (make-pcdata #f #f "quoted ")) + (test-not-xexpr? (list 'a (list (list 'href)) "content")) + (test-not-xexpr? +) (test-not-xexpr? #f)) diff --git a/collects/web-server/private/xexpr.ss b/collects/web-server/private/xexpr.ss index 0b9ec14e37..6e238a85e2 100644 --- a/collects/web-server/private/xexpr.ss +++ b/collects/web-server/private/xexpr.ss @@ -23,13 +23,17 @@ (make-exn:pretty (exn-message exn) 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))))))]) (contract xexpr/c val pos neg src-info)))) (lambda (v) #t))) (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 (define (format-xexpr/errors v) diff --git a/collects/xml/private/xexpr.ss b/collects/xml/private/xexpr.ss index f7d536251f..f754557d5b 100644 --- a/collects/xml/private/xexpr.ss +++ b/collects/xml/private/xexpr.ss @@ -26,11 +26,11 @@ comment? p-i? cdata? pcdata?)) #;(define xexpr/c - (flat-rec-contract xexpr - xexpr-datum/c - (cons/c symbol? - (or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr)) - (listof xexpr))))) + (flat-rec-contract xexpr + xexpr-datum/c + (cons/c symbol? + (or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr)) + (listof xexpr))))) (define xexpr/c (make-proj-contract @@ -129,13 +129,18 @@ ;; True if the list is a list of String,Symbol pairs. (define (attribute-symbol-string? attr true false) (if (symbol? (car attr)) - (if (or (string? (cadr attr)) - (permissive?)) - (true) + (if (pair? (cdr attr)) + (if (or (string? (cadr attr)) + (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 - (format "Expected a string, given ~a" (cadr attr)) + (format "Expected an attribute value string for attribute ~a" attr) (current-continuation-marks) - (cadr attr)))) + attr))) (false (make-exn:invalid-xexpr (format "Expected a symbol, given ~a" (car attr)) (current-continuation-marks)