ocaml-expat-0.9.1/0000755000175000017500000000000010462226576012775 5ustar tassitassiocaml-expat-0.9.1/doc/0000755000175000017500000000000010215043672013530 5ustar tassitassiocaml-expat-0.9.1/doc/README0000644000175000017500000000005507673414731014424 0ustar tassitassiRun "make doc" to generate the documentation ocaml-expat-0.9.1/expat.ml0000644000175000017500000001226710215043575014450 0ustar tassitassi(***********************************************************************) (* The OcamlExpat library *) (* *) (* Copyright 2002, 2003, 2004, 2005 Maas-Maarten Zeeman. All rights *) (* reserved. See LICENCE for details. *) (***********************************************************************) type expat_parser type xml_error = NONE | NO_MEMORY | SYNTAX | NO_ELEMENTS | INVALID_TOKEN | UNCLOSED_TOKEN | PARTIAL_CHAR | TAG_MISMATCH | DUPLICATE_ATTRIBUTE | JUNK_AFTER_DOC_ELEMENT | PARAM_ENTITY_REF | UNDEFINED_ENTITY | RECURSIVE_ENTITY_REF | ASYNC_ENTITY | BAD_CHAR_REF | BINARY_ENTITY_REF | ATTRIBUTE_EXTERNAL_ENTITY_REF | MISPLACED_XML_PI | UNKNOWN_ENCODING | INCORRECT_ENCODING | UNCLOSED_CDATA_SECTION | EXTERNAL_ENTITY_HANDLING | NOT_STANDALONE | UNEXPECTED_STATE | ENTITY_DECLARED_IN_PE | FEATURE_REQUIRES_XML_DTD | CANT_CHANGE_FEATURE_ONCE_PARSING exception Expat_error of xml_error external xml_error_to_string : xml_error -> string = "expat_XML_ErrorString" (* exception is currently too minimalistic (needs line-no, etc), but it's *) (* a start *) let _ = Callback.register_exception "expat_error" (Expat_error NONE) (* param entity handling *) type xml_param_entity_parsing_choice = NEVER | UNLESS_STANDALONE | ALWAYS external set_param_entity_parsing : expat_parser -> xml_param_entity_parsing_choice -> bool = "expat_XML_SetParamEntityParsing" (* return the version number of the expat library *) external expat_version : unit -> string = "expat_XML_ExpatVersion" (* calls to create a parser *) external parser_create : encoding:string option -> expat_parser = "expat_XML_ParserCreate" external parser_create_ns : encoding:string option -> separator:char -> expat_parser = "expat_XML_ParserCreateNS" external external_entity_parser_create : expat_parser -> string option -> string option -> expat_parser = "expat_XML_ExternalEntityParserCreate" (* calls needed to parse *) external parse : expat_parser -> string -> unit = "expat_XML_Parse" external parse_sub : expat_parser -> string -> int -> int -> unit = "expat_XML_ParseSub" external final : expat_parser -> unit = "expat_XML_Final" (* start element handler calls *) external set_start_element_handler : expat_parser -> (string -> (string * string) list -> unit) -> unit = "expat_XML_SetStartElementHandler" external reset_start_element_handler : expat_parser -> unit = "expat_XML_ResetStartElementHandler" (* end element handler calls *) external set_end_element_handler : expat_parser -> (string -> unit) -> unit = "expat_XML_SetEndElementHandler" external reset_end_element_handler : expat_parser -> unit = "expat_XML_ResetEndElementHandler" (* character data handler calls *) external set_character_data_handler : expat_parser -> (string -> unit) -> unit = "expat_XML_SetCharacterDataHandler" external reset_character_data_handler : expat_parser -> unit = "expat_XML_ResetCharacterDataHandler" (* processing instruction handler calls *) external set_processing_instruction_handler : expat_parser -> (string -> string -> unit) -> unit = "expat_XML_SetProcessingInstructionHandler" external reset_processing_instruction_handler : expat_parser -> unit = "expat_XML_ResetProcessingInstructionHandler" (* comment handler *) external set_comment_handler : expat_parser -> (string -> unit) -> unit = "expat_XML_SetCommentHandler" external reset_comment_handler : expat_parser -> unit = "expat_XML_ResetCommentHandler" (* start cdata handler *) external set_start_cdata_handler : expat_parser -> (unit -> unit) -> unit = "expat_XML_SetStartCDataHandler" external reset_start_cdata_handler : expat_parser -> unit = "expat_XML_ResetStartCDataHandler" (* end cdata handler *) external set_end_cdata_handler : expat_parser -> (unit -> unit) -> unit = "expat_XML_SetEndCDataHandler" external reset_end_cdata_handler : expat_parser -> unit = "expat_XML_ResetEndCDataHandler" (* default handler *) external set_default_handler : expat_parser -> (string -> unit) -> unit = "expat_XML_SetDefaultHandler" external reset_default_handler : expat_parser -> unit = "expat_XML_ResetDefaultHandler" (* external entity ref handler *) external set_external_entity_ref_handler : expat_parser -> (string option -> string option -> string -> string option -> unit) -> unit = "expat_XML_SetExternalEntityRefHandler" external reset_external_entity_ref_handler : expat_parser -> unit = "expat_XML_ResetDefaultHandler" (* some general parser query calls *) external get_current_byte_index : expat_parser -> int = "expat_XML_GetCurrentByteIndex" external get_current_column_number : expat_parser -> int = "expat_XML_GetCurrentColumnNumber" external get_current_line_number : expat_parser -> int = "expat_XML_GetCurrentLineNumber" external get_current_byte_count : expat_parser -> int = "expat_XML_GetCurrentByteCount" (* set/get base *) external get_base : expat_parser -> string option = "expat_XML_GetBase" external set_base : expat_parser -> string option -> unit = "expat_XML_SetBase" ocaml-expat-0.9.1/META0000644000175000017500000000025710162074623013441 0ustar tassitassiname = "expat" version = "0.9.0" description = "OCaml wrapper for the Expat XML parser" requires = "" archive(byte) = "expat.cma" archive(native) = "expat.cmxa" linkopts = "" ocaml-expat-0.9.1/Makefile0000644000175000017500000000416610215043575014434 0ustar tassitassi# # # Change this to match your expat installation. EXPAT_LIB=-lexpat EXPAT_LIBDIR=/usr/local/lib EXPAT_INCDIR=/usr/local/include NAME=expat OBJECTS=expat.cmo XOBJECTS=$(OBJECTS:.cmo=.cmx) C_OBJECTS=expat_stubs.o ARCHIVE=$(NAME).cma XARCHIVE=$(ARCHIVE:.cma=.cmxa) CARCHIVE_NAME=mlexpat CARCHIVE=lib$(CARCHIVE_NAME).a # Flags for the C compiler. CFLAGS=-DFULL_UNROLL -O2 -I$(EXPAT_INCDIR) OCAMLC=ocamlc OCAMLOPT=ocamlopt OCAMLDEP=ocamldep OCAMLMKLIB=ocamlmklib OCAMLDOC=ocamldoc OCAMLFIND=ocamlfind .PHONY: all all: $(ARCHIVE) .PHONY: allopt allopt: $(XARCHIVE) depend: *.c *.ml *.mli gcc -MM *.c > depend $(OCAMLDEP) *.mli *.ml >> depend ## Library creation $(CARCHIVE): $(C_OBJECTS) $(OCAMLMKLIB) -oc $(CARCHIVE_NAME) $(C_OBJECTS) \ -L$(EXPAT_LIBDIR) $(EXPAT_LIB) $(ARCHIVE): $(CARCHIVE) $(OBJECTS) $(OCAMLMKLIB) -o $(NAME) $(OBJECTS) -oc $(CARCHIVE_NAME) \ -L$(EXPAT_LIBDIR) $(EXPAT_LIB) $(XARCHIVE): $(CARCHIVE) $(XOBJECTS) $(OCAMLMKLIB) -o $(NAME) $(XOBJECTS) -oc $(CARCHIVE_NAME) \ -L$(EXPAT_LIBDIR) $(EXPAT_LIB) ## Installation .PHONY: install install: all { test ! -f $(XARCHIVE) || extra="$(XARCHIVE) $(NAME).a"; }; \ $(OCAMLFIND) install $(NAME) META $(NAME).cmi $(NAME).mli $(ARCHIVE) \ dll$(CARCHIVE_NAME).so lib$(CARCHIVE_NAME).a $$extra .PHONY: uninstall uninstall: $(OCAMLFIND) remove $(NAME) ## Documentation .PHONY: doc doc: FORCE cd doc; $(OCAMLDOC) -html -I .. ../$(NAME).mli ## Testing .PHONY: testall testall: test testopt .PHONY: test test: unittest ./unittest .PHONY: testopt testopt: unittest.opt ./unittest.opt unittest: all unittest.ml $(OCAMLFIND) ocamlc -o unittest -package oUnit -ccopt -L. -linkpkg \ $(ARCHIVE) unittest.ml unittest.opt: allopt unittest.ml $(OCAMLFIND) ocamlopt -o unittest.opt -package oUnit -ccopt -L. -linkpkg \ $(XARCHIVE) unittest.ml ## Cleaning up .PHONY: clean clean:: rm -f *~ *.cm* *.o *.a *.so doc/*.html doc/*.css depend \ unittest unittest.opt FORCE: .SUFFIXES: .ml .mli .cmo .cmi .cmx .mli.cmi: $(OCAMLC) -c $(COMPFLAGS) $< .ml.cmo: $(OCAMLC) -c $(COMPLAGS) $< .ml.cmx: $(OCAMLOPT) -c $(COMPFLAGS) $< .c.o: $(OCAMLC) -c -ccopt "$(CFLAGS)" $< include depend ocaml-expat-0.9.1/expat.mli0000644000175000017500000001355310215044250014607 0ustar tassitassi(***********************************************************************) (* The OcamlExpat library *) (* *) (* Copyright 2002, 2003, 2004, 2005 Maas-Maarten Zeeman. All rights *) (* reserved. See LICENCE for details. *) (***********************************************************************) (** The Ocaml Expat library provides an interface to the Expat XML Parser. Expat is a library, written C, for parsing XML documents. It's the underlying for Mozilla, Perl's [XML::Parser], Python's [xml.parser.expat], and other open source XML parsers. To use this library, link with [ocamlc expat.cma] or [ocamlopt expat.cmxa] @author Maas-Maarten Zeeman *) (** The type of expat parsers *) type expat_parser (** {5 Parser Creation} *) (** Create a new XML parser. If encoding is not empty, it specifies a character encoding to use for the document. This overrides the document encoding declaration. Expat has four built in encodings. [US-ASCII], [UTF-8], [UTF-16], [ISO-8859-1] *) val parser_create : encoding:string option -> expat_parser (** Create a new XML parser that has namespace processing in effect *) val parser_create_ns : encoding:string option -> separator:char -> expat_parser (** Create a new XML_Parser object for parsing an external general entity. Context is the context argument passed in a call to a external_entity_ref_handler. Other state information such as handlers, and namespace processing is inherited from the parser passed as the 1st argument. So you shouldn't need to call any of the behavior changing functions on this parser (unless you want it to act differently than the parent parser). *) val external_entity_parser_create : expat_parser -> string option -> string option -> expat_parser (** {5 Parsing} *) (** Let the parser parse a chunk of an XML document. @raise Expat_error error *) val parse : expat_parser -> string -> unit (** Let the parser parse a chunk of an XML document in a substring @raise Expat_error error *) val parse_sub : expat_parser -> string -> int -> int -> unit (** Inform the parser that the entire document has been parsed. *) val final : expat_parser -> unit (** {5 Handler Setting and Resetting} The strings that are passed to the handlers are always encoded in [UTF-8]. Your application is responsible for translation of these strings into other encodings. *) (** {6 Start element setting and resetting} *) val set_start_element_handler : expat_parser -> (string -> (string * string) list -> unit) -> unit val reset_start_element_handler : expat_parser -> unit (** {6 End element setting and resetting} *) val set_end_element_handler : expat_parser -> (string -> unit) -> unit val reset_end_element_handler : expat_parser -> unit (** {6 Character data hander setting and resetting} *) val set_character_data_handler : expat_parser -> (string -> unit) -> unit val reset_character_data_handler : expat_parser -> unit (** {6 Processing Instruction handler setting and resetting} *) val set_processing_instruction_handler : expat_parser -> (string -> string -> unit) -> unit val reset_processing_instruction_handler : expat_parser -> unit (** {6 Comment handler setting and resetting} *) val set_comment_handler : expat_parser -> (string -> unit) -> unit val reset_comment_handler : expat_parser -> unit (** {6 CData Section handler setting and resetting} *) val set_start_cdata_handler : expat_parser -> (unit -> unit) -> unit val reset_start_cdata_handler : expat_parser -> unit val set_end_cdata_handler : expat_parser -> (unit -> unit) -> unit val reset_end_cdata_handler : expat_parser -> unit (** {6 Default Handler setting and resetting} *) val set_default_handler : expat_parser -> (string -> unit) -> unit val reset_default_handler : expat_parser -> unit (** {6 External Entity Ref Handler setting and resetting} *) val set_external_entity_ref_handler : expat_parser -> (string option -> string option -> string -> string option -> unit) -> unit val reset_external_entity_ref_handler : expat_parser -> unit (** {5 Parse Position Functions} *) val get_current_byte_index : expat_parser -> int val get_current_column_number : expat_parser -> int val get_current_line_number : expat_parser -> int val get_current_byte_count : expat_parser -> int (** {5 Error Reporting} *) type xml_error = NONE | NO_MEMORY | SYNTAX | NO_ELEMENTS | INVALID_TOKEN | UNCLOSED_TOKEN | PARTIAL_CHAR | TAG_MISMATCH | DUPLICATE_ATTRIBUTE | JUNK_AFTER_DOC_ELEMENT | PARAM_ENTITY_REF | UNDEFINED_ENTITY | RECURSIVE_ENTITY_REF | ASYNC_ENTITY | BAD_CHAR_REF | BINARY_ENTITY_REF | ATTRIBUTE_EXTERNAL_ENTITY_REF | MISPLACED_XML_PI | UNKNOWN_ENCODING | INCORRECT_ENCODING | UNCLOSED_CDATA_SECTION | EXTERNAL_ENTITY_HANDLING | NOT_STANDALONE | UNEXPECTED_STATE | ENTITY_DECLARED_IN_PE | FEATURE_REQUIRES_XML_DTD | CANT_CHANGE_FEATURE_ONCE_PARSING (** Exception raised by parse function to report error conditions *) exception Expat_error of xml_error (** Converts a xml_error to a string *) val xml_error_to_string : xml_error -> string (** {5 Miscellaneous Functions} *) (** Set the base to be used for resolving relative URIs in system identifiers. *) val set_base : expat_parser -> string option -> unit (** Get the base for resolving relative URIs. *) val get_base : expat_parser -> string option (** Parameter entity handling types *) type xml_param_entity_parsing_choice = NEVER | UNLESS_STANDALONE | ALWAYS (** Enable the parsing of parameter entities *) val set_param_entity_parsing : expat_parser -> xml_param_entity_parsing_choice -> bool (** Return the Expat library version as a string (e.g. "expat_1.95.1" *) val expat_version : unit -> string ocaml-expat-0.9.1/LICENCE0000644000175000017500000000213507606616634013767 0ustar tassitassiCopyright (c) 2002, 2003 by Maas-Maarten Zeeman The package ocaml-expat is copyright by Maas-Maarten Zeeman. Permission is hereby granted, free of charge, to any person obtaining a copy of this document and the ocaml-expat software ("the Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. The Software is provided ``as is'', without warranty of any kind, express or implied, including but not limited to the warranties of merchantability, fitness for a particular purpose and noninfringement. In no event shall Maas-Maarten Zeeman be liable for any claim, damages or other liability, whether in an action of contract, tort or otherwise, arising from, out of or in connection with the Software or the use or other dealings in the software. ocaml-expat-0.9.1/README0000644000175000017500000000230110162615120013631 0ustar tassitassi The ocaml-expat library Overview Ocaml-Expat is a wrapper for the Expat XML parsing library. Expat is a library, written in C, for parsing XML documents. It's the underlying XML parser for the open source Mozilla project, Perl's XML::Parser, Python's xml.parsers.expat, and other open-source XML parsers. Installation - Edit the variables at the beginning of the Makefile to reflect the location where expat is installed on your system. The defaults are ok for Linux. - Do "make depend" and "make all" - If the Objective Caml native-code compiler is available on your platform (look for the "ocamlopt" executable), do "make allopt". - To generate the documentation, do "make doc" - (Optional) To test the library, do "make test". This requires the installation of OUnit. - (Optional) To test the library compiled with ocamlopt and ocamlc, do "make testall". This requires the installation of OUnit. - Become super-user if necessary and do "make install". This installs the library in the standard Objective Caml library directory. Documentation See the HTML documentation in doc/index.html References Expat: ocaml-expat-0.9.1/changelog0000644000175000017500000000242210162615120014627 0ustar tassitassiocaml-expat-0.9.0 - Small makefile improvements. ocaml-expat-0.1.0 - Made the installation independant of the use of ocamlopt. ocaml-expat-0.0.8 - Added findlib support ocaml-expat-0.0.7 - Add Olivier Andrieu's option handling fix, - Included XML_STATUS_OK defines required by older versions of Expat (also flagged by Olivier Andrieu) ocaml-expat-0.0.6 - Fixed a problem with the handling alloc_custom. Store_field, which is illegal. This could cause segfaults when the GC thinks it has to do something. Thanks go to Xavier Leroy. - Added a sanity check to parse_sub ocaml-expat-0.0.5 - Fixed a memory leak ocaml-expat-0.0.4 - Added support for external entity reference handling. - Made the error codes shorter by removing the redundant "XML_ERROR_". ocaml-expat-0.0.3 - Added default handler - Added cdata handlers - Added parse_sub call, which allows the parse of a substring, suggested by Alain Frisch. - Initialize handlers to Val_unit before a register_global_root ocaml-expat-0.0.2 - Add Olivier Andrieu's garbage collection, and finalization bug fix. - Enabled tests which fail with expat_1.95.5, but succeed with expat_1.95.6 (a counting problem) ocaml-expat-0.0.1 - First release of ocaml-expat ocaml-expat-0.9.1/expat_stubs.c0000644000175000017500000005652410215043575015506 0ustar tassitassi/***********************************************************************/ /* The OcamlExpat library */ /* */ /* Copyright 2002, 2003 Maas-Maarten Zeeman. All rights reserved. See */ /* LICENCE for details. */ /***********************************************************************/ /* $Id: expat_stubs.c,v 1.20 2005/03/13 14:00:29 maas Exp $ */ /* Stub code to interface Ocaml with Expat */ #include #include #include /* This is needed to support older versions of Expat 1.95.x */ #ifndef XML_STATUS_OK #define XML_STATUS_OK 1 #define XML_STATUS_ERROR 0 #endif #include #include #include #include #include #include #define XML_Parser_val(v) (*((XML_Parser *) Data_custom_val(v))) /* * Define the place where the handlers will be located inside the * handler tuple which is registered as global root. Handlers for * new functions should go here. */ enum expat_handler { EXPAT_START_ELEMENT_HANDLER, EXPAT_END_ELEMENT_HANDLER, EXPAT_CHARACTER_DATA_HANDLER, EXPAT_PROCESSING_INSTRUCTION_HANDLER, EXPAT_COMMENT_HANDLER, EXPAT_START_CDATA_HANDLER, EXPAT_END_CDATA_HANDLER, EXPAT_DEFAULT_HANDLER, EXPAT_EXTERNAL_ENTITY_REF_HANDLER, NUM_HANDLERS /* keep this at the end */ }; /* * Return None if a null string is passed as a parameter, and Some str * if a string is used. */ static value Val_option_string(const char *str) { CAMLparam0(); CAMLlocal2(some, some_str); if(str == NULL) { CAMLreturn (Val_int(0)); } else { some = alloc(1, 0); some_str = copy_string(str); Store_field(some, 0, some_str); CAMLreturn (some); } } /* * Return NULL if we have None, Some str otherwise. */ static char * String_option_val(value string_option) { if (Is_block(string_option)) return String_val(Field(string_option, 0)); return NULL; } static void xml_parser_finalize(value parser) { XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); /* The handlers are no longer needed */ *handlers = Val_unit; remove_global_root(handlers); /* Free the memory occupied by the parser */ XML_ParserFree(xml_parser); caml_stat_free(handlers); } static int xml_parser_compare(value v1, value v2) { XML_Parser p1 = XML_Parser_val(v1); XML_Parser p2 = XML_Parser_val(v2); if(p1 == p2) return 0; if(p1 < p2) return -1; return 1; } static long xml_parser_hash(value v) { return (long) XML_Parser_val(v); } static struct custom_operations xml_parser_ops = { "Expat_XML_Parser", xml_parser_finalize, xml_parser_compare, xml_parser_hash, custom_serialize_default, custom_deserialize_default }; static value create_ocaml_expat_parser(XML_Parser xml_parser) { CAMLparam0(); CAMLlocal1(parser); int i; value *handlers; /* * I don't know how to find out how much memory the parser consumes, * so I've set some figures here, which seems to do well. */ parser = alloc_custom(&xml_parser_ops, sizeof(XML_Parser), 1, 5000); XML_Parser_val(parser) = xml_parser; /* * Malloc a value for a tuple which will contain the callback * handlers and register it as global root. */ handlers = caml_stat_alloc(sizeof *handlers); *handlers = Val_unit; register_global_root(handlers); /* * Create a tuple which will hold the handlers. */ *handlers = alloc_tuple(NUM_HANDLERS); for(i = 0; i < NUM_HANDLERS; i++) { Field(*handlers, i) = Val_unit; } /* * Associate it as user data with the parser. This is possible because * a global root will not be relocated. */ XML_SetUserData(xml_parser, handlers); CAMLreturn (parser); } /* * parser_create : encoding:string option -> expat_parser = * "expat_XML_ParserCreate" */ CAMLprim value expat_XML_ParserCreate(value encoding) { return create_ocaml_expat_parser(XML_ParserCreate(String_option_val(encoding))); } /* * parser_create_ns : encoding:string option -> separator:char -> expat_parser = * "expat_XML_ParserCreateNS" */ CAMLprim value expat_XML_ParserCreateNS(value encoding, value sep) { return create_ocaml_expat_parser(XML_ParserCreateNS(String_option_val(encoding), (char) Long_val(sep))); } /* * external_entity_parser_create : expat_parser -> context:string option * -> encoding:string option -> expat_parser = * "expat_XML_ExternalEntityParserCreate" */ CAMLprim value expat_XML_ExternalEntityParserCreate(value p, value context, value encoding) { CAMLparam3(p, context, encoding); CAMLlocal1(parser); int i; value *handlers, *parent_handlers; XML_Parser xml_parser = \ XML_ExternalEntityParserCreate(XML_Parser_val(p), String_option_val(context), String_option_val(encoding)); parser = alloc_custom(&xml_parser_ops, sizeof(XML_Parser), 1, 5000); XML_Parser_val(parser) = xml_parser; /* * Malloc a value for a tuple which will contain the callback * handlers and register it as global root. */ handlers = caml_stat_alloc(sizeof *handlers); *handlers = Val_unit; register_global_root(handlers); /* * Create a tuple which will hold the handlers, and inherit the * handlers installed in the parent parser. */ parent_handlers = XML_GetUserData(xml_parser); *handlers = alloc_tuple(NUM_HANDLERS); for(i = 0; i < NUM_HANDLERS; i++) { Field(*handlers, i) = Field(*parent_handlers, i); } /* * Associate inherited handlers it as user data with the * parser. This is possible because a global root will not be * relocated. */ XML_SetUserData(xml_parser, handlers); CAMLreturn (parser); } /* * get_base : expat_parser -> string option */ CAMLprim value expat_XML_GetBase(value parser) { CAMLparam1(parser); CAMLlocal1(option); const char *base = NULL; base = XML_GetBase(XML_Parser_val(parser)); option = Val_option_string(base); CAMLreturn (option); } /* * val set_base : expat_parser -> string option -> unit */ CAMLprim value expat_XML_SetBase(value parser, value string) { CAMLparam2(parser, string); XML_SetBase(XML_Parser_val(parser), String_option_val(string)); CAMLreturn (Val_unit); } /* * external get_current_byte_index : expat_parser -> int = * "expat_XML_GetCurrentByteIndex" */ CAMLprim value expat_XML_GetCurrentByteIndex(value parser) { return Val_long(XML_GetCurrentByteIndex(XML_Parser_val(parser))); } /* * external get_current_byte_count : expat_parser -> int = * "expat_XML_GetCurrentByteCount" */ CAMLprim value expat_XML_GetCurrentByteCount(value parser) { return Val_long(XML_GetCurrentByteCount(XML_Parser_val(parser))); } /* * external get_current_column_number : expat_parser -> int = * "expat_XML_GetCurrentColumnNumber" */ CAMLprim value expat_XML_GetCurrentColumnNumber(value parser) { return Val_long(XML_GetCurrentColumnNumber(XML_Parser_val(parser))); } /* * external get_current_line_number : expat_parser -> int = * "expat_XML_GetCurrentLineNumber" */ CAMLprim value expat_XML_GetCurrentLineNumber(value parser) { return Val_long(XML_GetCurrentLineNumber(XML_Parser_val(parser))); } /* * external expat_version : unit -> string = "expat_XML_ExpatVersion" */ CAMLprim value expat_XML_ExpatVersion(value unit) { return copy_string(XML_ExpatVersion()); } /* * external set_param_entity_parsing : expat_parser -> * xml_param_entity_parsing_choice -> bool = * "expat_XML_SetParamEntityParsing" */ CAMLprim value expat_XML_SetParamEntityParsing(value parser, value choice) { CAMLparam2(parser, choice); CAMLreturn (Val_bool(XML_SetParamEntityParsing(XML_Parser_val(parser), Int_val(choice)))); } /* * external xml_error_to_string : xml_error -> string = "expat_XML_ErrorString" */ CAMLprim value expat_XML_ErrorString(value error_code) { CAMLparam1(error_code); const char *error_string = XML_ErrorString(Int_val(error_code)); /* XML_ErrorString(XML_ERROR_NONE) returns NULL, this check * will return an empty string whenever this happens. Note: * it checks for NULL, because that is the safest way. */ if (error_string == NULL) CAMLreturn (alloc_string(0)); CAMLreturn (copy_string(error_string)); } /* * Raise an expat_error exception */ static void expat_error(int error_code) { static value * expat_error_exn = NULL; if(expat_error_exn == NULL) { expat_error_exn = caml_named_value("expat_error"); if(expat_error_exn == NULL) { invalid_argument("Exception Expat_error not initialized"); } } raise_with_arg(*expat_error_exn, Val_long(error_code)); } /* * external parse : expat_parser -> string -> unit = "expat_XML_Parse" */ CAMLprim value expat_XML_Parse(value parser, value string) { CAMLparam2(parser, string); XML_Parser xml_parser = XML_Parser_val(parser); if(!XML_Parse(xml_parser, String_val(string), string_length(string), 0)) { expat_error(XML_GetErrorCode(xml_parser)); } CAMLreturn (Val_unit); } /* * external parse_sub : expat_parser -> string -> int -> int -> unit = * "expat_XML_ParseSub" */ CAMLprim value expat_XML_ParseSub(value vparser, value vstring, value voffset, value vlen) { CAMLparam2(vparser, vstring); XML_Parser parser = XML_Parser_val(vparser); int len = Int_val(vlen); int offset = Int_val(voffset); int string_len = string_length(vstring); char *string = String_val(vstring); /* sanity check on the parameters */ if((offset < 0) || (len < 0) || (offset > (string_len - len))) { invalid_argument("Expat.parse_sub"); } if(!XML_Parse(parser, string + offset, len, 0)) { expat_error(XML_GetErrorCode(parser)); } CAMLreturn (Val_unit); } /* * external final : expat_parser -> unit = "expat_XML_Final" */ CAMLprim value expat_XML_Final(value parser) { CAMLparam1(parser); XML_Parser xml_parser = XML_Parser_val(parser); if(!XML_Parse(xml_parser, NULL, 0, 1)) { expat_error(XML_GetErrorCode(xml_parser)); } CAMLreturn (Val_unit); } /* * Start element handling, setting and resetting. */ static void start_element_handler(void *user_data, const char *name, const char **attr) { CAMLparam0(); CAMLlocal5(list, cons, prev, att, tag); value *handlers = user_data; int i; list = Val_unit; prev = Val_unit; /* Create an assoc list with the attributes */ for(i = 0; attr[i]; i += 2) { /* Create a tuple */ att = alloc_tuple(2); Store_field(att, 0, copy_string(attr[i])); Store_field(att, 1, copy_string(attr[i + 1])); /* Create a cons */ cons = alloc_tuple(2); Store_field(cons, 0, att); Store_field(cons, 1, Val_unit); if(prev != Val_unit) { Store_field(prev, 1, cons); } prev = cons; if(list == Val_unit) { list = cons; } } tag = copy_string(name); callback2(Field(*handlers, EXPAT_START_ELEMENT_HANDLER), tag, list); CAMLreturn0; } static value set_start_handler(value parser, XML_StartElementHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_START_ELEMENT_HANDLER, ocaml_handler); XML_SetStartElementHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_start_element_handler : expat_parser -> * (string -> (string * string) list -> unit) -> unit = * "expat_XML_SetStartElementHandler" */ CAMLprim value expat_XML_SetStartElementHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_start_handler(parser, start_element_handler, handler)); } /* * external reset_start_element_handler : expat_parser -> unit = * "expat_XML_ResetStartElementHandler" */ CAMLprim value expat_XML_ResetStartElementHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_start_handler(parser, NULL, Val_unit)); } static void end_element_handler(void *user_data, const char *name) { value tag; value *handlers = user_data; tag = copy_string(name); callback(Field(*handlers, EXPAT_END_ELEMENT_HANDLER), tag); } static value set_end_handler(value parser, XML_EndElementHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_END_ELEMENT_HANDLER, ocaml_handler); XML_SetEndElementHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_end_element_handler : expat_parser -> (string -> unit) -> unit = * "expat_XML_SetEndElementHandler" */ CAMLprim value expat_XML_SetEndElementHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_end_handler(parser, end_element_handler, handler)); } /* * external reset_end_element_handler : expat_parser -> unit = * "expat_XML_ResetEndElementHandler" */ CAMLprim value expat_XML_ResetEndElementHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_end_handler(parser, NULL, Val_unit)); } /* * Character data handling, setting, and resetting */ static void character_data_handler(void *user_data, const char *data, int len) { CAMLparam0(); CAMLlocal1(str); value *handlers = user_data; str = alloc_string(len); memcpy(String_val(str), data, len); callback(Field(*handlers, EXPAT_CHARACTER_DATA_HANDLER), str); CAMLreturn0; } static value set_character_data_handler(value parser, XML_CharacterDataHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_CHARACTER_DATA_HANDLER, ocaml_handler); XML_SetCharacterDataHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_character_data_handler : expat_parser -> (string -> unit) -> unit = * "expat_XML_SetCharacterDataHandler" */ CAMLprim value expat_XML_SetCharacterDataHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_character_data_handler(parser, character_data_handler, handler)); } /* * external reset_end_element_handler : expat_parser -> unit = * "expat_XML_ResetEndElementHandler" */ CAMLprim value expat_XML_ResetCharacterDataHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_character_data_handler(parser, NULL, Val_unit)); } /* * Process instruction, setting and resetting */ static void processing_instruction_handler(void *user_data, const char *target, const char *data) { CAMLparam0(); CAMLlocal2(t, d); value *handlers = user_data; t = copy_string(target); d = copy_string(data); callback2(Field(*handlers, EXPAT_PROCESSING_INSTRUCTION_HANDLER), t, d); CAMLreturn0; } static value set_processing_instruction_handler(value parser, XML_ProcessingInstructionHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_PROCESSING_INSTRUCTION_HANDLER, ocaml_handler); XML_SetProcessingInstructionHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_processing_instruction_handler : expat_parser -> * (string -> string -> unit) -> unit = * "expat_XML_SetProcessingInstructionHandler" */ CAMLprim value expat_XML_SetProcessingInstructionHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_processing_instruction_handler(parser, processing_instruction_handler, handler)); } /* * external reset_processing_instruction_handler : expat_parser -> unit = * "expat_XML_ResetProcessingInstructionHandler" */ CAMLprim value expat_XML_ResetProcessingInstructionHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_processing_instruction_handler(parser, NULL, Val_unit)); } /* * Comment handler, setting and resetting */ static void comment_handler(void *user_data, const char *data) { CAMLparam0(); CAMLlocal1(d); value *handlers = user_data; d = copy_string(data); callback(Field(*handlers, EXPAT_COMMENT_HANDLER), d); CAMLreturn0; } static value set_comment_handler(value parser, XML_CommentHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_COMMENT_HANDLER, ocaml_handler); XML_SetCommentHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_comment_handler : expat_parser -> (string -> unit) -> unit = * "expat_XML_SetCommentHandler" */ CAMLprim value expat_XML_SetCommentHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_comment_handler(parser, comment_handler, handler)); } /* * external reset_comment_handler : expat_parser -> unit = * "expat_XML_ResetCommentHandler" */ CAMLprim value expat_XML_ResetCommentHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_comment_handler(parser, NULL, Val_unit)); } /* * Start CData handler, setting and resetting */ static void start_cdata_handler(void *user_data) { CAMLparam0(); value *handlers = user_data; callback(Field(*handlers, EXPAT_START_CDATA_HANDLER), Val_unit); CAMLreturn0; } static value set_start_cdata_handler(value parser, XML_StartCdataSectionHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_START_CDATA_HANDLER, ocaml_handler); XML_SetStartCdataSectionHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_start_cdata_handler : expat_parser -> (unit -> unit) -> unit = * "expat_XML_SetStartCDataHandler" */ CAMLprim value expat_XML_SetStartCDataHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_start_cdata_handler(parser, start_cdata_handler, handler)); } /* * external reset_start_cdata_handler : expat_parser -> unit = * "expat_XML_ResetStartCDataHandler" */ CAMLprim value expat_XML_ResetStartCDataHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_start_cdata_handler(parser, NULL, Val_unit)); } /* * End CData handler, setting and resetting */ static void end_cdata_handler(void *user_data) { CAMLparam0(); value *handlers = user_data; callback(Field(*handlers, EXPAT_END_CDATA_HANDLER), Val_unit); CAMLreturn0; } static value set_end_cdata_handler(value parser, XML_EndCdataSectionHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_END_CDATA_HANDLER, ocaml_handler); XML_SetEndCdataSectionHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_end_cdata_handler : expat_parser -> (unit -> unit) -> unit = * "expat_XML_SetEndCDataHandler" */ CAMLprim value expat_XML_SetEndCDataHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_end_cdata_handler(parser, end_cdata_handler, handler)); } /* * external reset_end_cdata_handler : expat_parser -> unit = * "expat_XML_ResetEndCDataHandler" */ CAMLprim value expat_XML_ResetEndCDataHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_end_cdata_handler(parser, NULL, Val_unit)); } /* * Default handler, setting and resetting */ static void default_handler(void *user_data, const char *data, int len) { CAMLparam0(); CAMLlocal1(d); value *handlers = user_data; d = alloc_string(len); memmove(String_val(d), data, len); callback(Field(*handlers, EXPAT_DEFAULT_HANDLER), d); CAMLreturn0; } static value set_default_handler(value parser, XML_DefaultHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_DEFAULT_HANDLER, ocaml_handler); XML_SetDefaultHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_default_handler : expat_parser -> (string -> unit) -> unit = * "expat_XML_SetDefaultHandler" */ CAMLprim value expat_XML_SetDefaultHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_default_handler(parser, default_handler, handler)); } /* * external reset_default_handler : expat_parser -> unit = * "expat_XML_ResetDefaultHandler" */ CAMLprim value expat_XML_ResetDefaultHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_default_handler(parser, NULL, Val_unit)); } /* * External Entity Ref handler, setting and resetting */ static int external_entity_ref_handler(XML_Parser xml_parser, const char *context, const char *base, const char *systemId, const char *publicId) { CAMLparam0(); CAMLlocal4(caml_context, caml_base, caml_systemId, caml_publicId); value *handlers = XML_GetUserData(xml_parser); value arg[4]; /* * Now put the strings into ocaml values. The parameters context, * base, and publicId are optional systemId is never optional. */ caml_context = Val_option_string(context); caml_base = Val_option_string(base); caml_systemId = copy_string(systemId); caml_publicId = Val_option_string(publicId); /* Call the callback which has more than 3 parameters */ arg[0] = caml_context; arg[1] = caml_base; arg[2] = caml_systemId; arg[3] = caml_publicId; callbackN(Field(*handlers, EXPAT_EXTERNAL_ENTITY_REF_HANDLER), 4, arg); CAMLreturn (XML_STATUS_OK); } static value set_external_entity_ref_handler(value parser, XML_ExternalEntityRefHandler c_handler, value ocaml_handler) { CAMLparam2(parser, ocaml_handler); XML_Parser xml_parser = XML_Parser_val(parser); value *handlers = XML_GetUserData(xml_parser); Store_field(*handlers, EXPAT_EXTERNAL_ENTITY_REF_HANDLER, ocaml_handler); XML_SetExternalEntityRefHandler(xml_parser, c_handler); CAMLreturn (Val_unit); } /* * external set_external_entity_ref_handler : expat_parser -> * (string option -> string option -> string -> string option -> unit) -> * unit = "expat_XML_SetExternalEntityRefHandler" */ CAMLprim value expat_XML_SetExternalEntityRefHandler(value parser, value handler) { CAMLparam2(parser, handler); CAMLreturn (set_external_entity_ref_handler(parser, external_entity_ref_handler, handler)); } /* * external reset_external_entity_ref_handler : expat_parser -> unit = * "expat_XML_ResetDefaultHandler" */ CAMLprim value expat_XML_ResetExternalEntityRefHandler(value parser) { CAMLparam1(parser); CAMLreturn (set_external_entity_ref_handler(parser, NULL, Val_unit)); } ocaml-expat-0.9.1/unittest.ml0000644000175000017500000003566010215043575015210 0ustar tassitassi(***********************************************************************) (* The OcamlExpat library *) (* *) (* Copyright 2002, 2003 Maas-Maarten Zeeman. All rights reserved. See *) (* LICENCE for details. *) (***********************************************************************) open Expat open OUnit (* All errors except XML_ERROR_NONE *) let xml_errors = [NO_MEMORY; SYNTAX; NO_ELEMENTS; INVALID_TOKEN; UNCLOSED_TOKEN; PARTIAL_CHAR; TAG_MISMATCH; DUPLICATE_ATTRIBUTE; JUNK_AFTER_DOC_ELEMENT; PARAM_ENTITY_REF; UNDEFINED_ENTITY; RECURSIVE_ENTITY_REF; ASYNC_ENTITY; BAD_CHAR_REF; BINARY_ENTITY_REF; ATTRIBUTE_EXTERNAL_ENTITY_REF; MISPLACED_XML_PI; UNKNOWN_ENCODING; INCORRECT_ENCODING; UNCLOSED_CDATA_SECTION; EXTERNAL_ENTITY_HANDLING; NOT_STANDALONE; UNEXPECTED_STATE; ENTITY_DECLARED_IN_PE; FEATURE_REQUIRES_XML_DTD; CANT_CHANGE_FEATURE_ONCE_PARSING;] ;; let (@=?) = assert_equal ~printer:string_of_int let rec loop f = function 0 -> () | n -> ignore(f ()); loop f (n - 1) let get_some = function None -> "None"; | Some s -> "Some " ^ s let suite = "expat" >::: ["expat_version" >:: (fun () -> "Unable to get expat_version" @? (expat_version () <> "") ); "xml_error_to_string" >:: (fun _ -> assert_equal "" (xml_error_to_string NONE) ~printer:(fun x-> "\"" ^ x ^ "\""); List.iter (fun e -> "did not get an error string" @? ((xml_error_to_string e) <> "")) xml_errors; ); "get_current_byte_index" >:: (fun _ -> let p = parser_create None in let byte_index = fun _ -> get_current_byte_index p in (-1) @=? (byte_index ()); parse p ""; 5 @=? (byte_index ()); parse p " "; 9 @=? (byte_index ()); parse p "blah"; 34 @=? (byte_index ()); ); (* This does not work on expat 1.95.5, but it will work with 1.95.6 *) "get_current_column_number" >:: (fun _ -> (* (Should) return the current column number *) (* Note: expat_1.95.5 returns wrong answers here *) let p = parser_create None in let column_number = fun _ -> get_current_column_number p in 0 @=? (column_number ()); parse p ""; 5 @=? (column_number ()); parse p " "; 6 @=? (column_number ()); parse p " "; 10 @=? (column_number ()); parse p ""; 16 @=? (column_number ()); parse p "\n"; 0 @=? (column_number ()); parse p ""; 6 @=? (column_number ()); ); "get_current_line_number" >:: (fun _ -> (* (Should) return the current line number *) (* expat_1.95.5 returns wrong answers here. Fixed expat_1.95.6 *) let p = parser_create None in let line_number = fun _ -> get_current_line_number p in 1 @=? (line_number ()); parse p "\n\n\n"; 4 @=? (line_number ()); ); "get_current_line_number_from_handler" >:: (fun _ -> (* Check the current line number from within the handler *) let p = parser_create None in let line_number = fun _ -> get_current_line_number p in let expected_line = ref 0 in let start_element_handler tag attrs = assert_equal !expected_line (line_number ()) ~msg:("start tag: " ^ tag) ~printer:string_of_int; in let end_element_handler tag = assert_equal !expected_line (line_number ()) ~msg:("end tag: " ^ tag) ~printer:string_of_int in set_start_element_handler p start_element_handler; set_end_element_handler p end_element_handler; expected_line := 1; parse p "\n"; expected_line := 2; parse p ""; expected_line := 4; parse p "\n\n"; expected_line := 7; parse p "\n\n\n"; !expected_line @=? (line_number ()) ); "get_current_byte_count" >:: (fun _ -> (* Returns the number of bytes in the current event. I'm not sure what it should return *) let p = parser_create None in let byte_count = fun _ -> get_current_byte_count p in 0 @=? (byte_count ()); parse p ""; 0 @=? (byte_count ()); parse p "bla bla bla"; 0 @=? (byte_count ()); parse p ":: (fun _ -> (* test the start element handler *) let p = parser_create None in let expected_start_tag = ref "" in let expected_end_tag = ref "" in let start_handler tag attrs = assert_equal !expected_start_tag tag ~msg:("start tag: " ^ tag) ~printer:(fun x -> x) in let end_handler tag = assert_equal !expected_end_tag tag ~msg:("end tag: " ^ tag) ~printer:(fun x -> x) in set_start_element_handler p start_handler; set_end_element_handler p end_handler; expected_start_tag := "a"; parse p "blah blah bla\n"; expected_start_tag := "b"; expected_end_tag := "b"; parse p " \n"; expected_start_tag := "c"; parse p " \n"; expected_end_tag := "c"; parse p " "; expected_end_tag := "a"; parse p ""; final p; ); "start element handler" >:: (fun _ -> let p = parser_create None in let buf = Buffer.create 10 in let start_handler tag attrs = Buffer.add_string buf "/"; Buffer.add_string buf tag; in set_start_element_handler p start_handler; parse p ("\n" ^ " \n" ^ " \n" ^ " \n" ^ " blah blah\n" ^ " " ^ " \n" ^ "\n"); final p; assert_equal "/a/b/c/d/e" (Buffer.contents buf) ~printer:(fun x->x)); "end element handler" >:: (fun _ -> let p = parser_create None in let buf = Buffer.create 10 in let end_handler tag = Buffer.add_string buf "/"; Buffer.add_string buf tag; in set_end_element_handler p end_handler; parse p ("\n" ^ " \n" ^ " \n" ^ " \n" ^ " blah blah\n" ^ " \n" ^ " \n" ^ "\n"); final p; assert_equal "/c/b/e/d/a" (Buffer.contents buf) ); "character data handler" >:: (fun _ -> let p = parser_create None in let buf = Buffer.create 10 in let character_data_handler data = Buffer.add_string buf data in set_character_data_handler p character_data_handler; parse p ("\n" ^ "..\n" ^ "....\n" ^ "..\n" ^ "..blah blah\n" ^ "....\n" ^ "..\n" ^ "\n"); final p; assert_equal "\n..\n....\n..\n..blah blah\n....\n..\n" (Buffer.contents buf) ~printer:String.escaped); "processing instruction handler" >:: (fun _ -> let p = parser_create None in let buf = Buffer.create 10 in let checked = ref false in let pi_handler target data = assert_equal "target" target ~printer:String.escaped; assert_equal "data" data ~printer:String.escaped; checked := true in set_processing_instruction_handler p pi_handler; parse p ("\n" ^ " \n" ^ " \n" ^ " \n" ^ " blah blah\n" ^ " \n" ^ " \n" ^ " \n" ^ "\n"); final p; "Did not receive a processing instruction." @? !checked); "start cdata handler" >:: (fun _ -> let p = parser_create None in let got_start_cdata = ref false in let start_cdata_handler _ = got_start_cdata := true in set_start_cdata_handler p start_cdata_handler; parse p ("\n" ^ " \n" ^ " \n" ^ " \n" ^ " \n" ^ " " ^ " \n" ^ " \n" ^ "\n"); final p; "Did not get a start cdata." @? !got_start_cdata); "end cdata handler" >:: (fun _ -> let p = parser_create None in let got_end_cdata = ref false in let end_cdata_handler x = got_end_cdata := true in set_end_cdata_handler p end_cdata_handler; parse p ("\n" ^ " \n" ^ " \n" ^ " \n" ^ " blah blah\n" ^ " >> blah]]>" ^ " \n" ^ " \n" ^ "\n"); final p; "Did not get an end cdata." @? !got_end_cdata ); "default handler" >:: (fun _ -> let p = parser_create None in let print_data str = (* print_string str; *) (* print_newline (); *) () in set_default_handler p print_data; parse p ("\n" ^ " \n" ^ " \n" ^ " \n" ^ " blah blah\n" ^ " >> blah]]>" ^ " \n" ^ " \n" ^ "\n"); final p; ); "external entity ref handler" >:: (fun _ -> let p = parser_create None in let print_data tag str = print_string tag; print_string str; print_newline () in let buf = Buffer.create 10 in let add_string = Buffer.add_string in let external_entity_handler context base system_id public_id = let p_e = external_entity_parser_create p context None in parse p_e ("\n" ^ ""); final p_e; add_string buf "#"; add_string buf (get_some context); add_string buf "#"; add_string buf (get_some base); add_string buf "#"; add_string buf system_id; add_string buf "#"; add_string buf (get_some public_id); add_string buf "#"; in ignore (set_param_entity_parsing p ALWAYS); set_external_entity_ref_handler p external_entity_handler; parse p ("\n" ^ "\n" ^ "> &entity;"); final p; assert_equal "#None#None#fry#Some frizzle#" (Buffer.contents buf) ~printer:(fun x -> x)); "external entity ref handler 2" >:: (fun _ -> let p = parser_create None in let buf = Buffer.create 10 in let add_string = Buffer.add_string in let external_entity_handler context base system_id public_id = add_string buf "#"; add_string buf (get_some context); add_string buf "#"; add_string buf (get_some base); add_string buf "#"; add_string buf system_id; add_string buf "#"; add_string buf (get_some public_id); add_string buf "#"; in ignore (set_param_entity_parsing p ALWAYS); set_external_entity_ref_handler p external_entity_handler; parse p ("\n" ^ "\n" ^ "]>\n" ^ "\n" ^ "&en;\n" ^ ""); final p; assert_equal ("#None#None#http://xml.libexpat.org/doc.dtd#None#" ^ "#Some en#None#http://xml.libexpat.org/entity.ent#None#") (Buffer.contents buf) ~printer:(fun x -> x) ); "parse_sub" >:: (fun _ -> let p = parser_create None in let buf = Buffer.create 10 in let store_data str = Buffer.add_string buf "#"; Buffer.add_string buf str; Buffer.add_string buf "#"; in set_default_handler p store_data; let str = "blah blah" in parse_sub p str 0 10; parse_sub p str 10 10; parse_sub p str 20 10; parse_sub p str 30 8; final p; assert_equal "###########bla##h blah#######" (Buffer.contents buf) ~printer:(fun x->x) ); "parse_sub wrong input" >:: (fun _ -> let p = parser_create None in let check_raises_Invalid_arg f = try f(); assert_string("No invalid_arg raised") with Invalid_argument(s) -> () in check_raises_Invalid_arg (fun _ -> parse_sub p "" (-1) 0); check_raises_Invalid_arg (fun _ -> parse_sub p "" 0 (-1)); check_raises_Invalid_arg (fun _ -> parse_sub p "" 0 1)); "set/get base" >:: (fun _ -> let p = parser_create None in assert_equal None (get_base p); set_base p (Some "This is the base"); assert_equal (Some "This is the base") (get_base p); set_base p None; assert_equal None (get_base p) ); "simple garbage collection test" >:: (fun _ -> let rec create_and_collect_garbage = function 0 -> Gc.full_major () | n -> let a = Array.init n (fun x -> String.create ((x + 2) * 200)) in let out = open_out "/dev/null" in Array.iter (fun str -> output_string out str) a; close_out out; create_and_collect_garbage (n - 1) in let do_stuff _ = let p1 = parser_create None in let p2 = parser_create None in let dummy_handler _ s = create_and_collect_garbage 13 in let external_entity_handler a b c d = create_and_collect_garbage 14 in set_start_element_handler p1 dummy_handler; set_start_element_handler p2 dummy_handler; set_end_element_handler p1 (dummy_handler ()); set_end_element_handler p2 (dummy_handler ()); set_character_data_handler p1 (dummy_handler ()); set_character_data_handler p2 (dummy_handler ()); set_default_handler p1 (dummy_handler ()); set_default_handler p2 (dummy_handler ()); ignore (set_param_entity_parsing p1 ALWAYS); ignore (set_param_entity_parsing p2 ALWAYS); set_external_entity_ref_handler p1 external_entity_handler; set_external_entity_ref_handler p2 external_entity_handler; List.iter (fun str -> parse p1 str; create_and_collect_garbage 23; parse p2 str; create_and_collect_garbage 31) ["\n"; "\n"; ""; ""; ""; "This is a bit of data"; "and an &entity;"; ""; ""; ""]; create_and_collect_garbage 13; final p1; create_and_collect_garbage 17; final p2; in (* This is not fool-proof, but I do not know another way to test if the memory management is implemented correctly. The strategy is to deliberately force some garbage collections here, if everything keeps running, then there is at least not something obviously wrong. *) loop do_stuff 10 ); "another garbage collection test" >:: (fun _ -> let parse _ = let stack = Stack.create () in let start_handler str attrs = Stack.push str stack; List.iter (fun (x, y) -> Stack.push x stack; Stack.push y stack) attrs in let character_data_handler str = Stack.push str stack in let p1 = parser_create None in set_start_element_handler p1 start_handler; set_character_data_handler p1 character_data_handler; let buflen = 1024 in let buf = String.create buflen in let xml_spec = open_in "/home/maas/xml-samples/REC-xml-19980210.xml.txt" in let rec parse _ = let n = input xml_spec buf 0 buflen in if (n > 0) then (Expat.parse_sub p1 buf 0 n; parse ()) in parse (); Expat.final p1; close_in xml_spec in loop parse 10 ); ];; let _ = run_test_tt_main suite