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

up

Browse Source 
svn: r13896
This commit is contained in:
Jay McCarthy 2009-03-02 16:21:32 +00:00
parent 5786c0d936
commit e51ea7f217
2 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/html/sgml-reader.ss
View File

@ -2,7 +2,8 @@
;; warning - this was copied from the XML collection. ;; warning - this was copied from the XML collection.
;; It needs to be abstracted back in. ;; It needs to be abstracted back in.
#lang scheme #lang scheme
(require xml) (require xml
(prefix-in scheme: scheme))
;; Kid-lister : (Symbol -> (U (listof Symbol) #f)) ;; Kid-lister : (Symbol -> (U (listof Symbol) #f))
(define kid-lister/c (define kid-lister/c
@ -18,6 +19,9 @@
[gen-may-contain (spec/c . -> . kid-lister/c)] [gen-may-contain (spec/c . -> . kid-lister/c)]
[gen-read-sgml (kid-lister/c (symbol? symbol? . -> . (or/c symbol? false/c)) . -> . (() (input-port?) . ->* . (listof content/c)))]) [gen-read-sgml (kid-lister/c (symbol? symbol? . -> . (or/c symbol? false/c)) . -> . (() (input-port?) . ->* . (listof content/c)))])
(define (file-position in)
(make-location 0 0 (scheme:file-position in)))
;; Start-tag ::= (make-start-tag Location Location Symbol (listof Attribute)) ;; Start-tag ::= (make-start-tag Location Location Symbol (listof Attribute))
(define-struct (start-tag source) (name attrs)) (define-struct (start-tag source) (name attrs))

9
collects/tests/html/test.ss
View File

@ -1,6 +1,7 @@
#lang scheme #lang scheme
(require (planet schematics/schemeunit:3) (require (planet schematics/schemeunit:3)
(planet schematics/schemeunit:3/text-ui) (planet schematics/schemeunit:3/text-ui)
net/url
(prefix-in h: html) (prefix-in h: html)
(prefix-in x: xml)) (prefix-in x: xml))
@ -40,6 +41,12 @@
'()]))] '()]))]
(check-equal? (extract-pcdata an-html) (check-equal? (extract-pcdata an-html)
' ("My title" "Hello world" "Testing" "!")))))) ' ("My title" "Hello world" "Testing" "!"))))
(test-case "Eli - March 1"
(check-not-false (lambda () (h:read-html-as-xml (get-pure-port (string->url "http://list.cs.brown.edu/pipermail/plt-scheme/"))))))
))
(run-tests html-tests) (run-tests html-tests)