1#!/usr/bin/perl -w 2######################################################################## 3# test.pl - test script for XML::Writer module. 4# Copyright (c) 1999 by Megginson Technologies. 5# Copyright (c) 2004, 2005 by Joseph Walton <joe@kafsemo.org>. 6# No warranty. Commercial and non-commercial use freely permitted. 7# 8# $Id: 01_main.t,v 1.22 2005/06/30 21:57:52 josephw Exp $ 9######################################################################## 10 11# Before 'make install' is performed this script should be runnable with 12# 'make test'. After 'make install' it should work as 'perl 01_main.t' 13 14use strict; 15 16use Test::More(tests => 207); 17 18 19# Catch warnings 20my $warning; 21 22$SIG{__WARN__} = sub { 23 ($warning) = @_ unless ($warning); 24}; 25 26sub wasNoWarning($) 27{ 28 my ($reason) = @_; 29 30 if (!ok(!$warning, $reason)) { 31 diag($warning); 32 } 33} 34 35# Constants for Unicode support 36my $unicodeSkipMessage = 'Unicode only supported with Perl >= 5.8.1'; 37 38sub isUnicodeSupported() 39{ 40 return $] >= 5.008001; 41} 42 43require XML::Writer; 44 45wasNoWarning('Loading XML::Writer should not result in warnings'); 46 47use IO::File; 48 49# The XML::Writer that will be used 50my $w; 51 52my $outputFile = IO::File->new_tmpfile or die "Unable to create temporary file: $!"; 53 54# Fetch the current contents of the scratch file as a scalar 55sub getBufStr() 56{ 57 local($/); 58 binmode($outputFile, ':bytes') if isUnicodeSupported(); 59 $outputFile->seek(0, 0); 60 return <$outputFile>; 61} 62 63# Set up the environment to run a test. 64sub initEnv(@) 65{ 66 my (%args) = @_; 67 68 # Reset the scratch file 69 $outputFile->seek(0, 0); 70 $outputFile->truncate(0); 71 binmode($outputFile, ':raw'); 72 73 # Overwrite OUTPUT so it goes to the scratch file 74 $args{'OUTPUT'} = $outputFile; 75 76 # Set NAMESPACES, unless it's present 77 $args{'NAMESPACES'} = 1 unless(defined($args{'NAMESPACES'})); 78 79 undef($warning); 80 $w = new XML::Writer(%args) || die "Cannot create XML writer"; 81} 82 83# 84# Check the results in the temporary output file. 85# 86# $expected - the exact output expected 87# 88sub checkResult($$) 89{ 90 my ($expected, $explanation) = (@_); 91 92 my $actual = getBufStr(); 93 94 if ($expected eq $actual) { 95 ok(1, $explanation); 96 } else { 97 my @e = split(/\n/, $expected); 98 my @a = split(/\n/, $actual); 99 100 if (@e + @a == 2) { 101 is(getBufStr(), $expected, $explanation); 102 } else { 103 if (eval {require Algorithm::Diff;}) { 104 fail($explanation); 105 106 Algorithm::Diff::traverse_sequences( \@e, \@a, { 107 MATCH => sub { diag(" $e[$_[0]]\n"); }, 108 DISCARD_A => sub { diag("-$e[$_[0]]\n"); }, 109 DISCARD_B => sub { diag("+$a[$_[1]]\n"); } 110 }); 111 } else { 112 fail($explanation); 113 diag(" got: '$actual'\n"); 114 diag(" expected: '$expected'\n"); 115 } 116 } 117 } 118 119 wasNoWarning('(no warnings)'); 120} 121 122# 123# Expect an error of some sort, and check that the message matches. 124# 125# $pattern - a regular expression that must match the error message 126# $value - the return value from an eval{} block 127# 128sub expectError($$) { 129 my ($pattern, $value) = (@_); 130 if (!ok((!defined($value) and ($@ =~ $pattern)), "Error expected: $pattern")) 131 { 132 diag('Actual error:'); 133 if ($@) { 134 diag($@); 135 } else { 136 diag('(no error)'); 137 diag(getBufStr()); 138 } 139 } 140} 141 142# Empty element tag. 143TEST: { 144 initEnv(); 145 $w->emptyTag("foo"); 146 $w->end(); 147 checkResult("<foo />\n", 'An empty element tag'); 148}; 149 150# Empty element tag with XML decl. 151TEST: { 152 initEnv(); 153 $w->xmlDecl(); 154 $w->emptyTag("foo"); 155 $w->end(); 156 checkResult(<<"EOS", 'Empty element tag with XML declaration'); 157<?xml version="1.0"?> 158<foo /> 159EOS 160}; 161 162# A document with a public and system identifier set 163TEST: { 164 initEnv(); 165 $w->doctype('html', "-//W3C//DTD XHTML 1.1//EN", 166 "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"); 167 $w->emptyTag('html'); 168 $w->end(); 169 checkResult(<<"EOS", 'A document with a public and system identifier'); 170<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> 171<html /> 172EOS 173}; 174 175# A document with a public and system identifier set, using startTag 176TEST: { 177 initEnv(); 178 $w->doctype('html', "-//W3C//DTD XHTML 1.1//EN", 179 "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"); 180 $w->startTag('html'); 181 $w->endTag('html'); 182 $w->end(); 183 checkResult(<<"EOS", 'A document with a public and system identifier'); 184<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> 185<html></html> 186EOS 187}; 188 189# A document with a only a public identifier 190TEST: { 191 initEnv(); 192 expectError("A DOCTYPE declaration with a public ID must also have a system ID", eval { 193 $w->doctype('html', "-//W3C//DTD XHTML 1.1//EN"); 194 }); 195}; 196 197# A document with only a system identifier set 198TEST: { 199 initEnv(); 200 $w->doctype('html', undef, "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"); 201 $w->emptyTag('html'); 202 $w->end(); 203 checkResult(<<"EOS", 'A document with just a system identifier'); 204<!DOCTYPE html SYSTEM "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> 205<html /> 206EOS 207}; 208 209# Empty element tag with standalone set 210TEST: { 211 initEnv(); 212 $w->xmlDecl(undef, 'yes'); 213 $w->emptyTag("foo"); 214 $w->end(); 215 checkResult(<<"EOS", 'A document with "standalone" declared'); 216<?xml version="1.0" standalone="yes"?> 217<foo /> 218EOS 219}; 220 221# Empty element tag with standalone explicitly set to 'no' 222TEST: { 223 initEnv(); 224 $w->xmlDecl(undef, 'no'); 225 $w->emptyTag("foo"); 226 $w->end(); 227 checkResult(<<"EOS", "A document with 'standalone' declared as 'no'"); 228<?xml version="1.0" standalone="no"?> 229<foo /> 230EOS 231}; 232 233# xmlDecl with encoding set 234TEST: { 235 initEnv(); 236 $w->xmlDecl('ISO-8859-1'); 237 $w->emptyTag("foo"); 238 $w->end(); 239 checkResult(<<"EOS", 'A document with a declared encoding'); 240<?xml version="1.0" encoding="ISO-8859-1"?> 241<foo /> 242EOS 243}; 244 245# Start/end tag. 246TEST: { 247 initEnv(); 248 $w->startTag("foo"); 249 $w->endTag("foo"); 250 $w->end(); 251 checkResult("<foo></foo>\n", 'A separate start and end tag'); 252}; 253 254# Attributes 255TEST: { 256 initEnv(); 257 $w->emptyTag("foo", "x" => "1>2"); 258 $w->end(); 259 checkResult("<foo x=\"1>2\" />\n", 'Simple attributes'); 260}; 261 262# Character data 263TEST: { 264 initEnv(); 265 $w->startTag("foo"); 266 $w->characters("<tag>&</tag>"); 267 $w->endTag("foo"); 268 $w->end(); 269 checkResult("<foo><tag>&amp;</tag></foo>\n", 'Escaped character data'); 270}; 271 272# Comment outside document element 273TEST: { 274 initEnv(); 275 $w->comment("comment"); 276 $w->emptyTag("foo"); 277 $w->end(); 278 checkResult("<!-- comment -->\n<foo />\n", 'A comment outside the document element'); 279}; 280 281# Processing instruction without data (outside document element) 282TEST: { 283 initEnv(); 284 $w->pi("pi"); 285 $w->emptyTag("foo"); 286 $w->end(); 287 checkResult("<?pi?>\n<foo />\n", 'A data-less processing instruction'); 288}; 289 290# Processing instruction with data (outside document element) 291TEST: { 292 initEnv(); 293 $w->pi("pi", "data"); 294 $w->emptyTag("foo"); 295 $w->end(); 296 checkResult("<?pi data?>\n<foo />\n", 'A processing instruction with data'); 297}; 298 299# Comment inside document element 300TEST: { 301 initEnv(); 302 $w->startTag("foo"); 303 $w->comment("comment"); 304 $w->endTag("foo"); 305 $w->end(); 306 checkResult("<foo><!-- comment --></foo>\n", 'A comment inside an element'); 307}; 308 309# Processing instruction inside document element 310TEST: { 311 initEnv(); 312 $w->startTag("foo"); 313 $w->pi("pi"); 314 $w->endTag("foo"); 315 $w->end(); 316 checkResult("<foo><?pi?></foo>\n", 'A processing instruction inside an element'); 317}; 318 319# WFE for mismatched tags 320TEST: { 321 initEnv(); 322 $w->startTag("foo"); 323 expectError("Attempt to end element \"foo\" with \"bar\" tag", eval { 324 $w->endTag("bar"); 325 }); 326}; 327 328# WFE for unclosed elements 329TEST: { 330 initEnv(); 331 $w->startTag("foo"); 332 $w->startTag("foo"); 333 $w->endTag("foo"); 334 expectError("Document ended with unmatched start tag\\(s\\)", eval { 335 $w->end(); 336 }); 337}; 338 339# WFE for no document element 340TEST: { 341 initEnv(); 342 $w->xmlDecl(); 343 expectError("Document cannot end without a document element", eval { 344 $w->end(); 345 }); 346}; 347 348# WFE for multiple document elements (non-empty) 349TEST: { 350 initEnv(); 351 $w->startTag('foo'); 352 $w->endTag('foo'); 353 expectError("Attempt to insert start tag after close of", eval { 354 $w->startTag('foo'); 355 }); 356}; 357 358# WFE for multiple document elements (empty) 359TEST: { 360 initEnv(); 361 $w->emptyTag('foo'); 362 expectError("Attempt to insert empty tag after close of", eval { 363 $w->emptyTag('foo'); 364 }); 365}; 366 367# DOCTYPE mismatch with empty tag 368TEST: { 369 initEnv(); 370 $w->doctype('foo'); 371 expectError("Document element is \"bar\", but DOCTYPE is \"foo\"", eval { 372 $w->emptyTag('bar'); 373 }); 374}; 375 376# DOCTYPE mismatch with start tag 377TEST: { 378 initEnv(); 379 $w->doctype('foo'); 380 expectError("Document element is \"bar\", but DOCTYPE is \"foo\"", eval { 381 $w->startTag('bar'); 382 }); 383}; 384 385# DOCTYPE declarations 386TEST: { 387 initEnv(); 388 $w->doctype('foo'); 389 expectError("Attempt to insert second DOCTYPE", eval { 390 $w->doctype('bar'); 391 }); 392}; 393 394# Misplaced DOCTYPE declaration 395TEST: { 396 initEnv(); 397 $w->startTag('foo'); 398 expectError("The DOCTYPE declaration must come before", eval { 399 $w->doctype('foo'); 400 }); 401}; 402 403# Multiple XML declarations 404TEST: { 405 initEnv(); 406 $w->xmlDecl(); 407 expectError("The XML declaration is not the first thing", eval { 408 $w->xmlDecl(); 409 }); 410}; 411 412# Misplaced XML declaration 413TEST: { 414 initEnv(); 415 $w->comment(); 416 expectError("The XML declaration is not the first thing", eval { 417 $w->xmlDecl(); 418 }); 419}; 420 421# Implied end-tag name. 422TEST: { 423 initEnv(); 424 $w->startTag('foo'); 425 $w->endTag(); 426 $w->end(); 427 checkResult("<foo></foo>\n", 'A tag ended using an implied tag name'); 428}; 429 430# in_element query 431TEST: { 432 initEnv(); 433 $w->startTag('foo'); 434 $w->startTag('bar'); 435 ok($w->in_element('bar'), 'in_element should identify the current element'); 436}; 437 438# within_element query 439TEST: { 440 initEnv(); 441 $w->startTag('foo'); 442 $w->startTag('bar'); 443 ok($w->within_element('foo') && $w->within_element('bar'), 444 'within_element should know about all elements above us'); 445}; 446 447# current_element query 448TEST: { 449 initEnv(); 450 $w->startTag('foo'); 451 $w->startTag('bar'); 452 is($w->current_element(), 'bar', 'current_element should identify the element we are in'); 453}; 454 455# ancestor query 456TEST: { 457 initEnv(); 458 $w->startTag('foo'); 459 $w->startTag('bar'); 460 ok($w->ancestor(0) eq 'bar' && $w->ancestor(1) eq 'foo', 461 'ancestor() should match the startTag calls that have been made'); 462}; 463 464# Basic namespace processing with empty element 465TEST: { 466 initEnv(); 467 my $ns = 'http://www.foo.com/'; 468 $w->addPrefix($ns, 'foo'); 469 $w->emptyTag([$ns, 'doc']); 470 $w->end(); 471 checkResult("<foo:doc xmlns:foo=\"$ns\" />\n", 'Basic namespace processing'); 472}; 473 474# Basic namespace processing with start/end tags 475TEST: { 476 initEnv(); 477 my $ns = 'http://www.foo.com/'; 478 $w->addPrefix($ns, 'foo'); 479 $w->startTag([$ns, 'doc']); 480 $w->endTag([$ns, 'doc']); 481 $w->end(); 482 checkResult("<foo:doc xmlns:foo=\"$ns\"></foo:doc>\n", 'Basic namespace processing'); 483}; 484 485# Basic namespace processing with generated prefix 486TEST: { 487 initEnv(); 488 my $ns = 'http://www.foo.com/'; 489 $w->startTag([$ns, 'doc']); 490 $w->endTag([$ns, 'doc']); 491 $w->end(); 492 checkResult("<__NS1:doc xmlns:__NS1=\"$ns\"></__NS1:doc>\n", 493 'Basic namespace processing with a generated prefix'); 494}; 495 496# Basic namespace processing with attributes and empty tag. 497TEST: { 498 initEnv(); 499 my $ns = 'http://www.foo.com/'; 500 $w->addPrefix($ns, 'foo'); 501 $w->emptyTag([$ns, 'doc'], [$ns, 'id'] => 'x'); 502 $w->end(); 503 checkResult("<foo:doc foo:id=\"x\" xmlns:foo=\"$ns\" />\n", 504 'A namespaced element with a namespaced attribute'); 505}; 506 507# Same as above, but with default namespace. 508TEST: { 509 initEnv(); 510 my $ns = 'http://www.foo.com/'; 511 $w->addPrefix($ns, ''); 512 $w->emptyTag([$ns, 'doc'], [$ns, 'id'] => 'x'); 513 $w->end(); 514 checkResult("<doc __NS1:id=\"x\" xmlns=\"$ns\" xmlns:__NS1=\"$ns\" />\n", 515 'Same as above, but with a default namespace'); 516}; 517 518# Same as above, but passing namespace prefixes through constructor 519TEST: { 520 my $ns = 'http://www.foo.com/'; 521 initEnv(PREFIX_MAP => {$ns => ''}); 522 $w->emptyTag([$ns, 'doc'], [$ns, 'id'] => 'x'); 523 $w->end(); 524 checkResult("<doc __NS1:id=\"x\" xmlns=\"$ns\" xmlns:__NS1=\"$ns\" />\n", 525 'Same as above, but passing the prefixes through the constructor'); 526}; 527 528# Same as above, but passing namespace prefixes through constructor and 529# then removing them programatically 530TEST: { 531 my $ns = 'http://www.foo.com/'; 532 initEnv(PREFIX_MAP => {$ns => ''}); 533 $w->removePrefix($ns); 534 $w->emptyTag([$ns, 'doc'], [$ns, 'id'] => 'x'); 535 $w->end(); 536 checkResult("<__NS1:doc __NS1:id=\"x\" xmlns:__NS1=\"$ns\" />\n", 537 'Same as above, but removing the prefix before the document starts'); 538}; 539 540# Verify that removePrefix works when there is no default prefix 541TEST: { 542 my $ns = 'http://www.foo.com/'; 543 initEnv(PREFIX_MAP => {$ns => 'pfx'}); 544 $w->removePrefix($ns); 545 wasNoWarning('removePrefix should not warn when there is no default prefix'); 546} 547 548# Verify that a removed namespace prefix behaves as if it were never added 549TEST: { 550 my $ns = 'http://www.foo.com/'; 551 initEnv(PREFIX_MAP => {$ns => 'pfx', 'http://www.example.com/' => ''}); 552 $w->removePrefix($ns); 553 $w->startTag([$ns, 'x']); 554 $w->emptyTag([$ns, 'y']); 555 $w->endTag([$ns, 'x']); 556 $w->end(); 557 checkResult("<__NS1:x xmlns:__NS1=\"$ns\"><__NS1:y /></__NS1:x>\n", 558 'Same as above, but with a non-default namespace'); 559}; 560 561# Test that autogenerated prefixes avoid collision. 562TEST: { 563 initEnv(); 564 my $ns = 'http://www.foo.com/'; 565 $w->addPrefix('http://www.bar.com/', '__NS1'); 566 $w->emptyTag([$ns, 'doc']); 567 $w->end(); 568 checkResult("<__NS2:doc xmlns:__NS2=\"$ns\" />\n", 569 "Make sure that an autogenerated prefix doesn't clash"); 570}; 571 572# Check for proper declaration nesting with subtrees. 573TEST: { 574 initEnv(); 575 my $ns = 'http://www.foo.com/'; 576 $w->addPrefix($ns, 'foo'); 577 $w->startTag('doc'); 578 $w->characters("\n"); 579 $w->emptyTag([$ns, 'ptr1']); 580 $w->characters("\n"); 581 $w->emptyTag([$ns, 'ptr2']); 582 $w->characters("\n"); 583 $w->endTag('doc'); 584 $w->end(); 585 checkResult(<<"EOS", 'Check for proper declaration nesting with subtrees.'); 586<doc> 587<foo:ptr1 xmlns:foo="$ns" /> 588<foo:ptr2 xmlns:foo="$ns" /> 589</doc> 590EOS 591}; 592 593# Check for proper declaration nesting with top level. 594TEST: { 595 initEnv(); 596 my $ns = 'http://www.foo.com/'; 597 $w->addPrefix($ns, 'foo'); 598 $w->startTag([$ns, 'doc']); 599 $w->characters("\n"); 600 $w->emptyTag([$ns, 'ptr1']); 601 $w->characters("\n"); 602 $w->emptyTag([$ns, 'ptr2']); 603 $w->characters("\n"); 604 $w->endTag([$ns, 'doc']); 605 $w->end(); 606 checkResult(<<"EOS", 'Check for proper declaration nesting with top level.'); 607<foo:doc xmlns:foo="$ns"> 608<foo:ptr1 /> 609<foo:ptr2 /> 610</foo:doc> 611EOS 612}; 613 614# Check for proper default declaration nesting with subtrees. 615TEST: { 616 initEnv(); 617 my $ns = 'http://www.foo.com/'; 618 $w->addPrefix($ns, ''); 619 $w->startTag('doc'); 620 $w->characters("\n"); 621 $w->emptyTag([$ns, 'ptr1']); 622 $w->characters("\n"); 623 $w->emptyTag([$ns, 'ptr2']); 624 $w->characters("\n"); 625 $w->endTag('doc'); 626 $w->end(); 627 checkResult(<<"EOS", 'Check for proper default declaration nesting with subtrees.'); 628<doc> 629<ptr1 xmlns="$ns" /> 630<ptr2 xmlns="$ns" /> 631</doc> 632EOS 633}; 634 635# Check for proper default declaration nesting with top level. 636TEST: { 637 initEnv(); 638 my $ns = 'http://www.foo.com/'; 639 $w->addPrefix($ns, ''); 640 $w->startTag([$ns, 'doc']); 641 $w->characters("\n"); 642 $w->emptyTag([$ns, 'ptr1']); 643 $w->characters("\n"); 644 $w->emptyTag([$ns, 'ptr2']); 645 $w->characters("\n"); 646 $w->endTag([$ns, 'doc']); 647 $w->end(); 648 checkResult(<<"EOS", 'Check for proper default declaration nesting with top level.'); 649<doc xmlns="$ns"> 650<ptr1 /> 651<ptr2 /> 652</doc> 653EOS 654}; 655 656# Namespace error: attribute name beginning 'xmlns' 657TEST: { 658 initEnv(); 659 expectError("Attribute name.*begins with 'xmlns'", eval { 660 $w->emptyTag('foo', 'xmlnsxxx' => 'x'); 661 }); 662}; 663 664# Namespace error: Detect an illegal colon in a PI target. 665TEST: { 666 initEnv(); 667 expectError("PI target.*contains a colon", eval { 668 $w->pi('foo:foo'); 669 }); 670}; 671 672# Namespace error: Detect an illegal colon in an element name. 673TEST: { 674 initEnv(); 675 expectError("Element name.*contains a colon", eval { 676 $w->emptyTag('foo:foo'); 677 }); 678}; 679 680# Namespace error: Detect an illegal colon in local part of an element name. 681TEST: { 682 initEnv(); 683 expectError("Local part of element name.*contains a colon", eval { 684 my $ns = 'http://www.foo.com/'; 685 $w->emptyTag([$ns, 'foo:foo']); 686 }); 687}; 688 689# Namespace error: attribute name containing ':'. 690TEST: { 691 initEnv(); 692 expectError("Attribute name.*contains ':'", eval { 693 $w->emptyTag('foo', 'foo:bar' => 'x'); 694 }); 695}; 696 697# Namespace error: Detect a colon in the local part of an att name. 698TEST: { 699 initEnv(); 700 expectError("Local part of attribute name.*contains a colon.", eval { 701 my $ns = "http://www.foo.com/"; 702 $w->emptyTag('foo', [$ns, 'foo:bar']); 703 }); 704}; 705 706# Verify that no warning is generated when namespace prefixes are passed 707# in on construction. 708TEST: { 709 initEnv(); 710 $w->emptyTag(['uri:null', 'element']); 711 $w->end(); 712 713 wasNoWarning('No warnings should be generated during writing'); 714}; 715 716# Verify that the 'xml:' prefix is known, and that the declaration is not 717# passed through. 718# 719TEST: { 720 initEnv(); 721 $w->emptyTag('elem', ['http://www.w3.org/XML/1998/namespace', 'space'] => 'preserve'); 722 $w->end(); 723 724 if (!unlike(getBufStr(), qr/1998/, "No declaration should be generated for the 'xml:' prefix")) 725 { 726 diag(getBufStr()); 727 } 728}; 729 730# This is an API-driving test; to pass, it needs an added method to force XML 731# namespace declarations on outer elements that aren't necessarily 732# in the namespace themselves. 733TEST: { 734 initEnv(PREFIX_MAP => {'uri:test', 'test'}, 735 FORCED_NS_DECLS => ['uri:test'] 736 ); 737 738 $w->startTag('doc'); 739 $w->emptyTag(['uri:test', 'elem']); 740 $w->emptyTag(['uri:test', 'elem']); 741 $w->emptyTag(['uri:test', 'elem']); 742 $w->endTag('doc'); 743 $w->end(); 744 745 if (!unlike(getBufStr(), qr/uri:test.*uri:test/, 'An API should allow forced namespace declarations')) 746 { 747 diag(getBufStr()); 748 } 749}; 750 751# Verify that a processing instruction of 'xml-stylesheet' can be added 752# without causing a warning, as well as a PI that contains 'xml' 753# other than at the beginning, and a PI with no data 754TEST: { 755 initEnv(); 756 $w->pi('xml-stylesheet', "type='text/xsl' href='style.xsl'"); 757 $w->pi('not-reserved-by-xml-spec', ''); 758 $w->pi('pi-with-no-data'); 759 760 $w->emptyTag('x'); 761 762 $w->end(); 763 764 wasNoWarning('The test processing instructions should not cause warnings'); 765}; 766 767# Verify that a still-reserved processing instruction generates 768# a warning. 769TEST: { 770 initEnv(); 771 $w->pi('xml-reserves-this-name'); 772 773 $w->emptyTag('x'); 774 $w->end(); 775 776 ok($warning =~ "^Processing instruction target begins with 'xml'", 777 "Reserved processing instruction names should cause warnings"); 778}; 779 780# Processing instruction data may not contain '?>' 781TEST: { 782 initEnv(); 783 expectError("Processing instruction may not contain", eval { 784 $w->pi('test', 'This string is bad?>'); 785 }); 786}; 787 788# A processing instruction name may not contain '?>' 789TEST: { 790 initEnv(); 791 expectError("Processing instruction may not contain", eval { 792 $w->pi('bad-processing-instruction-bad?>'); 793 }); 794}; 795 796# A processing instruction name can't contain spaces 797TEST: { 798 initEnv(); 799 expectError("", eval { 800 $w->pi('processing instruction'); 801 }); 802}; 803 804# Verify that dataMode can be turned on and off for specific elements 805TEST: { 806 initEnv( 807 DATA_MODE => 1, 808 DATA_INDENT => 1 809 ); 810 811 ok($w->getDataMode(), 'Should be in data mode'); 812 $w->startTag('doc'); 813 $w->dataElement('data', 'This is data'); 814 $w->dataElement('empty', ''); 815 $w->emptyTag('empty'); 816 $w->startTag('mixed'); 817 $w->setDataMode(0); 818 $w->characters('This is '); 819 $w->emptyTag('mixed'); 820 ok(!$w->getDataMode(), 'Should be in mixed mode'); 821 $w->characters(' '); 822 $w->startTag('x'); 823 $w->characters('content'); 824 $w->endTag('x'); 825 $w->characters('.'); 826 $w->setDataMode(1); 827 $w->setDataIndent(5); 828 $w->endTag('mixed'); 829 is($w->getDataIndent(), 5, 'Data indent should be changeable'); 830 $w->dataElement('data', 'This is data'); 831 $w->endTag('doc'); 832 $w->end(); 833 834 checkResult(<<"EOS", 'Turning dataMode on and off whilst writing'); 835<doc> 836 <data>This is data</data> 837 <empty></empty> 838 <empty /> 839 <mixed>This is <mixed /> <x>content</x>.</mixed> 840 <data>This is data</data> 841</doc> 842EOS 843}; 844 845# Verify that DATA_MODE on its own doesn't cause warnings 846TEST: { 847 initEnv( 848 DATA_MODE => 1 849 ); 850 851 $w->startTag('doc'); 852 $w->endTag('doc'); 853 854 wasNoWarning('DATA_MODE should not cause warnings'); 855}; 856 857# Test DATA_MODE and initial spacing 858TEST: { 859 initEnv( 860 DATA_MODE => 1 861 ); 862 863 $w->emptyTag('doc'); 864 $w->end(); 865 checkResult("<doc />\n", "An empty element with DATA_MODE"); 866}; 867 868# Test DATA_MODE and initial spacing 869TEST: { 870 initEnv( 871 DATA_MODE => 1 872 ); 873 874 $w->xmlDecl(); 875 $w->emptyTag('doc'); 876 $w->end(); 877 checkResult(<<"EOS", "An empty element with DATA_MODE"); 878<?xml version="1.0"?> 879 880<doc /> 881EOS 882}; 883 884# Test DATA_MODE and initial spacing 885TEST: { 886 initEnv( 887 DATA_MODE => 1, 888 DATA_INDENT => 1 889 ); 890 891 $w->xmlDecl(); 892 $w->startTag('doc'); 893 $w->emptyTag('item'); 894 $w->endTag('doc'); 895 $w->end(); 896 checkResult(<<"EOS", "A nested element with DATA_MODE and a declaration"); 897<?xml version="1.0"?> 898 899<doc> 900 <item /> 901</doc> 902EOS 903}; 904 905# Writing without namespaces should allow colons 906TEST: { 907 initEnv(NAMESPACES => 0); 908 $w->startTag('test:doc', 'x:attr' => 'value'); 909 $w->endTag('test:doc'); 910 911 checkResult('<test:doc x:attr="value"></test:doc>', 'A namespace-less document that uses colons in names'); 912}; 913 914# Test with NEWLINES 915TEST: { 916 initEnv(NEWLINES => 1); 917 $w->startTag('test'); 918 $w->endTag('test'); 919 $w->end(); 920 921 checkResult("<test\n></test\n>\n", 'Use of the NEWLINES parameter'); 922}; 923 924# Test bad comments 925TEST: { 926 initEnv(); 927 expectError("Comment may not contain '-->'", eval { 928 $w->comment('A bad comment -->'); 929 }); 930}; 931 932# Test invadvisible comments 933TEST: { 934 initEnv(); 935 $w->comment("Comments shouldn't contain double dashes i.e., --"); 936 $w->emptyTag('x'); 937 $w->end(); 938 939 ok($warning =~ "Interoperability problem: ", 'Comments with doubled dashes should cause warnings'); 940}; 941 942# Expect to break on mixed content in data mode 943TEST: { 944 initEnv(); 945 $w->setDataMode(1); 946 $w->startTag('x'); 947 $w->characters('Text'); 948 expectError("Mixed content not allowed in data mode: element x", eval { 949 $w->startTag('x'); 950 }); 951}; 952 953# Break with mixed content with emptyTag as well 954TEST: { 955 initEnv(); 956 $w->setDataMode(1); 957 $w->startTag('x'); 958 $w->characters('Text'); 959 expectError("Mixed content not allowed in data mode: element empty", eval { 960 $w->emptyTag('empty'); 961 }); 962}; 963 964# Break with mixed content when the element is written before the characters 965TEST: { 966 initEnv(); 967 $w->setDataMode(1); 968 $w->startTag('x'); 969 $w->emptyTag('empty'); 970 expectError("Mixed content not allowed in data mode: characters", eval { 971 $w->characters('Text'); 972 }); 973}; 974 975# Break if there are two attributes with the same name 976TEST: { 977 initEnv(NAMESPACES => 0); 978 expectError("Two attributes named", eval { 979 $w->emptyTag('x', 'a' => 'First', 'a' => 'Second'); 980 }); 981}; 982 983# Break if there are two attributes with the same namespace-qualified name 984TEST: { 985 initEnv(); 986 expectError("Two attributes named", eval { 987 $w->emptyTag('x', ['x', 'a'] => 'First', ['x', 'a'] => 'Second'); 988 }); 989}; 990 991# Succeed if there are two attributes with the same local name, but 992# in different namespaces 993TEST: { 994 initEnv(); 995 $w->emptyTag('x', ['x', 'a'] => 'First', ['y', 'a'] => 'Second'); 996 checkResult('<x __NS1:a="First" __NS2:a="Second" xmlns:__NS1="x" xmlns:__NS2="y" />', 'Two attributes with the same local name, but in different namespaces'); 997}; 998 999# Check failure when characters are written outside the document 1000TEST: { 1001 initEnv(); 1002 expectError('Attempt to insert characters outside of document element', 1003 eval { 1004 $w->characters('This should fail.'); 1005 }); 1006}; 1007 1008# Make sure that closing a tag straight off fails 1009TEST: { 1010 initEnv(); 1011 expectError('End tag .* does not close any open element', eval { 1012 $w->endTag('x'); 1013 }); 1014}; 1015 1016# Use UNSAFE to allow attributes with emptyTag 1017TEST: { 1018 initEnv(UNSAFE => 1); 1019 $w->emptyTag('x', 'xml:space' => 'preserve', ['x', 'y'] => 'z'); 1020 $w->end(); 1021 checkResult("<x xml:space=\"preserve\" __NS1:y=\"z\" xmlns:__NS1=\"x\" />\n", 'Using UNSAFE to bypass the namespace system for emptyTag'); 1022}; 1023 1024# Use UNSAFE to allow attributes with startTag 1025TEST: { 1026 initEnv(UNSAFE => 1); 1027 $w->startTag('sys:element', 'xml:space' => 'preserve', ['x', 'y'] => 'z'); 1028 $w->endTag('sys:element'); 1029 $w->end(); 1030 checkResult("<sys:element xml:space=\"preserve\" __NS1:y=\"z\" xmlns:__NS1=\"x\"></sys:element>\n", 'Using UNSAFE to bypass the namespace system for startTag'); 1031}; 1032 1033# Exercise nesting and namespaces 1034TEST: { 1035 initEnv(DATA_MODE => 1, DATA_INDENT => 1); 1036 $w->startTag(['a', 'element']); 1037 $w->startTag(['a', 'element']); 1038 $w->startTag(['b', 'element']); 1039 $w->startTag(['b', 'element']); 1040 $w->startTag(['c', 'element']); 1041 $w->startTag(['d', 'element']); 1042 $w->endTag(['d', 'element']); 1043 $w->startTag(['d', 'element']); 1044 $w->endTag(['d', 'element']); 1045 $w->endTag(['c', 'element']); 1046 $w->endTag(['b', 'element']); 1047 $w->endTag(['b', 'element']); 1048 $w->endTag(['a', 'element']); 1049 $w->endTag(['a', 'element']); 1050 $w->end(); 1051 1052 checkResult(<<"EOS", "Deep-nesting, to exercise prefix management"); 1053<__NS1:element xmlns:__NS1="a"> 1054 <__NS1:element> 1055 <__NS2:element xmlns:__NS2="b"> 1056 <__NS2:element> 1057 <__NS3:element xmlns:__NS3="c"> 1058 <__NS4:element xmlns:__NS4="d"></__NS4:element> 1059 <__NS4:element xmlns:__NS4="d"></__NS4:element> 1060 </__NS3:element> 1061 </__NS2:element> 1062 </__NS2:element> 1063 </__NS1:element> 1064</__NS1:element> 1065EOS 1066}; 1067 1068# Raw output. 1069TEST: { 1070 initEnv(UNSAFE => 1); 1071 $w->startTag("foo"); 1072 $w->raw("<bar/>"); 1073 $w->endTag("foo"); 1074 $w->end(); 1075 checkResult("<foo><bar/></foo>\n", 'raw() should pass text through without escaping it'); 1076}; 1077 1078# Attempting raw output in safe mode 1079TEST: { 1080 initEnv(); 1081 $w->startTag("foo"); 1082 expectError('raw\(\) is only available when UNSAFE is set', eval { 1083 $w->raw("<bar/>"); 1084 }); 1085} 1086 1087# Inserting a CDATA section. 1088TEST: { 1089 initEnv(); 1090 $w->startTag("foo"); 1091 $w->cdata("cdata testing - test"); 1092 $w->endTag("foo"); 1093 $w->end(); 1094 checkResult("<foo><![CDATA[cdata testing - test]]></foo>\n", 1095 'cdata() should create CDATA sections'); 1096}; 1097 1098# Inserting CDATA containing CDATA delimeters ']]>'. 1099TEST: { 1100 initEnv(); 1101 $w->startTag("foo"); 1102 $w->cdata("This is a CDATA section <![CDATA[text]]>"); 1103 $w->endTag("foo"); 1104 $w->end(); 1105 checkResult("<foo><![CDATA[This is a CDATA section <![CDATA[text]]]]><![CDATA[>]]></foo>\n", 'If a CDATA section would be invalid, it should be split up'); 1106}; 1107 1108# cdataElement(). 1109TEST: { 1110 initEnv(); 1111 $w->cdataElement("foo", "hello", a => 'b'); 1112 $w->end(); 1113 checkResult(qq'<foo a="b"><![CDATA[hello]]></foo>\n', 1114 'cdataElement should produce a valid element containing a CDATA section'); 1115}; 1116 1117# Verify that writing characters using CDATA outside of an element fails 1118TEST: { 1119 initEnv(); 1120 expectError('Attempt to insert characters outside of document element', 1121 eval { 1122 $w->cdata('Test'); 1123 }); 1124}; 1125 1126# Expect to break on mixed content in data mode 1127TEST: { 1128 initEnv(); 1129 $w->setDataMode(1); 1130 $w->startTag('x'); 1131 $w->cdata('Text'); 1132 expectError("Mixed content not allowed in data mode: element x", eval { 1133 $w->startTag('x'); 1134 }); 1135}; 1136 1137# Break with mixed content when the element is written before the characters 1138TEST: { 1139 initEnv(); 1140 $w->setDataMode(1); 1141 $w->startTag('x'); 1142 $w->emptyTag('empty'); 1143 expectError("Mixed content not allowed in data mode: characters", eval { 1144 $w->cdata('Text'); 1145 }); 1146}; 1147 1148# Make sure addPrefix-caused clashes are resolved 1149TEST: { 1150 initEnv(); 1151 1152 $w->addPrefix('a', ''); 1153 $w->addPrefix('b', ''); 1154 1155 $w->startTag(['a', 'doc']); 1156 $w->emptyTag(['b', 'elem']); 1157 $w->endTag(['a', 'doc']); 1158 $w->end(); 1159 1160 checkResult(<<"EOS", 'Later addPrefix()s should override earlier ones'); 1161<__NS1:doc xmlns:__NS1="a"><elem xmlns="b" /></__NS1:doc> 1162EOS 1163}; 1164 1165# addPrefix should work in the middle of a document 1166TEST: { 1167 initEnv(); 1168 1169 $w->addPrefix('a', ''); 1170 $w->startTag(['a', 'doc']); 1171 1172 $w->addPrefix('b', ''); 1173 $w->emptyTag(['b', 'elem']); 1174 $w->endTag(['a', 'doc']); 1175 $w->end(); 1176 1177 checkResult(<<"EOS", 'addPrefix should work in the middle of a document'); 1178<doc xmlns="a"><elem xmlns="b" /></doc> 1179EOS 1180}; 1181 1182# Verify changing the default namespace 1183TEST: { 1184 initEnv( 1185 DATA_MODE => 1, 1186 DATA_INDENT => 1 1187 ); 1188 1189 $w->addPrefix('a', ''); 1190 1191 $w->startTag(['a', 'doc']); 1192 1193 $w->startTag(['b', 'elem1']); 1194 $w->emptyTag(['b', 'elem1']); 1195 $w->emptyTag(['a', 'elem2']); 1196 $w->endTag(['b', 'elem1']); 1197 1198 $w->addPrefix('b', ''); 1199 1200 $w->startTag(['b', 'elem1']); 1201 $w->emptyTag(['b', 'elem1']); 1202 $w->emptyTag(['a', 'elem2']); 1203 $w->endTag(['b', 'elem1']); 1204 1205 $w->addPrefix('a', ''); 1206 1207 $w->startTag(['b', 'elem1']); 1208 $w->emptyTag(['b', 'elem1']); 1209 $w->emptyTag(['a', 'elem2']); 1210 $w->endTag(['b', 'elem1']); 1211 1212 $w->endTag(['a', 'doc']); 1213 $w->end(); 1214 1215 checkResult(<<"EOS", 'The default namespace should be modifiable during a document'); 1216<doc xmlns="a"> 1217 <__NS1:elem1 xmlns:__NS1="b"> 1218 <__NS1:elem1 /> 1219 <elem2 /> 1220 </__NS1:elem1> 1221 <elem1 xmlns="b"> 1222 <elem1 /> 1223 <__NS1:elem2 xmlns:__NS1="a" /> 1224 </elem1> 1225 <__NS1:elem1 xmlns:__NS1="b"> 1226 <__NS1:elem1 /> 1227 <elem2 /> 1228 </__NS1:elem1> 1229</doc> 1230EOS 1231}; 1232 1233# Verify forcing namespace declarations mid-document 1234TEST: { 1235 initEnv( 1236 DATA_MODE => 1, 1237 DATA_INDENT => 1 1238 ); 1239 1240 $w->addPrefix('a', ''); 1241 1242 $w->startTag(['a', 'doc']); 1243 1244 $w->forceNSDecl('c'); 1245 $w->startTag(['b', 'elem1']); 1246 1247 $w->emptyTag(['c', 'elem3']); 1248 $w->emptyTag(['c', 'elem3']); 1249 $w->emptyTag(['c', 'elem3']); 1250 1251 $w->endTag(['b', 'elem1']); 1252 1253 $w->endTag(['a', 'doc']); 1254 $w->end(); 1255 1256 checkResult(<<"EOS", 'Namespace declarations should be forceable mid-document'); 1257<doc xmlns="a"> 1258 <__NS1:elem1 xmlns:__NS1="b" xmlns:__NS2="c"> 1259 <__NS2:elem3 /> 1260 <__NS2:elem3 /> 1261 <__NS2:elem3 /> 1262 </__NS1:elem1> 1263</doc> 1264EOS 1265}; 1266 1267# Verify that PREFIX_MAP's default prefix is not ignored when 1268# a document element is from a different namespace 1269TEST: { 1270 initEnv(PREFIX_MAP => {'uri:test', ''}, 1271 FORCED_NS_DECLS => ['uri:test'] 1272 ); 1273 1274 $w->emptyTag(['uri:test2', 'document']); 1275 1276 $w->end(); 1277 1278 checkResult(<<"EOS", 'The default namespace declaration should be present and correct when the document element belongs to a different namespace'); 1279<__NS1:document xmlns:__NS1="uri:test2" xmlns="uri:test" /> 1280EOS 1281}; 1282 1283# Without namespaces, addPrefix and removePrefix should be safe NOPs 1284TEST: { 1285 initEnv(NAMESPACES => 0); 1286 1287 $w->addPrefix('these', 'arguments', 'are', 'ignored'); 1288 $w->removePrefix('as', 'are', 'these'); 1289 1290 wasNoWarning('Prefix manipulation on a namespace-unaware instance should not warn'); 1291}; 1292 1293# Make sure that getting and setting the output stream behaves as expected 1294TEST: { 1295 initEnv(); 1296 1297 my $out = $w->getOutput(); 1298 1299 isnt($out, undef, 'Output for this fixture must be defined'); 1300 1301 $w->setOutput(\*STDERR); 1302 is($w->getOutput(), \*STDERR, 'Changing output should be reflected in a subsequent get'); 1303 1304 $w->setOutput($out); 1305 is ($w->getOutput(), $out, 'Changing output back should succeed'); 1306 1307 $w->emptyTag('x'); 1308 $w->end(); 1309 checkResult("<x />\n", 'After changing the output a document should still be generated'); 1310}; 1311 1312# Make sure that undef implies STDOUT for setOutput 1313TEST: { 1314 initEnv(); 1315 1316 $w->setOutput(); 1317 1318 is($w->getOutput(), \*STDOUT, 'If no output is given, STDOUT should be used'); 1319}; 1320 1321# Create an ill-formed document using unsafe mode 1322TEST: { 1323 initEnv(UNSAFE => 1); 1324 1325 $w->xmlDecl('us-ascii'); 1326 $w->comment("--"); 1327 $w->characters("Test\n"); 1328 $w->cdata("Test\n"); 1329 $w->doctype('y', undef, '/'); 1330 $w->emptyTag('x'); 1331 $w->end(); 1332 checkResult(<<EOR, 'Unsafe mode should not enforce validity tests.'); 1333<?xml version="1.0" encoding="us-ascii"?> 1334<!-- -- --> 1335Test 1336<![CDATA[Test 1337]]><!DOCTYPE y SYSTEM "/"> 1338<x /> 1339EOR 1340 1341}; 1342 1343# Ensure that newlines in attributes are escaped 1344TEST: { 1345 initEnv(); 1346 1347 $w->emptyTag('x', 'a' => "A\nB"); 1348 $w->end(); 1349 1350 checkResult("<x a=\"A B\" />\n", 'Newlines in attribute values should be escaped'); 1351}; 1352 1353# Make sure UTF-8 is written properly 1354SKIP: { 1355 skip $unicodeSkipMessage, 2 unless isUnicodeSupported(); 1356 1357 initEnv(ENCODING => 'utf-8', DATA_MODE => 1); 1358 1359 $w->xmlDecl(); 1360 $w->comment("\$ \x{A3} \x{20AC}"); 1361 $w->startTag('a'); 1362 $w->dataElement('b', '$'); 1363 $w->dataElement('b', "\x{A3}"); 1364 $w->dataElement('b', "\x{20AC}"); 1365 $w->startTag('c'); 1366 $w->cdata(" \$ \x{A3} \x{20AC} "); 1367 $w->endTag('c'); 1368 $w->endTag('a'); 1369 $w->end(); 1370 1371 checkResult(<<EOR, 'When requested, output should be UTF-8 encoded'); 1372<?xml version="1.0" encoding="utf-8"?> 1373<!-- \$ \x{C2}\x{A3} \x{E2}\x{82}\x{AC} --> 1374 1375<a> 1376<b>\x{24}</b> 1377<b>\x{C2}\x{A3}</b> 1378<b>\x{E2}\x{82}\x{AC}</b> 1379<c><![CDATA[ \$ \x{C2}\x{A3} \x{E2}\x{82}\x{AC} ]]></c> 1380</a> 1381EOR 1382}; 1383 1384# Capture generated XML in a scalar 1385TEST: { 1386 my $s; 1387 1388 $w = new XML::Writer(OUTPUT => \$s); 1389 $w->emptyTag('x'); 1390 $w->end(); 1391 1392 wasNoWarning('Capturing in a scalar should not cause warnings'); 1393 is($s, "<x />\n", "Output should be stored in a scalar, if one is passed"); 1394}; 1395 1396# Modify the scalar during capture 1397TEST: { 1398 my $s; 1399 1400 $w = new XML::Writer(OUTPUT => \$s); 1401 $w->startTag('foo', bar => 'baz'); 1402 is($s, "<foo bar=\"baz\">", 'Scalars should be up-to-date during writing'); 1403 1404 $s = ''; 1405 $w->dataElement('txt', 'blah'); 1406 $w->endTag('foo'); 1407 $w->end(); 1408 1409 is($s, "<txt>blah</txt></foo>\n", 'Resetting the scalar should work properly'); 1410}; 1411 1412# Ensure that ENCODING and SCALAR don't cause failure when used together 1413TEST: { 1414 my $s; 1415 1416 ok(eval {$w = new XML::Writer(OUTPUT => \$s, 1417 ENCODING => 'utf-8' 1418 );}, 'OUTPUT and ENCODING should not cause failure'); 1419} 1420 1421# Verify that unknown encodings cause failure 1422TEST: { 1423 expectError('encoding', eval { 1424 initEnv(ENCODING => 'x-unsupported-encoding'); 1425 }); 1426} 1427 1428# Make sure scalars are built up as UTF-8 (if UTF-8 is passed in) 1429SKIP: { 1430 skip $unicodeSkipMessage, 2 unless isUnicodeSupported(); 1431 1432 my $s; 1433 1434 $w = new XML::Writer(OUTPUT => \$s); 1435 1436 my $x = 'x'; 1437 utf8::upgrade($x); 1438 1439 $w->emptyTag($x); 1440 $w->end(); 1441 1442 ok(utf8::is_utf8($s), 'A storage scalar should preserve utf8-ness'); 1443 1444 1445 undef($s); 1446 $w = new XML::Writer(OUTPUT => \$s); 1447 $w->startTag('a'); 1448 $w->dataElement('x', "\$"); 1449 $w->dataElement('x', "\x{A3}"); 1450 $w->dataElement('x', "\x{20AC}"); 1451 $w->endTag('a'); 1452 $w->end(); 1453 1454 is($s, "<a><x>\$</x><x>\x{A3}</x><x>\x{20AC}</x></a>\n", 1455 'A storage scalar should work with utf8 strings'); 1456} 1457 1458# Test US-ASCII encoding 1459SKIP: { 1460 skip $unicodeSkipMessage, 7 unless isUnicodeSupported(); 1461 1462 initEnv(ENCODING => 'us-ascii', DATA_MODE => 1); 1463 1464 $w->xmlDecl(); 1465 $w->startTag('a'); 1466 $w->dataElement('x', "\$", 'a' => "\$"); 1467 $w->dataElement('x', "\x{A3}", 'a' => "\x{A3}"); 1468 $w->dataElement('x', "\x{20AC}", 'a' => "\x{20AC}"); 1469 $w->endTag('a'); 1470 $w->end(); 1471 1472 checkResult(<<'EOR', 'US-ASCII support should cover text and attributes'); 1473<?xml version="1.0" encoding="us-ascii"?> 1474 1475<a> 1476<x a="$">$</x> 1477<x a="£">£</x> 1478<x a="€">€</x> 1479</a> 1480EOR 1481 1482 1483 # Make sure non-ASCII characters that can't be represented 1484 # as references cause failure 1485 my $text = "\x{A3}"; 1486# utf8::upgrade($text); 1487 1488 initEnv(ENCODING => 'us-ascii', DATA_MODE => 1); 1489 $w->startTag('a'); 1490 $w->cdata('Text'); 1491 expectError('ASCII', eval { 1492 $w->cdata($text); 1493 }); 1494 1495 1496 initEnv(ENCODING => 'us-ascii', DATA_MODE => 1); 1497 $w->startTag('a'); 1498 $w->comment('Text'); 1499 expectError('ASCII', eval { 1500 $w->comment($text); 1501 }); 1502 1503 1504 initEnv(ENCODING => 'us-ascii', DATA_MODE => 1); 1505 expectError('ASCII', eval { 1506 $w->emptyTag("\x{DC}berpr\x{FC}fung"); 1507 }); 1508 1509 1510 # Make sure Unicode generates warnings when it makes it through 1511 # to a US-ASCII-encoded stream 1512 initEnv(ENCODING => 'us-ascii', DATA_MODE => 1, UNSAFE => 1); 1513 $w->startTag('a'); 1514 $w->cdata($text); 1515 $w->endTag('a'); 1516 $w->end(); 1517 1518 $outputFile->flush(); 1519 ok($warning && $warning =~ /does not map to ascii/, 1520 'Perl IO should warn about non-ASCII characters in output'); 1521 1522 1523 initEnv(ENCODING => 'us-ascii', DATA_MODE => 1, UNSAFE => 1); 1524 $w->startTag('a'); 1525 $w->comment($text); 1526 $w->endTag('a'); 1527 $w->end(); 1528 1529 $outputFile->flush(); 1530 ok($warning && $warning =~ /does not map to ascii/, 1531 'Perl IO should warn about non-ASCII characters in output'); 1532 1533} 1534 1535# Make sure comments are formatted in data mode 1536TEST: { 1537 initEnv(DATA_MODE => 1, DATA_INDENT => 1); 1538 1539 $w->xmlDecl(); 1540 $w->comment("Test"); 1541 $w->comment("Test"); 1542 $w->startTag("x"); 1543 $w->comment("Test 2"); 1544 $w->startTag("y"); 1545 $w->comment("Test 3"); 1546 $w->endTag("y"); 1547 $w->comment("Test 4"); 1548 $w->startTag("y"); 1549 $w->endTag("y"); 1550 $w->endTag("x"); 1551 $w->end(); 1552 $w->comment("Test 5"); 1553 1554 checkResult(<<'EOR', 'Comments should be formatted like elements when in data mode'); 1555<?xml version="1.0"?> 1556<!-- Test --> 1557<!-- Test --> 1558 1559<x> 1560 <!-- Test 2 --> 1561 <y> 1562 <!-- Test 3 --> 1563 </y> 1564 <!-- Test 4 --> 1565 <y></y> 1566</x> 1567<!-- Test 5 --> 1568EOR 1569} 1570 1571# Test characters outside the BMP 1572SKIP: { 1573 skip $unicodeSkipMessage, 4 unless isUnicodeSupported(); 1574 1575 my $s = "\x{10480}"; # U+10480 OSMANYA LETTER ALEF 1576 1577 initEnv(ENCODING => 'utf-8'); 1578 1579 $w->dataElement('x', $s); 1580 $w->end(); 1581 1582 checkResult(<<"EOR", 'Characters outside the BMP should be encoded correctly in UTF-8'); 1583<x>\xF0\x90\x92\x80</x> 1584EOR 1585 1586 initEnv(ENCODING => 'us-ascii'); 1587 1588 $w->dataElement('x', $s); 1589 $w->end(); 1590 1591 checkResult(<<'EOR', 'Characters outside the BMP should be encoded correctly in US-ASCII'); 1592<x>𐒀</x> 1593EOR 1594} 1595 1596 1597# Ensure 'ancestor' returns undef beyond the document 1598TEST: { 1599 initEnv(); 1600 1601 is($w->ancestor(0), undef, 'With no document, ancestors should be undef'); 1602 1603 $w->startTag('x'); 1604 is($w->ancestor(0), 'x', 'ancestor(0) should return the current element'); 1605 is($w->ancestor(1), undef, 'ancestor should return undef beyond the document'); 1606} 1607 1608# Don't allow undefined Unicode characters, but do allow whitespace 1609TEST: { 1610 # Test characters 1611 1612 initEnv(); 1613 1614 $w->startTag('x'); 1615 expectError('\u0000', eval { 1616 $w->characters("\x00"); 1617 }); 1618 1619 initEnv(); 1620 1621 $w->dataElement('x', "\x09\x0A\x0D "); 1622 $w->end(); 1623 1624 checkResult(<<"EOR", 'Whitespace below \u0020 is valid.'); 1625<x>\x09\x0A\x0D </x> 1626EOR 1627 1628 1629 # CDATA 1630 1631 initEnv(); 1632 $w->startTag('x'); 1633 expectError('\u0000', eval { 1634 $w->cdata("\x00"); 1635 }); 1636 1637 initEnv(); 1638 1639 $w->startTag('x'); 1640 $w->cdata("\x09\x0A\x0D "); 1641 $w->endTag('x'); 1642 $w->end(); 1643 1644 checkResult(<<"EOR", 'Whitespace below \u0020 is valid.'); 1645<x><![CDATA[\x09\x0A\x0D ]]></x> 1646EOR 1647 1648 1649 # Attribute values 1650 1651 initEnv(); 1652 expectError('\u0000', eval { 1653 $w->emptyTag('x', 'a' => "\x00"); 1654 }); 1655 1656 initEnv(); 1657 $w->emptyTag('x', 'a' => "\x09\x0A\x0D "); 1658 $w->end(); 1659 1660 # Currently, \u000A is escaped. This test is for lack of errors, 1661 # not exact serialisation, so change it if necessary. 1662 checkResult(<<"EOR", 'Whitespace below \u0020 is valid.'); 1663<x a="\x09 \x0D " /> 1664EOR 1665} 1666 1667# Unsafe mode should not enforce character validity tests 1668TEST: { 1669 initEnv(UNSAFE => 1); 1670 1671 $w->dataElement('x', "\x00"); 1672 $w->end(); 1673 checkResult(<<"EOR", 'Unsafe mode should not enforce character validity tests'); 1674<x>\x00</x> 1675EOR 1676 1677 initEnv(UNSAFE => 1); 1678 $w->startTag('x'); 1679 $w->cdata("\x00"); 1680 $w->endTag('x'); 1681 $w->end(); 1682 checkResult(<<"EOR", 'Unsafe mode should not enforce character validity tests'); 1683<x><![CDATA[\x00]]></x> 1684EOR 1685 1686 initEnv(UNSAFE => 1); 1687 $w->emptyTag('x', 'a' => "\x00"); 1688 $w->end(); 1689 checkResult(<<"EOR", 'Unsafe mode should not enforce character validity tests'); 1690<x a="\x00" /> 1691EOR 1692} 1693 1694# Cover XML declaration encoding cases 1695TEST: { 1696 # No declaration unless specified 1697 initEnv(); 1698 $w->xmlDecl(); 1699 $w->emptyTag('x'); 1700 $w->end(); 1701 1702 checkResult(<<"EOR", 'When no encoding is specified, the declaration should not include one'); 1703<?xml version="1.0"?> 1704<x /> 1705EOR 1706 1707 # An encoding specified in the constructor carries across to the declaration 1708 initEnv(ENCODING => 'us-ascii'); 1709 $w->xmlDecl(); 1710 $w->emptyTag('x'); 1711 $w->end(); 1712 1713 checkResult(<<"EOR", 'If an encoding is specified for the document, it should appear in the declaration'); 1714<?xml version="1.0" encoding="us-ascii"?> 1715<x /> 1716EOR 1717 1718 # Anything passed in the xmlDecl call should override 1719 initEnv(ENCODING => 'us-ascii'); 1720 $w->xmlDecl('utf-8'); 1721 $w->emptyTag('x'); 1722 $w->end(); 1723 checkResult(<<"EOR", 'An encoding passed to xmlDecl should override any other encoding'); 1724<?xml version="1.0" encoding="utf-8"?> 1725<x /> 1726EOR 1727 1728 # The empty string should force the omission of the decl 1729 initEnv(ENCODING => 'us-ascii'); 1730 $w->xmlDecl(''); 1731 $w->emptyTag('x'); 1732 $w->end(); 1733 checkResult(<<"EOR", 'xmlDecl should treat the empty string as instruction to omit the encoding from the declaration'); 1734<?xml version="1.0"?> 1735<x /> 1736EOR 1737} 1738 1739 1740# Free test resources 1741$outputFile->close() or die "Unable to close temporary file: $!"; 1742 17431; 1744 1745__END__ 1746