SCM Repository
Annotation of /sml/trunk/src/smlnj-lib/HTML/test-parser.sml
Parent Directory
| 
Revision Log
Revision 2 - (view) (download)
| 1 : | monnier | 2 | (* test-parser.sml |
| 2 : | * | ||
| 3 : | * COPYRIGHT (c) 1996 AT&T REsearch. | ||
| 4 : | * | ||
| 5 : | * This is a simple test driver for the HTML parser. | ||
| 6 : | *) | ||
| 7 : | |||
| 8 : | structure Main : sig | ||
| 9 : | |||
| 10 : | val doit : string -> HTML.html option | ||
| 11 : | val main : (string * string list) -> OS.Process.status | ||
| 12 : | |||
| 13 : | end = struct | ||
| 14 : | |||
| 15 : | structure Err = | ||
| 16 : | struct | ||
| 17 : | type context = {file : string option, line : int} | ||
| 18 : | |||
| 19 : | structure F = Format | ||
| 20 : | |||
| 21 : | fun prf ({file, line}, fmt, args) = ( | ||
| 22 : | case file | ||
| 23 : | of NONE => TextIO.output ( | ||
| 24 : | TextIO.stdErr, | ||
| 25 : | F.format "line %3d: " [F.INT line]) | ||
| 26 : | | (SOME fname) => TextIO.output ( | ||
| 27 : | TextIO.stdErr, | ||
| 28 : | F.format "%s[%d]: " [F.STR fname, F.INT line]) | ||
| 29 : | (* end case *); | ||
| 30 : | TextIO.output(TextIO.stdErr, F.format fmt args); | ||
| 31 : | TextIO.output1(TextIO.stdErr, #"\n")) | ||
| 32 : | |||
| 33 : | fun badStartTag ctx tagName = | ||
| 34 : | prf (ctx, "unrecognized start tag \"%s\"",[F.STR tagName]) | ||
| 35 : | |||
| 36 : | fun badEndTag ctx tagName = | ||
| 37 : | prf (ctx, "unrecognized end tag \"%s\"",[F.STR tagName]) | ||
| 38 : | |||
| 39 : | fun badAttrVal ctx (attrName, attrVal) = | ||
| 40 : | prf (ctx, "bad value \"%s\" for attribute \"%s\"", | ||
| 41 : | [F.STR attrVal, F.STR attrName]) | ||
| 42 : | |||
| 43 : | fun lexError ctx msg = prf (ctx, "%s", [F.STR msg]) | ||
| 44 : | |||
| 45 : | fun syntaxError ctx msg = prf (ctx, "%s", [F.STR msg]) | ||
| 46 : | |||
| 47 : | fun missingAttrVal ctx attrName = | ||
| 48 : | prf (ctx, "missing value for \"%s\" attribute", [F.STR attrName]) | ||
| 49 : | |||
| 50 : | fun missingAttr ctx attrName = | ||
| 51 : | prf (ctx, "missing \"%s\" attribute", [F.STR attrName]) | ||
| 52 : | |||
| 53 : | fun unknownAttr ctx attrName = | ||
| 54 : | prf (ctx, "unknown attribute \"%s\"", [F.STR attrName]) | ||
| 55 : | |||
| 56 : | fun unquotedAttrVal ctx attrName = | ||
| 57 : | prf (ctx, "attribute value for \"%s\" should be quoted", | ||
| 58 : | [F.STR attrName]) | ||
| 59 : | |||
| 60 : | end | ||
| 61 : | |||
| 62 : | structure P = HTMLParserFn(Err); | ||
| 63 : | |||
| 64 : | fun doit fname = SOME(P.parseFile fname) (* handle _ => NONE *) | ||
| 65 : | |||
| 66 : | fun main (_, files) = (List.app (ignore o doit) files; OS.Process.success) | ||
| 67 : | |||
| 68 : | end; |
| root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
| Powered by ViewVC 1.0.0 |
