You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@xerces.apache.org by ja...@apache.org on 2005/05/28 14:17:18 UTC
svn commit: r178867 - in /xerces/xerces-p/trunk/scripts: ./ memtest-light.pl
memtest.pl xercesc-memtest.pl xmluni-output.pl
Author: jasons
Date: Sat May 28 05:17:17 2005
New Revision: 178867
URL: http://svn.apache.org/viewcvs?rev=178867&view=rev
Log:
new
Added:
xerces/xerces-p/trunk/scripts/
xerces/xerces-p/trunk/scripts/memtest-light.pl (with props)
xerces/xerces-p/trunk/scripts/memtest.pl
xerces/xerces-p/trunk/scripts/xercesc-memtest.pl
xerces/xerces-p/trunk/scripts/xmluni-output.pl
- copied unchanged from r177927, xerces/xerces-p/trunk/docs/xmluni-output.pl
Added: xerces/xerces-p/trunk/scripts/memtest-light.pl
URL: http://svn.apache.org/viewcvs/xerces/xerces-p/trunk/scripts/memtest-light.pl?rev=178867&view=auto
==============================================================================
--- xerces/xerces-p/trunk/scripts/memtest-light.pl (added)
+++ xerces/xerces-p/trunk/scripts/memtest-light.pl Sat May 28 05:17:17 2005
@@ -0,0 +1,465 @@
+#!/usr/bin/perl -w
+
+use blib;
+use XML::Xerces;
+use strict;
+use Getopt::Long;
+use Linux::MemInfo;
+use Proc::ProcessTable;
+use IO::Handle;
+use vars qw(@LEAK);
+
+my %OPTIONS;
+$OPTIONS{count} = 1000;
+$OPTIONS{iter} = 10;
+$OPTIONS{test} = 'dom';
+my $rc = GetOptions(\%OPTIONS,
+ 'file=s',
+ 'count=i',
+ 'iter=i',
+ 'test=s',
+ 'help',
+ 'validate',
+ 'leak',
+ 'schema',
+ );
+my $USAGE = <<"EOU";
+usage: $0 [required flags] [optional flags]
+ required flags:
+ --file=file_name : the XML file to parse
+ --test=name : which test to run
+
+ test names:
+ dom : use a DOM parser (default)
+ dom : use a SAX parser
+ domcreate : create a DOM tree
+ nodemap : check DOMNamedNodeMap for leaks
+ nodelist : check DOMNodeList for leaks
+ membuf : check MemBufInputSource
+ domappend : test DOMExceptions for leaks
+ domelement : test DOMExceptions for leaks (part 2)
+ xmlexcept : test XMLExceptions for leaks
+
+ optional parameters:
+ --count=num : run num iterations default = $OPTIONS{count}
+ --iter=num : # iterations to print results = $OPTIONS{iter}
+ --leak : leak memory on purpose to test the script
+ --validate : turn validation on
+ --schema : parse a W3C XML Schema file (forces --validate)
+ --help : print this message
+EOU
+
+die "$rc\n$USAGE" unless $rc;
+die $USAGE if exists $OPTIONS{help};
+
+my $xml;
+unless ($OPTIONS{test} eq 'domcreate'
+ or $OPTIONS{test} eq 'membuf'
+ or $OPTIONS{test} eq 'domelement'
+ or $OPTIONS{test} eq 'domappend'
+ or $OPTIONS{test} eq 'xmlexcept'
+ ) {
+ die "Must specify --file\n$USAGE"
+ unless exists $OPTIONS{file};
+ open(IN,$OPTIONS{file})
+ or die "Couldn't open $OPTIONS{file} for reading";
+
+ # slurp in the file
+ {
+ local $/;
+ $xml = <IN>;
+ }
+}
+
+my @tests = qw(dom
+ sax
+ sax2
+ nodemap
+ nodelist
+ domcreate
+ domappend
+ membuf
+ domelement
+ xmlexcept
+ );
+unless (grep {$OPTIONS{test} eq $_} @tests) {
+ die "Invalid test: $OPTIONS{test}, use one of: " . join(',', @tests) . "\n";
+}
+
+my $logfile = '/tmp/xerces-memtest.log';
+open(LOG,">$logfile")
+ or die "Couldn't open $logfile for reading";
+
+ # NOTICE: We must now explicitly call XMLPlatformUtils::Initialize()
+ # when the module is loaded. Xerces.pm no longer does this.
+ #
+ #
+XML::Xerces::XMLPlatformUtils::Initialize();
+
+$main::LEAK = 1
+ if exists $OPTIONS{leak};
+
+# we initialize the starting memory after running the first iteration
+my $starting_size;
+
+my $validate = 0;
+my $schema = 0;
+my $namespace = 0;
+if (exists $OPTIONS{validate}) {
+ if ($OPTIONS{test} eq 'dom') {
+ $validate = $XML::Xerces::AbstractDOMParser::Val_Always;
+ } else {
+ $validate = 1;
+ }
+}
+if (exists $OPTIONS{schema}) {
+ $validate = 1;
+ $schema = 1;
+ $namespace = 1;
+}
+
+STDOUT->autoflush();
+
+my $errorHandler = XML::Xerces::PerlErrorHandler->new() ;
+
+# Just to make sure there is only one, $Parser is global but it's not used anywhere else:
+my $dom = XML::Xerces::XercesDOMParser->new() ;
+$dom->setErrorHandler($errorHandler) ;
+$dom->setValidationScheme ($validate);
+$dom->setDoNamespaces ($namespace);
+$dom->setDoSchema ($schema);
+$dom->setValidationSchemaFullChecking ($schema);
+$dom->setValidationConstraintFatal ($validate);
+
+package MyDocumentHandler;
+use strict;
+use vars qw(@ISA);
+@ISA = qw(XML::Xerces::PerlDocumentHandler);
+
+sub start_element {
+ my ($self,$name,$attrs) = @_;
+ my $count = $attrs->getLength();
+
+ if ($main::LEAK) {
+ push(@main::LEAK,$attrs);
+ }
+}
+sub end_element {}
+
+sub characters {
+}
+sub ignorable_whitespace {
+}
+
+package main;
+
+my $sax = XML::Xerces::SAXParser->new() ;
+$sax->setErrorHandler($errorHandler) ;
+$sax->setValidationScheme ($validate);
+$sax->setDoNamespaces ($namespace);
+$sax->setDoSchema ($schema);
+$sax->setValidationSchemaFullChecking ($schema);
+$sax->setValidationConstraintFatal ($validate);
+my $handler = MyDocumentHandler->new();
+$sax->setDocumentHandler($handler);
+
+if ($OPTIONS{test} eq 'nodelist' or $OPTIONS{test} eq 'nodemap') {
+ $dom->parse($OPTIONS{file});
+}
+
+my ($domImpl,$dt);
+my $doc;
+if ($OPTIONS{test} eq 'domelement') {
+ $domImpl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
+ $doc = $domImpl->createDocument('myns', 'HISTORY', undef);
+}
+
+my $DOCUMENT = <<XML;
+<?xml version="1.0"?>
+<HISTORY xmlns="myns" xmlns:myns="myns"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xsi:schemaLocation="myns test.xsd">
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+ <RECORD ID="0" PRICE="1.1" VOL="10"/>
+</HISTORY>
+XML
+
+for (my $count=1;$count<=$OPTIONS{count};$count++) {
+ # run the loop
+
+ if ($OPTIONS{test} eq 'dom') {
+ test_dom($xml,$dom);
+ } elsif ($OPTIONS{test} eq 'sax') {
+ test_sax($sax);
+ } elsif ($OPTIONS{test} eq 'domcreate') {
+ test_dom_create();
+ } elsif ($OPTIONS{test} eq 'domelement') {
+ test_dom_create_element();
+ } elsif ($OPTIONS{test} eq 'domappend') {
+ test_dom_create_element();
+ } elsif ($OPTIONS{test} eq 'membuf') {
+ test_membuf();
+ } elsif ($OPTIONS{test} eq 'sax2') {
+ test_sax2($xml);
+ } elsif ($OPTIONS{test} eq 'xmlexcept') {
+ test_xmlexcept();
+ } elsif ($OPTIONS{test} eq 'nodelist') {
+ test_domlist($xml,$dom);
+ } elsif ($OPTIONS{test} eq 'nodemap') {
+ test_dommap($xml,$dom);
+ } else {
+ die "Unknown test $OPTIONS{test}";
+ }
+
+ if ($count % $OPTIONS{iter} == 0) {
+ my ($proc) = get_proc($$);
+ my $size = $proc->size();
+ my $leak = $size - $starting_size;
+ my $iter_leak = $leak/$count;
+ my ($size_unit,$leak_unit,$iter_unit);
+ ($size,$size_unit) = get_val_unit($size);
+ ($leak,$leak_unit) = get_val_unit($leak);
+ ($iter_leak,$iter_unit) = get_val_unit($iter_leak);
+ printf STDOUT "%d: total mem: %d%s, leaked mem: %d%s, leak/iteration:%d%s",
+ $count,
+ $size,
+ $size_unit,
+ $leak,
+ $leak_unit,
+ $iter_leak,
+ $iter_unit,
+ ;
+ printf STDOUT ", elements leaked = %d: \n", scalar @LEAK;
+ } elsif ($count == 5) {
+ my ($proc) = get_proc($$);
+ $starting_size = $proc->size();
+ printf STDOUT "starting mem: %dk\n", int($starting_size/1024);
+ }
+}
+
+END {
+ # NOTICE: We must now explicitly call XMLPlatformUtils::Terminate()
+ # when the module is unloaded. Xerces.pm no longer does this for us
+ #
+ #
+ XML::Xerces::XMLPlatformUtils::Terminate();
+}
+
+sub get_proc {
+ my $pid = shift;
+ return grep {$_->pid == $pid} @{Proc::ProcessTable->new->table};
+}
+
+sub test_dom {
+ my $xml = shift ;
+ my $parser = shift;
+
+ eval {
+ # my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parse($OPTIONS{file});
+ };
+ XML::Xerces::error($@) if $@;
+
+ if ($OPTIONS{leak}) {
+ my $doc = $parser->getDocument();
+ my $node_list = $doc->getElementsByTagName('*');
+ push(@LEAK,$node_list);
+ }
+ $parser->resetDocumentPool();
+}
+
+sub test_sax2 {
+ my $parser = XML::Xerces::XMLReaderFactory::createXMLReader() ;
+ $parser->setErrorHandler($errorHandler) ;
+
+# my $contentHandler = new XML::Xerces::PerlContentHandler() ;
+# $parser->setContentHandler($contentHandler) ;
+
+ eval {
+ $parser->setFeature($XML::Xerces::XMLUni::fgSAX2CoreNameSpaces, $namespace);
+ $parser->setFeature($XML::Xerces::XMLUni::fgXercesSchema, $schema);
+ $parser->setFeature($XML::Xerces::XMLUni::fgXercesSchemaFullChecking, $schema);
+ $parser->setFeature($XML::Xerces::XMLUni::fgXercesValidationErrorAsFatal, $validate);
+ };
+ XML::Xerces::error($@) if $@;
+
+
+ eval {
+ $parser->setFeature($XML::Xerces::XMLUni::fgSAX2CoreValidation, $validate);
+ $parser->setFeature($XML::Xerces::XMLUni::fgXercesDynamic, 0);
+ };
+ XML::Xerces::error($@) if $@;
+
+ eval {
+ # my $is = XML::Xerces::MemBufInputSource->new($xml);
+ my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parse($is) ;
+ } ;
+ XML::Xerces::error($@) if $@;
+}
+
+sub test_sax {
+ # my $parser = XML::Xerces::SAXParser->new();
+ my $parser = shift;
+
+ eval {
+ # my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parse($OPTIONS{file});
+ };
+ XML::Xerces::error($@) if $@;
+}
+
+sub test_xmlexcept {
+ my $uri = eval{XML::Xerces::XMLUri->new(undef,"")};
+ die "no error" unless $@;
+}
+
+sub test_domlist {
+ my $xml = shift ;
+ my $parser = shift;
+
+ my $doc = $parser->getDocument();
+ my $node_list = $doc->getElementsByTagName('*');
+ if ($OPTIONS{leak}) {
+ push(@LEAK,$node_list);
+ }
+}
+
+sub test_membuf {
+ my $is = eval {XML::Xerces::MemBufInputSource->new($DOCUMENT,"foo")};
+ XML::Xerces::error($@) if $@;
+ if ($OPTIONS{leak}) {
+ push(@LEAK,$is);
+ }
+}
+
+sub test_dommap {
+ my $xml = shift ;
+ my $parser = shift;
+
+ my $doc = $parser->getDocument();
+ my $root = $doc->getDocumentElement();
+ my $map = $root->getAttributes();
+ if ($OPTIONS{leak}) {
+ push(@LEAK,$map);
+ }
+}
+
+sub test_dom_create {
+ my $domImpl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
+ my $dt = eval{$domImpl->createDocumentType('x', '', '')};
+ XML::Xerces::error($@) if $@;
+ my $document = $domImpl->createDocument('myns', 'HISTORY', $dt);
+
+ # Default prefix
+ $document->getDocumentElement->setAttributeNS("http://www.w3.org/2000/xmlns/", "xmlns:myns", 'myns');
+
+ for (my $i = 0; $i < 10; $i++) {
+ my $record = $document->createElement('RECORD');
+ $document->getDocumentElement->appendChild($record);
+ $record->setAttribute('ID', '0');
+ $record->setAttribute('PRICE', '1.1');
+ $record->setAttribute('VOl', '10');
+ }
+ $document->release();
+}
+
+
+sub test_dom_create_element {
+ # my $document = shift;
+
+ my $domImpl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
+ # my $dt = eval{$domImpl->createDocumentType('x', '', '')};
+ # XML::Xerces::error($@) if $@;
+ my $document = $domImpl->createDocument('myns', 'HISTORY', undef);
+
+ my $element = eval {$document->createElement('9')};
+ die "No exception raised"
+ unless $@;
+
+ $document->release();
+}
+
+sub test_dom_append_child {
+ my $document = q[<?xml version="1.0" encoding="UTF-8"?>
+<contributors>
+ <person Role="manager">
+ <name>Mike Pogue</name>
+ <email>mpogue@us.ibm.com</email>
+ </person>
+ <person Role="developer">
+ <name>Tom Watson</name>
+ <email>rtwatson@us.ibm.com</email>
+ </person>
+ <person Role="tech writer">
+ <name>Susan Hardenbrook</name>
+ <email>susanhar@us.ibm.com</email>
+ </person>
+</contributors>];
+
+ my $DOM1 = new XML::Xerces::XercesDOMParser;
+ my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
+ $DOM1->setErrorHandler($ERROR_HANDLER);
+ my $is = eval{XML::Xerces::MemBufInputSource->new($document)};
+ XML::Xerces::error($@) if $@;
+ eval{$DOM1->parse($is)};
+ XML::Xerces::error($@) if $@;
+
+ my $DOM2 = new XML::Xerces::XercesDOMParser;
+ $DOM2->setErrorHandler($ERROR_HANDLER);
+ eval {$DOM2->parse($is)};
+ XML::Xerces::error($@) if $@;
+
+ my $doc1 = $DOM1->getDocument();
+ my $doc2 = $DOM2->getDocument();
+ my $root2 = $doc2->getDocumentElement();
+
+ # Trying to append to a DOMDocument node gives a hierarchy error
+ eval {
+ $doc1->appendChild($root2);
+ };
+ die "No exception raised"
+ unless $@;
+}
+
+
+sub get_val_unit {
+ my $val = shift;
+ my $unit;
+ if ($val > 2 * 1024) {
+ $unit = 'k';
+ $val = int($val/1024);
+ } else {
+ $unit = 'b';
+ }
+ return ($val,$unit)
+}
+
Propchange: xerces/xerces-p/trunk/scripts/memtest-light.pl
------------------------------------------------------------------------------
svn:executable = *
Added: xerces/xerces-p/trunk/scripts/memtest.pl
URL: http://svn.apache.org/viewcvs/xerces/xerces-p/trunk/scripts/memtest.pl?rev=178867&view=auto
==============================================================================
--- xerces/xerces-p/trunk/scripts/memtest.pl (added)
+++ xerces/xerces-p/trunk/scripts/memtest.pl Sat May 28 05:17:17 2005
@@ -0,0 +1,270 @@
+use blib;
+use XML::Xerces;
+use strict;
+use Getopt::Long;
+use Linux::MemInfo;
+use Proc::ProcessTable;
+use IO::Handle;
+
+my %OPTIONS;
+$OPTIONS{count} = 1000;
+$OPTIONS{test} = 'dom';
+my $rc = GetOptions(\%OPTIONS,
+ 'file=s',
+ 'count=i',
+ 'test=s',
+ 'help',
+ 'validate',
+ 'schema',
+ );
+my $USAGE = <<"EOU";
+usage: $0 [required flags] [optional flags]
+ required flags:
+ --file=file_name : the XML file to parse
+ --test=name : which test to run
+
+ test names:
+ dom : use a DOM parser (default)
+ builder : use a DOMBuilder
+ writer : test a DOMWriter
+ sax2 : use a SAX2XMLReader
+ exception : use a DOM parser to test exception handler leakage
+
+ optional parameters:
+ --count=num : run num iterations default = $OPTIONS{count}
+ --validate : turn validation on
+ --schema : parse a W3C XML Schema file (forces --validate)
+ --help : print this message
+EOU
+
+die "$rc\n$USAGE" unless $rc;
+die $USAGE if exists $OPTIONS{help};
+
+die "Must specify --file\n$USAGE"
+ unless exists $OPTIONS{file};
+
+my @tests = qw(dom sax2 builder writer exception);
+unless (grep {$OPTIONS{test} eq $_} @tests) {
+ die "Invalid test: $OPTIONS{test}, use one of: " . join(',', @tests) . "\n";
+}
+
+open(IN,$OPTIONS{file})
+ or die "Couldn't open $OPTIONS{file} for reading";
+my $logfile = '/tmp/xerces-memtest.log';
+open(LOG,">$logfile")
+ or die "Couldn't open $logfile for reading";
+
+# slurp in the file
+my $xml;
+{
+ local $/;
+ $xml = <IN>;
+}
+
+# we initialize the starting memory after running the first iteration
+my $starting_size;
+
+my $validate = 0;
+my $schema = 0;
+my $namespace = 0;
+if (exists $OPTIONS{validate}) {
+ if ($OPTIONS{test} eq 'dom') {
+ $validate = $XML::Xerces::AbstractDOMParser::Val_Always;
+ } else {
+ $validate = 1;
+ }
+}
+if (exists $OPTIONS{schema}) {
+ $validate = 1;
+ $schema = 1;
+ $namespace = 1;
+}
+
+STDERR->autoflush();
+
+my $errorHandler = XML::Xerces::PerlErrorHandler->new() ;
+my $impl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
+# Just to make sure there is only one, $Parser is global but it's not used anywhere else:
+my $dom = XML::Xerces::XercesDOMParser->new() ;
+$dom->setErrorHandler($errorHandler) ;
+$dom->setValidationScheme ($validate);
+$dom->setDoNamespaces ($namespace);
+$dom->setDoSchema ($schema);
+$dom->setValidationSchemaFullChecking ($schema);
+$dom->setValidationConstraintFatal ($validate);
+
+my $builder = $impl->createDOMBuilder($XML::Xerces::DOMImplementationLS::MODE_SYNCHRONOUS,'');
+my $writer = $impl->createDOMWriter();
+my $doc;
+if ($OPTIONS{test} eq 'writer') {
+ if ($writer->canSetFeature('format-pretty-print',1)) {
+ $writer->setFeature('format-pretty-print',1);
+ }
+ eval {$dom->parse($OPTIONS{file})};
+ XML::Xerces::error($@) if $@;
+ $doc = $dom->getDocument();
+}
+
+for (my $count=1;$count<=$OPTIONS{count};$count++) {
+ # run the loop
+ if ($OPTIONS{test} eq 'dom') {
+ test_dom($xml,$dom);
+ } elsif ($OPTIONS{test} eq 'exception') {
+ test_exception($xml,$dom);
+ } elsif ($OPTIONS{test} eq 'sax2') {
+ test_sax2($xml);
+ } elsif ($OPTIONS{test} eq 'builder') {
+ test_builder($xml,$impl);
+ } elsif ($OPTIONS{test} eq 'writer') {
+ test_writer($writer,$doc);
+ }
+ if ($count % 100 == 0) {
+ my ($proc) = get_proc($$);
+ my $size = $proc->size();
+ my $leak = $size - $starting_size;
+ my $iter_leak = $leak/$count;
+ my ($size_unit,$leak_unit,$iter_unit);
+ ($size,$size_unit) = get_val_unit($size);
+ ($leak,$leak_unit) = get_val_unit($leak);
+ ($iter_leak,$iter_unit) = get_val_unit($iter_leak);
+ printf STDERR "%d: total mem: %d%s, leaked mem: %d%s, leak/iteration:%d%s\n",
+ $count,
+ $size,
+ $size_unit,
+ $leak,
+ $leak_unit,
+ $iter_leak,
+ $iter_unit,
+ ;
+ } elsif ($count == 1) {
+ my ($proc) = get_proc($$);
+ $starting_size = $proc->size();
+ printf STDERR "starting mem: %dk\n", int($starting_size/1024);
+ }
+}
+
+sub get_proc {
+ my $pid = shift;
+ return grep {$_->pid == $pid} @{Proc::ProcessTable->new->table};
+}
+
+sub test_sax2 {
+ my $xml = shift ;
+ # Just to make sure there is only one, $Parser is global but it's not used anywhere else:
+ my $parser = XML::Xerces::XMLReaderFactory::createXMLReader() ;
+ $parser->setErrorHandler($errorHandler) ;
+
+# my $contentHandler = new XML::Xerces::PerlContentHandler() ;
+# $parser->setContentHandler($contentHandler) ;
+
+ eval {
+ $parser->setFeature("$XML::Xerces::XMLUni::fgSAX2CoreNameSpaces", $namespace);
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesSchema", $schema);
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesSchemaFullChecking", $schema);
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesValidationErrorAsFatal", $validate);
+ };
+ XML::Xerces::error($@) if $@;
+
+
+ eval {
+ $parser->setFeature("$XML::Xerces::XMLUni::fgSAX2CoreValidation", $validate);
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesDynamic", 0);
+ };
+ XML::Xerces::error($@) if $@;
+
+ eval {
+ # my $is = XML::Xerces::MemBufInputSource->new($xml);
+ my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parse($is) ;
+ } ;
+ XML::Xerces::error($@) if $@;
+}
+
+sub test_builder {
+ my $xml = shift ;
+ my $impl = shift;
+
+ my $parser = $impl->createDOMBuilder($XML::Xerces::DOMImplementationLS::MODE_SYNCHRONOUS,'');
+
+ eval {
+ $parser->setFeature("$XML::Xerces::XMLUni::fgDOMNamespaces", $namespace) ;
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesSchema", $schema) ;
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesSchemaFullChecking", $schema) ;
+ };
+ XML::Xerces::error($@) if $@;
+
+
+ eval {
+ $parser->setFeature("$XML::Xerces::XMLUni::fgDOMValidation", $validate) ;
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesValidationErrorAsFatal", $validate) ;
+ $parser->setFeature("$XML::Xerces::XMLUni::fgXercesContinueAfterFatalError", not $validate) ;
+# $parser->setFeature("$XML::Xerces::XMLUni::fgDOMValidateIfSchema", 1) ;
+ };
+ XML::Xerces::error($@) if $@;
+
+ eval {
+ # my $is = XML::Xerces::MemBufInputSource->new($xml);
+ # my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parseURI($OPTIONS{file}) ;
+ } ;
+ XML::Xerces::error($@) if $@;
+ $parser->resetDocumentPool();
+ $parser->release();
+}
+
+sub test_dom {
+ my $xml = shift ;
+ my $parser = shift;
+
+ eval {
+ # my $is = XML::Xerces::MemBufInputSource->new($xml);
+ my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parse($is) ;
+ };
+ XML::Xerces::error($@) if $@;
+ $parser->resetDocumentPool();
+}
+
+sub test_exception {
+ my $xml = shift ;
+ my $parser = shift;
+
+ eval {
+ # my $is = XML::Xerces::MemBufInputSource->new($xml);
+ my $is = XML::Xerces::LocalFileInputSource->new($OPTIONS{file});
+ $parser->parse($is) ;
+ };
+ # if we run this test with a file that raises an exception
+ # and we leave this line commented out, we will check if exceptions
+ # are leaking or not
+ # XML::Xerces::error($@) if $@;
+ $parser->resetDocumentPool();
+}
+
+sub test_writer {
+ my $writer = shift;
+ my $doc = shift;
+
+ my $impl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
+ $writer = $impl->createDOMWriter();
+
+ return;
+
+ my $target = XML::Xerces::MemBufFormatTarget->new();
+ eval{$writer->writeNode($target, $doc)};
+ XML::Xerces::error($@) if $@;
+
+ my $xml = $target->getRawBuffer();
+}
+
+sub get_val_unit {
+ my $val = shift;
+ my $unit;
+ if ($val > 2 * 1024) {
+ $unit = 'k';
+ $val = int($val/1024);
+ } else {
+ $unit = 'b';
+ }
+ return ($val,$unit)
+}
Added: xerces/xerces-p/trunk/scripts/xercesc-memtest.pl
URL: http://svn.apache.org/viewcvs/xerces/xerces-p/trunk/scripts/xercesc-memtest.pl?rev=178867&view=auto
==============================================================================
--- xerces/xerces-p/trunk/scripts/xercesc-memtest.pl (added)
+++ xerces/xerces-p/trunk/scripts/xercesc-memtest.pl Sat May 28 05:17:17 2005
@@ -0,0 +1,94 @@
+# use blib;
+use strict;
+use Getopt::Long;
+use Linux::MemInfo;
+use Proc::ProcessTable;
+use IO::Handle;
+
+my %OPTIONS;
+$OPTIONS{count} = 1000;
+$OPTIONS{dom} = 1;
+my $rc = GetOptions(\%OPTIONS,
+ 'file=s',
+ 'program=s',
+ 'help',
+ );
+my $USAGE = <<"EOU";
+usage: $0 [required flags]
+ required flags:
+ --file=file_name : the XML file to parse
+ --program=prog_name : the Xerces-C program to run
+
+ optional parameters:
+ --help : print this message
+EOU
+
+die "$rc\n$USAGE" unless $rc;
+die $USAGE if exists $OPTIONS{help};
+
+die "Must specify --program\n$USAGE"
+ unless exists $OPTIONS{program};
+
+my $logfile = '/tmp/xercesc-memtest.log';
+# open(LOG,">$logfile")
+# or die "Couldn't open $logfile for reading";
+
+# get the initial results:
+my %info = get_mem_info();
+my $starting_mem = $info{mem_free};
+
+STDERR->autoflush();
+
+my $starting_size = 0;
+my $pid;
+if ($pid = fork) {
+ print STDERR "Parent: $$, child: $pid\n";
+ while (1) {
+ sleep(1);
+ if ($starting_size) {
+ my ($proc) = get_proc($pid);
+ my $size = $proc->size();
+ my $leak = $size - $starting_size;
+ my ($size_unit,$leak_unit);
+ ($size,$size_unit) = get_val_unit($size);
+ ($leak,$leak_unit) = get_val_unit($leak);
+ printf STDERR "total mem: %d%s, leaked mem: %d%s\n",
+ $size,
+ $size_unit,
+ $leak,
+ $leak_unit,
+ ;
+ } else {
+ my ($proc) = get_proc($pid);
+ $starting_size = $proc->size();
+ printf STDERR "starting mem: %dk\n", int($starting_size/1024);
+ }
+ }
+} else {
+ print STDERR "execution loop: Parent: $$, child: $pid\n";
+ my @args = ($OPTIONS{program});
+ if (exists $OPTIONS{file}) {
+ push(@args, $OPTIONS{file});
+ }
+ # push(@args," > $logfile 2>&1");
+ exec(join(" ", @args))
+
+}
+
+sub get_val_unit {
+ my $val = shift;
+ my $unit;
+ if ($val > 2 * 1024) {
+ $unit = 'k';
+ $val = int($val/1024);
+ } else {
+ $unit = 'b';
+ }
+ return ($val,$unit)
+}
+
+sub get_proc {
+ my $pid = shift;
+ return grep {$_->pid == $pid} @{Proc::ProcessTable->new->table};
+}
+
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@xerces.apache.org
For additional commands, e-mail: commits-help@xerces.apache.org