#!/usr/bin/perl -w

use strict;
use HTML::Mason::Tests;

my $tests = make_tests();
$tests->run;

sub make_tests
{
    my $group = HTML::Mason::Tests->tests_class->new( name => 'subrequest',
                                                      description => 'subrequest-related features' );

#------------------------------------------------------------

    $group->add_support( path => '/support/subrequest_error_test',
                         component => <<'EOF',
<& /shared/display_req_obj &>
% die "whoops!";
EOF
                       );

#------------------------------------------------------------


    $group->add_support( path => '/support/dir/autohandler',
                         component => <<'EOF',
I am the autohandler.
EOF
                       );

#------------------------------------------------------------

    $group->add_support( path => '/support/dir/comp',
                         component => <<'EOF',
I am the called comp (no autohandler).
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'subrequest',
                      description => 'tests the official subrequest mechanism',
                      component => <<'EOF',
<%def .helper>
Executing subrequest
% print "I can print before the subrequest\n";
% my $buf;
% my $req = $m->make_subrequest(comp=>'/shared/display_req_obj', out_method => \$buf);
% $req->exec();
<% $buf %>
% print "I can still print after the subrequest\n";
</%def>

Calling helper
<& .helper &>
EOF
                      expect => <<'EOF',

Calling helper

Executing subrequest
I can print before the subrequest
My depth is 1.

I am a subrequest.

The top-level component is /shared/display_req_obj.

My stack looks like:
-----
/shared/display_req_obj
-----


I can still print after the subrequest
EOF
                    );


#------------------------------------------------------------

    $group->add_test( name => 'subrequest_with_autohandler',
                      description => 'tests the subrequest mechanism with an autohandler',
                      component => <<'EOF',
Executing subrequest
% my $buf;
% my $req = $m->make_subrequest(comp=>'/subrequest/support/dir/comp', out_method => \$buf);
% $req->exec();
<% $buf %>
EOF
                      expect => <<'EOF',
Executing subrequest
I am the autohandler.
EOF
                    );


#------------------------------------------------------------

    $group->add_support( path => '/subrequest2/autohandler',
                         component => <<'EOF',
I am the autohandler for <% $m->base_comp->name %>.
% $m->call_next;
<%flags>
inherit => undef
</%flags>
EOF
                       );

#------------------------------------------------------------

    $group->add_support( path => '/subrequest2/bar',
                         component => <<'EOF',
I am bar.
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'subreq_exec_order',
                      path => '/subrequest2/subreq_exec_order',
                      call_path => '/subrequest2/subreq_exec_order',
                      description => 'Test that output from a subrequest comes out when we expect it to.',
                      component => <<'EOF',
% $m->subexec('/subrequest/subrequest2/bar');
I am subreq_exec_order.
EOF
                      expect => <<'EOF',
I am the autohandler for subreq_exec_order.
I am the autohandler for bar.
I am bar.
I am subreq_exec_order.
EOF
                    );

#------------------------------------------------------------

    $group->add_support( path => '/support/autoflush_subrequest',
                         component => <<'EOF',
% $m->autoflush($autoflush) if $autoflush;
here is the child
% $m->clear_buffer if $clear;
<%args>
$autoflush => 0
$clear => 0
</%args>
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'autoflush_subrequest',
                      description => 'make sure that a subrequest respects its parent autoflush setting',
                      interp_params => { autoflush => 1 },
                      component => <<'EOF',
My child says:
% $m->flush_buffer;
% $m->subexec('/subrequest/support/autoflush_subrequest');
% $m->clear_buffer;
EOF
                      expect => <<'EOF',
My child says:
here is the child
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'subrequest_inherits_no_autoflush',
                      description => 'make sure that a subrequest inherits its parent autoflush setting (autoflush off)',
                      interp_params => { autoflush => 0 },
                      component => <<'EOF',
My child says:
% $m->flush_buffer;
% $m->subexec('/subrequest/support/autoflush_subrequest');
% $m->clear_buffer;
EOF
                      expect => <<'EOF',
My child says:
EOF
                    );

#------------------------------------------------------------

    $group->add_test( name => 'autoflush_in_subrequest',
                      description => 'make sure that a subrequest with autoflush on does not flush parent',
                      component => <<'EOF',
My child says:
% $m->flush_buffer;
% $m->subexec('/subrequest/support/autoflush_subrequest', autoflush => 1);
% $m->clear_buffer;
EOF
                      expect => <<'EOF',
My child says:
EOF
                    );

#------------------------------------------------------------

    # SKIPPING THIS TEST FOR NOW - NOT SURE OF DESIRED BEHAVIOR
    if (0) {
        $group->add_test( name => 'autoflush_in_parent_not_subrequest',
                          description => 'make sure that a subrequest with autoflush can clear its own buffers',
                          interp_params => { autoflush => 1 },
                          component => <<'EOF',
My child says:
% $m->flush_buffer;
% $m->subexec('/subrequest/support/autoflush_subrequest', autoflush => 0, clear => 1);
% $m->clear_buffer;
EOF
                          expect => <<'EOF',
My child says:
EOF
                          );
    }

#------------------------------------------------------------

    $group->add_support( path => '/support/return/scalar',
                         component => <<'EOF',
% die "wantarray should be false" unless defined(wantarray) and !wantarray;
% return 'foo';
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'return_scalar',
                      description => 'tests that exec returns scalar return value of top component',
                      component => <<'EOF',
% my $req = $m->make_subrequest(comp=>'/subrequest/support/return/scalar');
% my $value = $req->exec();
return value is <% $value %>
EOF
                      expect => <<'EOF',
return value is foo
EOF
                    );


#------------------------------------------------------------

    $group->add_support( path => '/support/return/list',
                         component => <<'EOF',
% die "wantarray should be true" unless wantarray;
% return (1, 2, 3);
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'return_list',
                      description => 'tests that exec returns list return value of top component',
                      component => <<'EOF',
% my $req = $m->make_subrequest(comp=>'/subrequest/support/return/list');
% my @value = $req->exec();
return value is <% join(",", @value) %>
EOF
                      expect => <<'EOF',
return value is 1,2,3
EOF
                    );


#------------------------------------------------------------

    $group->add_support( path => '/support/return/nothing',
                         component => <<'EOF',
wantarray is <% defined(wantarray) ? "defined" : "undefined" %>
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'return_nothing',
                      description => 'tests exec in non-return context',
                      component => <<'EOF',
% my $req = $m->make_subrequest(comp=>'/subrequest/support/return/nothing');
% $req->exec();
EOF
                      expect => <<'EOF',
wantarray is undefined
EOF
                    );


#------------------------------------------------------------

    $group->add_support( path => '/support/output',
                         component => <<'EOF',
More output
EOF
                       );

#------------------------------------------------------------

    $group->add_test( name => 'kwindla',
                      description => 'tests bug report from Kwindla Kramer',
                      component => <<'EOF',
Some output
% $m->clear_buffer;
% my $req = $m->make_subrequest( comp => '/subrequest/support/output' );
% $req->exec();
% $m->flush_buffer;
% $m->abort;
EOF
                      expect => <<'EOF',
More output
EOF
                    );


#------------------------------------------------------------

    $group->add_test( name => 'in_package',
                      description => 'use in_package with subrequest',
                      interp_params => { in_package => 'Test::Package' },
                      component => <<'EOF',
Before subreq
% $m->subexec( '/subrequest/support/output' );
After subreq
EOF
                      expect => <<'EOF',
Before subreq
More output
After subreq
EOF
                    );


#------------------------------------------------------------

    $group->add_test( name => 'relative_path_call',
                      description => 'call subrequest with relative path',
                      component => <<'EOF',
% $m->subexec( 'support/output' );
EOF
                      expect => <<'EOF',
More output
EOF
                    );


#------------------------------------------------------------

    $group->add_test( name => 'comp_object_call',
                      description => 'call subrequest with component object',
                      component => <<'EOF',
% $m->subexec( $m->interp->load('/subrequest/support/output') );
EOF
                      expect => <<'EOF',
More output
EOF
                    );


#------------------------------------------------------------

    $group->add_support( path => 'support/subexec_recurse_test',
                         component => <<'EOF',
Entering <% $m->request_depth %><p>
% if ($count < $max) {
%   $m->subexec('subexec_recurse_test', count=>$count+1, max=>$max)
% }
Exiting <% $m->request_depth %><p>
<%args>
$count=>0
$max
</%args>
EOF
                       );


#------------------------------------------------------------

    $group->add_test( name => 'max_recurse_1',
                      description => 'Test that recursion 8 levels deep is allowed',
                      component => '<& support/subexec_recurse_test, max=>8 &>',
                      expect => <<'EOF',
Entering 1<p>
Entering 2<p>
Entering 3<p>
Entering 4<p>
Entering 5<p>
Entering 6<p>
Entering 7<p>
Entering 8<p>
Entering 9<p>
Exiting 9<p>
Exiting 8<p>
Exiting 7<p>
Exiting 6<p>
Exiting 5<p>
Exiting 4<p>
Exiting 3<p>
Exiting 2<p>
Exiting 1<p>
EOF
                      );

#------------------------------------------------------------

    $group->add_test( name => 'max_recurse_2',
                      description => 'Test that recursion is stopped after 32 subexecs',
                      component => '<& support/subexec_recurse_test, max=>48 &>',
                      expect_error => qr{subrequest depth > 32 \(infinite subrequest loop\?\)},
                    );

#------------------------------------------------------------

    return $group;
}