use strict;
use warnings;
use HTML::Mason::Tests;
my $tests = make_tests();
$tests->run;
sub make_tests
{
my $group = HTML::Mason::Tests->tests_class->new( name => 'request',
description => 'request object functionality' );
#------------------------------------------------------------
$group->add_support( path => '/support/abort_test',
component => <<'EOF',
<%args>
$val => 50
</%args>
Some more text
% $m->abort($val);
But this will never be seen
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/sections/perl',
component => <<'EOF',
foo
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/support/various_test',
component => <<'EOF',
Caller is <% $m->caller->title %> or <% $m->callers(1)->title %> or <% $m->callers(-2)->title %>.
The top level component is <% $m->callers(-1)->title %> or <% $m->request_comp->title %>.
The full component stack is <% join(",",map($_->title,$m->callers)) %>.
My argument list is (<% join(",",$m->caller_args(0)) %>).
The top argument list is (<% join(",",$m->request_args()) %>) or (<% join(",",$m->caller_args(-1)) %>).
% foreach my $path (qw(various_test /request/sections/perl foobar /shared)) {
% my $full_path = HTML::Mason::Tools::absolute_comp_path($path, $m->current_comp->dir_path);
Trying to fetch <% $path %> (full path <% $full_path %>):
% if ($m->comp_exists($path)) {
% if (my $comp = $m->fetch_comp($path)) {
<% $path %> exists with title <% $comp->title %>.
% } else {
<% $path %> exists but could not fetch object!
% }
% } else {
<% $path %> does not exist.
% }
% }
% $m->print("Output via the out function.");
/request/file outputs <% int(length($m->scomp("/request/file"))/10) %>0+ characters.
EOF
);
#------------------------------------------------------------
$group->add_support( path => 'various_helper',
component => <<'EOF',
<& support/various_test, %ARGS &>
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'abort',
description => 'test $m->abort method (autoflush on)',
interp_params => { autoflush => 1 },
component => <<'EOF',
Some text
% eval {$m->comp('support/abort_test')};
% if (my $err = $@) {
% if ($m->aborted) {
Component aborted with value <% $err->aborted_value %>
% } else {
Got error
% }
% }
EOF
expect => <<'EOF',
Some text
Some more text
Component aborted with value 50
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'abort_0',
description => 'test $m->abort method with value of 0',
component => <<'EOF',
Some text
% eval {$m->comp('support/abort_test', val => 0)};
% if (my $err = $@) {
% if ($m->aborted($err)) {
Component aborted with value <% $err->aborted_value %>
% } else {
Got error
% }
% }
EOF
expect => <<'EOF',
Some text
Some more text
Component aborted with value 0
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'abort',
description => 'test $m->abort method (autoflush off)',
component => <<'EOF',
Some text
% eval {$m->comp('support/abort_test')};
% if (my $err = $@) {
% if ($m->aborted) {
Component aborted with value <% $err->aborted_value %>
% } else {
Got error
% }
% }
EOF
expect => <<'EOF',
Some text
Some more text
Component aborted with value 50
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'file',
description => 'tests $m->file method',
component => <<'EOF',
Now I will print myself:
% my $output = $m->file("file");
% $output =~ s/\cM//g;
<% $output %>
EOF
expect => <<'EOF',
Now I will print myself:
Now I will print myself:
% my $output = $m->file("file");
% $output =~ s/\cM//g;
<% $output %>
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'file_in_subcomp',
description => 'tests $m->file method in subcomponent',
component => <<'EOF',
Here I am:
<& .sub &>
<%def .sub>
% my $f = $m->file('file_in_subcomp'); $f =~ s/\r\n?/\n/g;
<% $f %>
</%def>
EOF
expect => <<'EOF',
Here I am:
Here I am:
<& .sub &>
<%def .sub>
% my $f = $m->file('file_in_subcomp'); $f =~ s/\r\n?/\n/g;
<% $f %>
</%def>
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'list_out',
description => 'tests that $m->print can handle a list of arguments',
component => <<'EOF',
Sending list of arguments:
<% 'blah','boom','bah' %>
<%perl>
$m->print(3,4,5);
my @lst = (7,8,9);
$m->print(@lst);
</%perl>
EOF
expect => <<'EOF',
Sending list of arguments:
blahboombah
345789
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'req_obj',
description => 'tests various operations such as comp calls, $m->current_comp',
component => <<'EOF',
<%def .subcomp>
% if ($count < 5) {
<& $m->current_comp, count=>$count+1 &>
% } else {
<& /shared/display_req_obj &>
% }
<%args>
$count
</%args>
</%def>
<% '-' x 10 %>
One level request:
<& /shared/display_req_obj &>
<% '-' x 10 %>
Many level request:
<& .subcomp, count=>0 &>
<% '-' x 10 %>
EOF
expect => <<'EOF',
----------
One level request:
My depth is 2.
I am not a subrequest.
The top-level component is /request/req_obj.
My stack looks like:
-----
/shared/display_req_obj
/request/req_obj
-----
----------
Many level request:
My depth is 8.
I am not a subrequest.
The top-level component is /request/req_obj.
My stack looks like:
-----
/shared/display_req_obj
/request/req_obj:.subcomp
/request/req_obj:.subcomp
/request/req_obj:.subcomp
/request/req_obj:.subcomp
/request/req_obj:.subcomp
/request/req_obj:.subcomp
/request/req_obj
-----
----------
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'various',
call_args => {junk=>5},
description => 'tests caller, callers, fetch_comp, process_comp_path, comp_exists and scomp',
component => <<'EOF',
<& various_helper, junk=>$ARGS{junk}+1 &>
EOF
expect => <<'EOF',
Caller is /request/various_helper or /request/various_helper or /request/various_helper.
The top level component is /request/various or /request/various.
The full component stack is /request/support/various_test,/request/various_helper,/request/various.
My argument list is (junk,6).
The top argument list is (junk,5) or (junk,5).
Trying to fetch various_test (full path /request/support/various_test):
various_test exists with title /request/support/various_test.
Trying to fetch /request/sections/perl (full path /request/sections/perl):
/request/sections/perl exists with title /request/sections/perl.
Trying to fetch foobar (full path /request/support/foobar):
foobar does not exist.
Trying to fetch /shared (full path /shared):
/shared does not exist.
Output via the out function.
/request/file outputs 120+ characters.
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/autohandler_test2/autohandler',
component => <<'EOF',
This is the first autohandler
Remaining chain: <% join(',',map($_->title,$m->fetch_next_all)) %>
<& $m->fetch_next, level => 1 &>\
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/autohandler_test2/dir1/autohandler',
component => <<'EOF',
This is the second autohandler
Remaining chain: <% join(',',map($_->title,$m->fetch_next_all)) %>
% foreach (@_) {
<% $_ %>
% }
<& $m->fetch_next, level => 2 &>\
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'fetch_next',
path => '/autohandler_test2/dir1/fetch_next',
call_path => '/autohandler_test2/dir1/fetch_next',
description => 'Test $m->fetch_next and $m->fetch_next_all',
component => <<'EOF',
This is the main component (called by level <% $ARGS{level} %>)
Remaining chain: <% join(',',map($_->title,$m->fetch_next_all)) %>
% foreach (@_) {
<% $_ %>
% }
EOF
expect => <<'EOF',
This is the first autohandler
Remaining chain: /request/autohandler_test2/dir1/autohandler,/request/autohandler_test2/dir1/fetch_next
This is the second autohandler
Remaining chain: /request/autohandler_test2/dir1/fetch_next
level
1
This is the main component (called by level 2)
Remaining chain:
level
2
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'print',
description => 'Test print function from a component',
component => <<'EOF',
This is first.
% print "This is second.\n";
This is third.
EOF
expect => <<'EOF',
This is first.
This is second.
This is third.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'printf',
description => 'Test printf function from a component',
component => <<'EOF',
This is first.
% printf '%s', "This is second.\n";
This is third.
EOF
expect => <<'EOF',
This is first.
This is second.
This is third.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'autoflush_print',
description => 'Test print function from a component with autoflush on',
interp_params => { autoflush => 1 },
component => <<'EOF',
This is first.
% print "This is second.\n";
This is third.
EOF
expect => <<'EOF',
This is first.
This is second.
This is third.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'autoflush_printf',
description => 'Test printf function from a component with autoflush on',
interp_params => { autoflush => 1 },
component => <<'EOF',
This is first.
% printf '%s', "This is second.\n";
This is third.
EOF
expect => <<'EOF',
This is first.
This is second.
This is third.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'flush_print',
description => 'Test print function from a component in conjunction with $m->flush_buffer call',
component => <<'EOF',
This is first.
% print "This is second.\n";
% $m->flush_buffer;
This is third.
EOF
expect => <<'EOF',
This is first.
This is second.
This is third.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'flush_print_autoflush',
description => 'Test print function from a component with autoflush on in conjunction with $m->flush_buffer call',
interp_params => { autoflush => 1 },
component => <<'EOF',
This is first.
% print "This is second.\n";
% $m->flush_buffer;
This is third.
EOF
expect => <<'EOF',
This is first.
This is second.
This is third.
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'flush_filter',
description => 'Test $m->flush_buffer in presence of filter',
component => <<'EOF',
one
% $m->flush_buffer;
% $m->clear_buffer;
two
<%filter>
$_ .= $_;
</%filter>
EOF
expect => <<'EOF',
one
one
two
two
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'clear_buffer',
description => 'Test $m->clear_buffer in a normal component',
component => <<'EOF',
one
% $m->clear_buffer;
two
EOF
expect => <<'EOF',
two
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'clear_filter',
description => 'Test $m->clear_buffer in presence of filter',
component => <<'EOF',
one
% $m->clear_buffer;
two
<%filter>
$_ .= $_;
</%filter>
EOF
expect => <<'EOF',
two
two
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'autoflush_disabled',
description => 'Using autoflush when disabled generates an error',
interp_params => { autoflush => 1, enable_autoflush => 0 },
component => <<'EOF',
Hi
EOF
expect_error => qr/Cannot use autoflush unless enable_autoflush is set/,
);
#------------------------------------------------------------
$group->add_test( name => 'instance',
description => 'Test HTML::Mason::Request->instance',
component => <<'EOF',
<% $m eq HTML::Mason::Request->instance ? 'yes' : 'no' %>
EOF
expect => <<'EOF',
yes
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'abort_and_filter',
description => 'Test that an abort in a filtered component still generates _some_ output, and that filter is run only once',
component => <<'EOF',
filter
% eval { $m->comp('support/abort_test') };
<%filter>
$_ = uc $_;
$_ =~ s/\s+$//;
$_ .= "\nfilter ran once";
</%filter>
EOF
expect => <<'EOF',
FILTER
SOME MORE TEXT
filter ran once
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'abort_and_filter_2',
description => 'Test that $m->aborted can be checked in a filter section',
component => <<'EOF',
filter
% $m->abort;
<%filter>
unless ( $m->aborted )
{
$_ = uc $_;
$_ =~ s/\s+$//;
$_ .= "\nfilter ran once";
}
</%filter>
EOF
expect => <<'EOF',
filter
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'abort_and_store',
description => 'Test that an abort in a store\'d component still generates _some_ output',
component => <<'EOF',
filter
% my $foo;
% eval { $m->comp( { store => \$foo }, 'support/abort_test') };
<% $foo %>
EOF
expect => <<'EOF',
filter
Some more text
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'clear_and_abort',
description => 'Test the clear_and_abort() method',
component => <<'EOF',
Some output
% $m->flush_buffer;
More output
% $m->clear_and_abort();
EOF
expect => <<'EOF',
Some output
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'reexec',
description => 'test that $m cannot be reexecuted',
component => <<'EOF',
<%init>
$m->exec;
</%init>
EOF
expect_error => qr/Can only call exec\(\) once/,
);
#------------------------------------------------------------
$group->add_test( name => 'caller_in_subcomp',
description => 'tests $m->caller() in subcomponent',
component => <<'EOF',
<%def .foo>
<% $m->caller->name %>
</%def>
<& .foo &>
EOF
expect => <<'EOF',
caller_in_subcomp
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'caller_at_top_level',
description => 'tests $m->caller() from top component',
component => <<'EOF',
caller is <% defined($m->caller) ? "defined" : "undefined" %>
callers(5) is <% defined($m->callers(5)) ? "defined" : "undefined" %>
caller_args(7) is <% defined($m->callers(7)) ? "defined" : "undefined" %>
EOF
expect => <<'EOF',
caller is undefined
callers(5) is undefined
caller_args(7) is undefined
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/support/longjump_test3',
component => <<'EOF',
Depth is <% $m->depth %>.
The full component stack is <% join(",",map($_->title,$m->callers)) %>.
EOF
);
$group->add_support( path => '/support/subdir/longjump_test2',
component => <<'EOF',
This is longjump_test2
% no warnings 'uninitialized'; next;
EOF
);
$group->add_support( path => '/support/longjump_test1',
component => <<'EOF',
<& longjump_test3 &>
% foreach my $i (0..2) {
<& subdir/longjump_test2 &>
% }
<& longjump_test3 &>
EOF
);
# It is possible to accidentally call 'next' from a component and
# jump out to the last loop or block in a previous component.
# While this cannot be supported behavior (since necessary cleanup
# and plugin code is skipped), we'd like to avoid a Mason request
# stack corruption at a minimum.
#
$group->add_test( name => 'longjump',
description => 'Accidentally calling next to exit a component does not corrupt stack',
component => <<'EOF',
<& support/longjump_test1 &>
EOF
expect => <<'EOF',
Depth is 3.
The full component stack is /request/support/longjump_test3,/request/support/longjump_test1,/request/longjump.
This is longjump_test2
This is longjump_test2
This is longjump_test2
Depth is 3.
The full component stack is /request/support/longjump_test3,/request/support/longjump_test1,/request/longjump.
EOF
# This just shuts the test code up
expect_warnings => qr/.*/,
);
#------------------------------------------------------------
$group->add_support( path => '/support/callers_out_of_bounds2',
component => <<'EOF',
hi
EOF
);
#------------------------------------------------------------
$group->add_support( path => '/support/callers_out_of_bounds1',
component => <<'EOF',
<& callers_out_of_bounds2 &>
% foreach my $i (-4 .. 4) {
callers(<% $i %>) is <% defined($m->callers($i)) ? $m->callers($i)->title : 'not defined' %>
% }
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'callers_out_of_bounds',
description => 'tests $m->callers() for out of bounds indexes',
component => <<'EOF',
<& support/callers_out_of_bounds1 &>
EOF
expect => <<'EOF',
hi
callers(-4) is not defined
callers(-3) is not defined
callers(-2) is /request/support/callers_out_of_bounds1
callers(-1) is /request/callers_out_of_bounds
callers(0) is /request/support/callers_out_of_bounds1
callers(1) is /request/callers_out_of_bounds
callers(2) is not defined
callers(3) is not defined
callers(4) is not defined
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'call_self',
description => 'Test $m->call_self',
component => <<'EOF',
called
<%init>
my $out;
if ( $m->call_self( \$out, undef ) )
{
$m->print($out);
return;
}
</%init>
EOF
expect => <<'EOF',
called
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'call_self_retval',
description => 'Test that we can get return value of component via $m->call_self',
component => <<'EOF',
called
<%init>
my @return;
if ( $m->call_self( undef, \@return ) )
{
$m->print( "0: $return[0]\n1: $return[1]\n" );
return;
}
return ( 'foo', 'bar' );
</%init>
EOF
expect => <<'EOF',
0: foo
1: bar
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'call_self_output_and_retval',
description => 'Test that we can get return value and output of component via $m->call_self',
component => <<'EOF',
called
<%init>
my $out;
my @return;
if ( $m->call_self( \$out, \@return ) )
{
$m->print( "${out}0: $return[0]\n1: $return[1]\n" );
return;
}
</%init>
<%cleanup>
return ( 'foo', 'bar' );
</%cleanup>
EOF
expect => <<'EOF',
called
0: foo
1: bar
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'call_self_with_filter',
description => 'Test that $m->call_self works in presence of filter',
component => <<'EOF',
called
<%filter>
$_ = uc $_;
$_ .= ' filtered';
</%filter>
<%init>
my $out;
if ( $m->call_self( \$out, undef ) )
{
$m->print($out);
return;
}
</%init>
EOF
expect => <<'EOF',
CALLED
filtered
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'subcomp_from_shared',
description => 'Test calling a subcomponent inside shared block',
component => <<'EOF',
<%shared>
$m->comp('subcomp');
</%shared>
<%def subcomp>
a subcomp
</%def>
EOF
expect_error =>
qr/cannot call a method or subcomponent from a <%shared> block/,
);
#------------------------------------------------------------
$group->add_test( name => 'method_in_shared',
description => 'Test calling a method inside shared block',
component => <<'EOF',
<%shared>
$m->comp('SELF:meth');
</%shared>
<%method meth>
a method
</%method>
EOF
expect_error =>
qr/cannot call a method or subcomponent from a <%shared> block/,
);
#------------------------------------------------------------
$group->add_test( name => 'notes',
description => 'Test the notes() method',
component => <<'EOF',
% $m->notes('key', 'value');
k: <% $m->notes('key') %>
k2: <% $m->notes->{key} %>
EOF
expect =>
qr/k: value\s+k2: value/,
);
#------------------------------------------------------------
$group->add_test( name => 'flush_and_store',
description => q{Test that $m->flush_buffer is ignored in a store'd component},
interp_params => { autoflush => 1 },
component => <<'EOF',
<%def .world>\
World\
</%def>
% my $world;
% $m->comp( { store => \$world }, '.world');
Hello, <% $world %>!
% $world = $m->scomp('.world');
Hello, <% $world %>!
EOF
expect => <<'EOF',
Hello, World!
Hello, World!
EOF
);
#------------------------------------------------------------
$group->add_test( name => 'flush_and_scomp_recursive',
description => 'Test that $m->flush_buffer is ignored in a recursive scomp() call',
interp_params => { autoflush => 1 },
component => <<'EOF',
<%def .orld>\
orld\
</%def>
<%def .world>\
W<& .orld &>\
</%def>
% my $world = $m->scomp('.world');
Hello, <% $world %>!
EOF
expect => <<'EOF',
Hello, World!
EOF
);
#------------------------------------------------------------
return $group;
}