2 * ----------------------------------------------------------------------
11 let error_happened = ref false;;
13 let rec prerr_error e =
14 prerr_endline (string_of_exn e)
20 prerr_endline ("WARNING: " ^ w)
24 let outbuf = String.create 8192;;
26 let output_utf8 config s =
27 match config.encoding with
31 for i = 0 to String.length s - 1 do
32 let c = Char.code(s.[i]) in
34 print_char(Char.chr(c))
36 print_char(Char.chr(0xc0 lor (c lsr 6)));
37 print_char(Char.chr(0x80 lor (c land 0x3f)));
44 let re = Str.regexp "[&<>\"\009\010\013]";;
50 match Str.matched_string s with
64 let rec output_xml config n =
65 match n # node_type with
67 n # iter_nodes (output_xml config)
69 let [ pi ] = n # pinstr pi_name in
70 output_utf8 config "<?";
71 output_utf8 config (pi # target);
72 output_utf8 config " ";
73 output_utf8 config (pi # value);
74 output_utf8 config "?>";
76 output_utf8 config "<";
77 output_utf8 config name;
79 Sort.list ( <= ) (n # attribute_names) in
82 match n # attribute attname with
84 output_utf8 config " ";
85 output_utf8 config attname;
86 output_utf8 config "=\"";
87 output_utf8 config (escaped v);
88 output_utf8 config "\"";
90 let v = String.concat " " vl in
91 output_utf8 config " ";
92 output_utf8 config attname;
93 output_utf8 config "=\"";
94 output_utf8 config (escaped v);
95 output_utf8 config "\"";
100 output_utf8 config ">";
101 n # iter_nodes (output_xml config);
102 output_utf8 config "</";
103 output_utf8 config name;
104 output_utf8 config ">";
107 output_utf8 config (escaped v)
110 match n # comment with
114 output_utf8 config ("<!--" ^ v ^ "-->")
120 let parse debug wf iso88591 comments filename =
122 let e = new element_impl default_extension in
123 e # keep_always_whitespace_mode;
124 make_spec_from_mapping
125 ~super_root_exemplar: e
126 ~default_pinstr_exemplar: e
128 ~data_exemplar: (new data_impl default_extension)
129 ~default_element_exemplar: e
130 ~element_mapping: (Hashtbl.create 1)
134 { default_config with
136 debugging_mode = debug;
137 enable_pinstr_nodes = true;
138 enable_super_root_node = true;
139 enable_comment_nodes = comments;
140 encoding = if iso88591 then `Enc_iso88591 else `Enc_utf8;
146 if wf then parse_wfdocument_entity
148 let index = new hash_index in
149 parse_document_entity
151 ~id_index:(index :> 'ext index)
159 output_xml config (tree # root)
162 error_happened := true;
168 let debug = ref false in
169 let wf = ref false in
170 let iso88591 = ref false in
171 let comments = ref false in
172 let files = ref [] in
174 [ "-d", Arg.Set debug,
175 " turn debugging mode on";
177 " check only on well-formedness";
178 "-iso-8859-1", Arg.Set iso88591,
179 " use ISO-8859-1 as internal encoding instead of UTF-8";
180 "-comments", Arg.Set comments,
181 " output comments, too";
183 (fun x -> files := x :: !files)
185 usage: test_canonxml [options] file ...
188 files := List.rev !files;
189 List.iter (parse !debug !wf !iso88591 !comments) !files;
194 if !error_happened then exit(1);;
196 (* ======================================================================
200 * Revision 1.1 2000/11/17 09:57:32 lpadovan
203 * Revision 1.8 2000/08/17 00:51:57 gerd
204 * Added -comments option to test enable_comment_nodes.
206 * Revision 1.7 2000/08/16 23:44:17 gerd
207 * Updates because of changes of the PXP API.
209 * Revision 1.6 2000/07/14 14:56:55 gerd
212 * Revision 1.5 2000/07/14 14:17:58 gerd
213 * Updated because of iterface changes.
215 * Revision 1.4 2000/07/09 01:06:20 gerd
218 * Revision 1.3 2000/06/04 20:31:03 gerd
219 * Updates because of renamed PXP modules.
221 * Revision 1.2 2000/05/20 20:34:28 gerd
222 * Changed for UTF-8 support.
224 * Revision 1.1 2000/04/30 20:13:01 gerd
227 * Revision 1.3 1999/11/09 22:27:30 gerd
228 * The programs returns now an exit code of 1 if one of the
229 * XML files produces an error.
231 * Revision 1.2 1999/09/01 23:09:56 gerd
232 * Added the option -wf that switches to well-formedness checking
233 * instead of validation.
235 * Revision 1.1 1999/08/14 22:20:53 gerd