summaryrefslogtreecommitdiff
path: root/rt/t/api
diff options
context:
space:
mode:
Diffstat (limited to 'rt/t/api')
-rw-r--r--rt/t/api/attachment.t3
-rw-r--r--rt/t/api/canonical_charset.t3
-rw-r--r--rt/t/api/cfsearch.t106
-rw-r--r--rt/t/api/i18n_guess.t2
-rw-r--r--rt/t/api/menu.t85
-rw-r--r--rt/t/api/password-types.t6
-rw-r--r--rt/t/api/template-parsing.t306
-rw-r--r--rt/t/api/transaction.t52
-rw-r--r--rt/t/api/uri-canonicalize.t54
9 files changed, 607 insertions, 10 deletions
diff --git a/rt/t/api/attachment.t b/rt/t/api/attachment.t
index 8b7cb608b..52e3c3f16 100644
--- a/rt/t/api/attachment.t
+++ b/rt/t/api/attachment.t
@@ -58,10 +58,9 @@ is ($#headers, 2, "testing a bunch of singline multiple headers" );
my $mime = $attachment->ContentAsMIME;
like( $mime->head->get('Content-Type'),
qr/charset="iso-8859-1"/, 'content type of ContentAsMIME is original' );
- require Encode;
is(
Encode::decode( 'iso-8859-1', $mime->stringify_body ),
- Encode::decode( 'utf8', "Håvard\n" ),
+ Encode::decode( 'UTF-8', "Håvard\n" ),
'body of ContentAsMIME is original'
);
}
diff --git a/rt/t/api/canonical_charset.t b/rt/t/api/canonical_charset.t
index a426d89b6..86c3e97b3 100644
--- a/rt/t/api/canonical_charset.t
+++ b/rt/t/api/canonical_charset.t
@@ -3,7 +3,6 @@ use strict;
use RT::Test nodata => 1, tests => 11;
use RT::I18N;
-use Encode;
my %map = (
'euc-cn' => 'gbk',
@@ -22,7 +21,7 @@ for my $charset ( keys %map ) {
my $mime = MIME::Entity->build(
Type => 'text/plain; charset=gb2312',
- Data => [encode('gbk', decode_utf8("法新社倫敦11日電"))],
+ Data => [Encode::encode("gbk", Encode::decode( "UTF-8", "法新社倫敦11日電"))],
);
RT::I18N::SetMIMEEntityToUTF8($mime);
diff --git a/rt/t/api/cfsearch.t b/rt/t/api/cfsearch.t
new file mode 100644
index 000000000..7a460ce2e
--- /dev/null
+++ b/rt/t/api/cfsearch.t
@@ -0,0 +1,106 @@
+use strict;
+use warnings;
+
+use RT::Test tests => 18;
+
+my $suffix = '-'. $$;
+
+use_ok 'RT::Users';
+use_ok 'RT::CustomField';
+
+my $u1 = RT::User->new( RT->SystemUser );
+isa_ok( $u1, 'RT::User' );
+ok( $u1->Load('root'), "Loaded user 'root'" );
+
+# create cf
+my $cfname = 'TestUserCF'. $suffix;
+my $cf = RT::CustomField->new( RT->SystemUser );
+isa_ok( $cf, 'RT::CustomField' );
+
+{
+ my ($id, $msg) = $cf->Create(
+ Name => $cfname,
+ LookupType => 'RT::User',
+ Type => 'Freeform',
+ Description => 'Freeform CF for tests',
+ );
+ ok( $id, "Created cf '$cfname' - " . $msg );
+}
+
+{
+ my ($status, $msg) = $cf->AddToObject( $u1 );
+ ok( $status, "Added CF to user object - " . $msg);
+}
+
+my $cfvalue1 = 'Foo';
+
+{
+ my ($id, $msg) = $u1->AddCustomFieldValue(
+ Field => $cfname,
+ Value => $cfvalue1,
+ RecordTransaction => 0 );
+ ok( $id, "Adding CF value '$cfvalue1' - " . $msg );
+}
+
+# Confirm value is returned.
+{
+ my $cf_value_ref = QueryCFValue( $cfvalue1, $cf->id );
+ is( scalar(@$cf_value_ref), 1, 'Got one value.' );
+ is( $cf_value_ref->[0], 'Foo', 'Got Foo back for value.' );
+}
+
+{
+ my ($id, $msg) = $u1->DeleteCustomFieldValue(
+ Field => $cfname,
+ Value => $cfvalue1,
+ RecordTransaction => 0 );
+ ok( $id, "Deleting CF value - " . $msg );
+}
+
+my $cfvalue2 = 'Bar';
+{
+ my ($id, $msg) = $u1->AddCustomFieldValue(
+ Field => $cfname,
+ Value => $cfvalue2,
+ RecordTransaction => 0 );
+ ok( $id, "Adding second CF value '$cfvalue2' - " . $msg );
+}
+
+# Confirm no value is returned for Foo.
+{
+ # Calling with $cfvalue1 on purpose to confirm
+ # it has been disabled by the delete above.
+
+ my $cf_value_ref = QueryCFValue( $cfvalue1, $cf->id );
+ is( scalar(@$cf_value_ref), 0, 'No values returned for Foo.' );
+}
+
+# Confirm value is returned for Bar.
+{
+ my $cf_value_ref = QueryCFValue( $cfvalue2, $cf->id );
+ is( scalar(@$cf_value_ref), 1, 'Got one value.' );
+ is( $cf_value_ref->[0], 'Bar', 'Got Bar back for value.' );
+}
+
+
+sub QueryCFValue{
+ my $cf_value = shift;
+ my $cf_id = shift;
+ my @cf_value_strs;
+
+ my $users = RT::Users->new(RT->SystemUser);
+ isa_ok( $users, 'RT::Users' );
+
+ $users->LimitCustomField(
+ CUSTOMFIELD => $cf_id,
+ OPERATOR => "=",
+ VALUE => $cf_value );
+
+ while ( my $filtered_user = $users->Next() ){
+ my $cf_values = $filtered_user->CustomFieldValues($cf->id);
+ while (my $cf_value = $cf_values->Next() ){
+ push @cf_value_strs, $cf_value->Content;
+ }
+ }
+ return \@cf_value_strs;
+}
diff --git a/rt/t/api/i18n_guess.t b/rt/t/api/i18n_guess.t
index 956cb1505..a64b2952c 100644
--- a/rt/t/api/i18n_guess.t
+++ b/rt/t/api/i18n_guess.t
@@ -4,8 +4,6 @@ use warnings;
use RT::Test tests => 16;
-use Encode qw(encode);
-
use constant HAS_ENCODE_GUESS => do { local $@; eval { require Encode::Guess; 1 } };
use constant HAS_ENCODE_DETECT => do { local $@; eval { require Encode::Detect::Detector; 1 } };
diff --git a/rt/t/api/menu.t b/rt/t/api/menu.t
new file mode 100644
index 000000000..a9cda69c7
--- /dev/null
+++ b/rt/t/api/menu.t
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+use RT::Interface::Web::Menu;
+
+sub child_path_is($$$) {
+ my ($menu, $child, $expected) = @_;
+ my $c = $menu->child($child->[0], path => $child->[1]);
+ is $c->path, $expected, "'$child->[1]' normalizes to '$expected'";
+ return $c;
+}
+
+{
+ package FakeRequest;
+ sub new { bless {}, shift }
+ sub path_info { "" }
+
+ package FakeInterp;
+ require CGI;
+ sub new { bless {}, shift }
+ sub cgi_object { CGI->new }
+}
+
+local $HTML::Mason::Commands::r = FakeRequest->new;
+local $HTML::Mason::Commands::m = FakeInterp->new;
+
+my $menu = RT::Interface::Web::Menu->new;
+ok $menu, "Created top level menu";
+
+child_path_is $menu, [search => "Search/Simple.html"], "/Search/Simple.html";
+child_path_is $menu, [absolute => "/Prefs/Other.html"], "/Prefs/Other.html";
+child_path_is $menu, [scheme => "http://example.com"], "http://example.com";
+
+my $tools =
+ child_path_is $menu, [tools => "/Tools/"], "/Tools/";
+ child_path_is $tools, [myday => "MyDay.html"], "/Tools/MyDay.html";
+ child_path_is $tools, [activity => "/Activity.html"], "/Activity.html";
+ my $ext =
+ child_path_is $tools, [external => "http://example.com"], "http://example.com";
+ child_path_is $ext, [wiki => "wiki/"], "http://example.com/wiki/";
+
+# Pathological case of multiplying slashes
+my $home =
+ child_path_is $menu, [home => "/"], "/";
+ child_path_is $home, [slash => "/"], "/";
+ child_path_is $home, [empty => ""], "/";
+
+
+
+sub order_ok($$;$) {
+ my ($menu, $expected, $name) = @_;
+ my @children = $menu->children;
+
+ is scalar @children, scalar @$expected, "correct number of children";
+ is_deeply [map { $_->key } @children], $expected, $name;
+
+ my $last_child = shift @children; # first child's sort doesn't matter
+ for (@children) {
+ ok $_->sort_order > $last_child->sort_order, sprintf "%s order higher than %s's", $_->key, $last_child->key;
+ $last_child = $_;
+ }
+}
+
+$menu = RT::Interface::Web::Menu->new;
+
+ok $menu->child("foo", title => "foo"), "added child foo";
+order_ok $menu, [qw(foo)], "sorted";
+
+ok $menu->child("foo")->add_after("bar", title => "bar"), "added child bar after foo";
+order_ok $menu, [qw(foo bar)], "sorted after";
+
+ok $menu->child("bar")->add_before("baz", title => "baz"), "added child baz before bar";
+order_ok $menu, [qw(foo baz bar)], "sorted before (in between)";
+
+ok $menu->child("bat", title => "bat", sort_order => 2.2), "added child bat between baz and bar";
+order_ok $menu, [qw(foo baz bat bar)], "sorted between manually";
+
+ok $menu->child("bat")->add_before("pre", title => "pre"), "added child pre before bat";
+order_ok $menu, [qw(foo baz pre bat bar)], "sorted between (before)";
+
+ok $menu->child("bat")->add_after("post", title => "post"), "added child post after bat";
+order_ok $menu, [qw(foo baz pre bat post bar)], "sorted between (after)";
+
+done_testing;
diff --git a/rt/t/api/password-types.t b/rt/t/api/password-types.t
index 10a874a3d..4cb634248 100644
--- a/rt/t/api/password-types.t
+++ b/rt/t/api/password-types.t
@@ -3,8 +3,6 @@ use warnings;
use RT::Test;
use Digest::MD5;
-use Encode 'encode_utf8';
-use utf8;
my $default = "sha512";
@@ -43,9 +41,9 @@ like($root->__Value("Password"), qr/^\!$default\!/, "And is now upgraded to salt
# Non-ASCII salted truncated SHA-256
my $non_ascii_trunc = MIME::Base64::encode_base64(
- "salt" . substr(Digest::SHA::sha256("salt".Digest::MD5::md5(encode_utf8("áěšý"))),0,26),
+ "salt" . substr(Digest::SHA::sha256("salt".Digest::MD5::md5("áěšý")),0,26),
""
);
$root->_Set( Field => "Password", Value => $non_ascii_trunc);
-ok($root->IsPassword("áěšý"), "Unsalted MD5 base64 works");
+ok($root->IsPassword(Encode::decode("UTF-8", "áěšý")), "Unsalted MD5 base64 works");
like($root->__Value("Password"), qr/^\!$default\!/, "And is now upgraded to salted $default");
diff --git a/rt/t/api/template-parsing.t b/rt/t/api/template-parsing.t
new file mode 100644
index 000000000..455b84d27
--- /dev/null
+++ b/rt/t/api/template-parsing.t
@@ -0,0 +1,306 @@
+use strict;
+use warnings;
+use RT;
+use RT::Test tests => 266;
+use Test::Warn;
+
+my $queue = RT::Queue->new(RT->SystemUser);
+$queue->Load("General");
+
+my $ticket_cf = RT::CustomField->new(RT->SystemUser);
+$ticket_cf->Create(
+ Name => 'Department',
+ Queue => '0',
+ Type => 'FreeformSingle',
+);
+
+my $txn_cf = RT::CustomField->new(RT->SystemUser);
+$txn_cf->Create(
+ Name => 'Category',
+ LookupType => RT::Transaction->CustomFieldLookupType,
+ Type => 'FreeformSingle',
+);
+$txn_cf->AddToObject($queue);
+
+my $ticket = RT::Ticket->new(RT->SystemUser);
+my ($id, $msg) = $ticket->Create(
+ Subject => "template testing",
+ Queue => "General",
+ Owner => 'root@localhost',
+ Requestor => ["dom\@example.com"],
+ "CustomField-" . $txn_cf->id => "Special",
+);
+ok($id, "Created ticket: $msg");
+my $txn = $ticket->Transactions->First;
+
+$ticket->AddCustomFieldValue(
+ Field => 'Department',
+ Value => 'Coolio',
+);
+
+TemplateTest(
+ Content => "\ntest",
+ PerlOutput => "test",
+ SimpleOutput => "test",
+);
+
+TemplateTest(
+ Content => "\ntest { 5 * 5 }",
+ PerlOutput => "test 25",
+ SimpleOutput => "test { 5 * 5 }",
+);
+
+TemplateTest(
+ Content => "\ntest { \$Requestor }",
+ PerlOutput => "test dom\@example.com",
+ SimpleOutput => "test dom\@example.com",
+);
+
+TemplateTest(
+ Content => "\ntest { \$TicketSubject }",
+ PerlOutput => "test ",
+ SimpleOutput => "test template testing",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketQueueId }",
+ Output => "test 1",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketQueueName }",
+ Output => "test General",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketOwnerId }",
+ Output => "test 12",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketOwnerName }",
+ Output => "test root",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketOwnerEmailAddress }",
+ Output => "test root\@localhost",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketStatus }",
+ Output => "test new",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest #{ \$TicketId }",
+ Output => "test #" . $ticket->id,
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketCFDepartment }",
+ Output => "test Coolio",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest #{ \$TransactionId }",
+ Output => "test #" . $txn->id,
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TransactionType }",
+ Output => "test Create",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TransactionCFCategory }",
+ Output => "test Special",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$TicketDelete }",
+ Output => "test { \$TicketDelete }",
+);
+
+SimpleTemplateTest(
+ Content => "\ntest { \$Nonexistent }",
+ Output => "test { \$Nonexistent }",
+);
+
+warning_like {
+ TemplateTest(
+ Content => "\ntest { \$Ticket->Nonexistent }",
+ PerlOutput => undef,
+ SimpleOutput => "test { \$Ticket->Nonexistent }",
+ );
+} qr/RT::Ticket::Nonexistent Unimplemented/;
+
+warning_like {
+ TemplateTest(
+ Content => "\ntest { \$Nonexistent->Nonexistent }",
+ PerlOutput => undef,
+ SimpleOutput => "test { \$Nonexistent->Nonexistent }",
+ );
+} qr/Can't call method "Nonexistent" on an undefined value/;
+
+TemplateTest(
+ Content => "\ntest { \$Ticket->OwnerObj->Name }",
+ PerlOutput => "test root",
+ SimpleOutput => "test { \$Ticket->OwnerObj->Name }",
+);
+
+warning_like {
+ TemplateTest(
+ Content => "\ntest { *!( }",
+ SyntaxError => 1,
+ PerlOutput => undef,
+ SimpleOutput => "test { *!( }",
+ );
+} qr/Template parsing error: syntax error/;
+
+TemplateTest(
+ Content => "\ntest { \$rtname ",
+ SyntaxError => 1,
+ PerlOutput => undef,
+ SimpleOutput => undef,
+);
+
+is($ticket->Status, 'new', "test setup");
+SimpleTemplateTest(
+ Content => "\ntest { \$Ticket->SetStatus('resolved') }",
+ Output => "test { \$Ticket->SetStatus('resolved') }",
+);
+is($ticket->Status, 'new', "simple templates can't call ->SetStatus");
+
+note "test arguments passing";
+{
+ PerlTemplateTest(
+ Content => "\ntest { \$Nonexistent }",
+ Output => "test ",
+ );
+ PerlTemplateTest(
+ Content => "\ntest { \$Nonexistent }",
+ Arguments => { Nonexistent => 'foo' },
+ Output => "test foo",
+ );
+
+ PerlTemplateTest(
+ Content => "\n".'array: { join ", ", @array }',
+ Arguments => { array => [qw(foo bar)] },
+ Output => "array: foo, bar",
+ );
+ PerlTemplateTest(
+ Content => "\n".'hash: { join ", ", map "$_ => $hash{$_}", sort keys %hash }',
+ Arguments => { hash => {1 => 2, a => 'b'} },
+ Output => "hash: 1 => 2, a => b",
+ );
+ PerlTemplateTest(
+ Content => "\n".'code: { code() }',
+ Arguments => { code => sub { "baz" } },
+ Output => "code: baz",
+ );
+}
+
+# Make sure changing the template's type works
+{
+ my $template = RT::Template->new(RT->SystemUser);
+ $template->Create(
+ Name => "type chameleon",
+ Type => "Perl",
+ Content => "\ntest { 10 * 7 }",
+ );
+ ok($id = $template->id, "Created template");
+ $template->Parse;
+ is($template->MIMEObj->stringify_body, "test 70", "Perl output");
+
+ $template = RT::Template->new(RT->SystemUser);
+ $template->Load($id);
+ is($template->Name, "type chameleon");
+
+ $template->SetType('Simple');
+ $template->Parse;
+ is($template->MIMEObj->stringify_body, "test { 10 * 7 }", "Simple output");
+
+ $template = RT::Template->new(RT->SystemUser);
+ $template->Load($id);
+ is($template->Name, "type chameleon");
+
+ $template->SetType('Perl');
+ $template->Parse;
+ is($template->MIMEObj->stringify_body, "test 70", "Perl output");
+}
+
+undef $ticket;
+
+my $counter = 0;
+sub IndividualTemplateTest {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ my %args = (
+ Name => "Test-" . ++$counter,
+ Type => "Perl",
+ @_,
+ );
+
+ my $t = RT::Template->new(RT->SystemUser);
+ $t->Create(
+ Name => $args{Name},
+ Type => $args{Type},
+ Content => $args{Content},
+ );
+
+ ok($t->id, "Created $args{Type} template");
+ is($t->Name, $args{Name}, "$args{Type} template name");
+ is($t->Content, $args{Content}, "$args{Type} content");
+ is($t->Type, $args{Type}, "template type");
+
+ # this should never blow up!
+ my ($ok, $msg) = $t->CompileCheck;
+
+ # we don't need to syntax check simple templates since if you mess them up
+ # it's safe to just use the input directly as the template's output
+ if ($args{SyntaxError} && $args{Type} eq 'Perl') {
+ ok(!$ok, "got a syntax error");
+ }
+ else {
+ ok($ok, $msg);
+ }
+
+ ($ok, $msg) = $t->Parse(
+ $args{'Arguments'}
+ ? ( %{ $args{'Arguments'} } )
+ : (TicketObj => $ticket, TransactionObj => $txn )
+ ,
+ );
+ if (defined $args{Output}) {
+ ok($ok, $msg);
+ is($t->MIMEObj->stringify_body, $args{Output}, "$args{Type} template's output");
+ }
+ else {
+ ok(!$ok, "expected a failure");
+ }
+}
+
+sub TemplateTest {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my %args = @_;
+
+ for my $type ('Perl', 'Simple') {
+ IndividualTemplateTest(
+ %args,
+ Type => $type,
+ Output => $args{$type . 'Output'},
+ );
+ }
+}
+
+sub SimpleTemplateTest {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ IndividualTemplateTest( @_, Type => 'Simple' );
+}
+
+sub PerlTemplateTest {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ IndividualTemplateTest( @_, Type => 'Perl' );
+}
+
diff --git a/rt/t/api/transaction.t b/rt/t/api/transaction.t
new file mode 100644
index 000000000..22c3cfe72
--- /dev/null
+++ b/rt/t/api/transaction.t
@@ -0,0 +1,52 @@
+
+use strict;
+use warnings;
+use RT;
+use RT::Test tests => undef;
+use Test::Warn;
+
+use_ok ('RT::Transaction');
+
+{
+ my $u = RT::User->new(RT->SystemUser);
+ $u->Load("root");
+ ok ($u->Id, "Found the root user");
+ ok(my $t = RT::Ticket->new(RT->SystemUser));
+ my ($id, $msg) = $t->Create( Queue => 'General',
+ Subject => 'Testing',
+ Owner => $u->Id
+ );
+ ok($id, "Create new ticket $id");
+ isnt($id , 0);
+
+ my $txn = RT::Transaction->new(RT->SystemUser);
+ my ($txn_id, $txn_msg) = $txn->Create(
+ Type => 'AddLink',
+ Field => 'RefersTo',
+ Ticket => $id,
+ NewValue => 'ticket 42', );
+ ok( $txn_id, "Created transaction $txn_id: $txn_msg");
+
+ my $brief;
+ warning_like { $brief = $txn->BriefDescription }
+ qr/Could not determine a URI scheme/,
+ "Caught URI warning";
+
+ is( $brief, 'Reference to ticket 42 added', "Got string description: $brief");
+
+ $txn = RT::Transaction->new(RT->SystemUser);
+ ($txn_id, $txn_msg) = $txn->Create(
+ Type => 'DeleteLink',
+ Field => 'RefersTo',
+ Ticket => $id,
+ OldValue => 'ticket 42', );
+ ok( $txn_id, "Created transaction $txn_id: $txn_msg");
+
+ warning_like { $brief = $txn->BriefDescription }
+ qr/Could not determine a URI scheme/,
+ "Caught URI warning";
+
+ is( $brief, 'Reference to ticket 42 deleted', "Got string description: $brief");
+}
+
+done_testing;
diff --git a/rt/t/api/uri-canonicalize.t b/rt/t/api/uri-canonicalize.t
new file mode 100644
index 000000000..288569c7f
--- /dev/null
+++ b/rt/t/api/uri-canonicalize.t
@@ -0,0 +1,54 @@
+use strict;
+use warnings;
+use RT::Test tests => undef;
+
+my @warnings;
+local $SIG{__WARN__} = sub {
+ push @warnings, "@_";
+};
+
+# Create ticket
+my $ticket = RT::Test->create_ticket( Queue => 1, Subject => 'test ticket' );
+ok $ticket->id, 'created ticket';
+
+# Create article class
+my $class = RT::Class->new( $RT::SystemUser );
+$class->Create( Name => 'URItest - '. $$ );
+ok $class->id, 'created a class';
+
+# Create article
+my $article = RT::Article->new( $RT::SystemUser );
+$article->Create(
+ Name => 'Testing URI parsing - '. $$,
+ Summary => 'In which this should load',
+ Class => $class->Id
+);
+ok $article->id, 'create article';
+
+# Test permutations of URIs
+my $ORG = RT->Config->Get('Organization');
+my $URI = RT::URI->new( RT->SystemUser );
+my %expected = (
+ # tickets
+ "1" => "fsck.com-rt://$ORG/ticket/1",
+ "t:1" => "fsck.com-rt://$ORG/ticket/1",
+ "fsck.com-rt://$ORG/ticket/1" => "fsck.com-rt://$ORG/ticket/1",
+
+ # articles
+ "a:1" => "fsck.com-article://$ORG/article/1",
+ "fsck.com-article://$ORG/article/1" => "fsck.com-article://$ORG/article/1",
+
+ # random stuff
+ "http://$ORG" => "http://$ORG",
+ "mailto:foo\@example.com" => "mailto:foo\@example.com",
+ "invalid" => "invalid", # doesn't trigger die
+);
+for my $uri (sort keys %expected) {
+ is $URI->CanonicalizeURI($uri), $expected{$uri}, "canonicalized as expected";
+}
+
+is_deeply \@warnings, [
+ "Could not determine a URI scheme for invalid\n",
+], "expected warnings";
+
+done_testing;