view release on metacpan or  search on metacpan

t/app/Plack/Test/Suite.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Compiler::Lexer;
use Compiler::Parser;
use Compiler::Parser::AST::Renderer;
use Test::Compiler::Parser;

subtest 'parse Plack/Test/Suite.pm' => sub {
    my $script = do { local $/; <DATA> };
    my $tokens = Compiler::Lexer->new('')->tokenize($script);
    my $ast = Compiler::Parser->new->parse($tokens);
    Compiler::Parser::AST::Renderer->new->render($ast);
    node_ok($ast->root, [
        Test::Compiler::Parser::package { 'Plack::Test::Suite',
        },
        module { 'strict',
        },
        module { 'warnings',
        },
        module { 'Digest::MD5',
        },
        module { 'File::ShareDir',
        },
        module { 'HTTP::Request',
        },
        module { 'HTTP::Request::Common',
        },
        module { 'LWP::UserAgent',
        },
        module { 'Test::More',
        },
        module { 'Test::TCP',
        },
        module { 'Plack::Loader',
        },
        module { 'Plack::Middleware::Lint',
        },
        module { 'Plack::Util',
        },
        module { 'Plack::Request',
        },
        module { 'Try::Tiny',
        },
        branch { '=',
            left => leaf '$share_dir',
            right => function_call { 'try',
                args => [
                    branch { '||',
                        left => hash_ref { '{}',
                            data => function_call { 'File::ShareDir::dist_dir',
                                args => [
                                    leaf 'Plack',
                                ],
                            },
                        },
                        right => leaf 'share',
                    },
                ],
            },
        },
        branch { '=',
            left => hash { '$ENV',
                key => hash_ref { '{}',
                    data => leaf 'PLACK_TEST_SCRIPT_NAME',
                },
            },
            right => leaf '',
        },
        branch { '=',
            left => leaf '@TEST',
            right => list { '()',
                data => branch { ',',
                    left => branch { ',',
                        left => branch { ',',
                            left => branch { ',',
                                left => branch { ',',
                                    left => branch { ',',
                                        left => branch { ',',
                                            left => branch { ',',
                                                left => branch { ',',
                                                    left => branch { ',',
                                                        left => branch { ',',
                                                            left => branch { ',',
                                                                left => branch { ',',
                                                                    left => branch { ',',
                                                                        left => branch { ',',
                                                                            left => branch { ',',
                                                                                left => branch { ',',
                                                                                    left => branch { ',',
                                                                                        left => branch { ',',
                                                                                            left => branch { ',',
                                                                                                left => branch { ',',
                                                                                                    left => branch { ',',
                                                                                                        left => branch { ',',
                                                                                                            left => branch { ',',
                                                                                                                left => branch { ',',
                                                                                                                    left => branch { ',',
                                                                                                                        left => branch { ',',
                                                                                                                            left => branch { ',',
                                                                                                                                left => branch { ',',
                                                                                                                                    left => branch { ',',
                                                                                                                                        left => branch { ',',

t/app/Plack/Test/Suite.t  view on Meta::CPAN

                    ],
                },
            ],
        },
        function { 'test_app_handler',
            body => Test::Compiler::Parser::return { 'return',
                body => function { 'sub',
                    body => [
                        branch { '=',
                            left => leaf '$env',
                            right => function_call { 'shift',
                                args => [
                                ],
                            },
                        },
                        branch { '->',
                            left => branch { '->',
                                left => array { '$TEST',
                                    idx => array_ref { '[]',
                                        data => branch { '->',
                                            left => leaf '$env',
                                            right => hash_ref { '{}',
                                                data => leaf 'HTTP_X_PLACK_TEST',
                                            },
                                        },
                                    },
                                },
                                right => array_ref { '[]',
                                    data => leaf '2',
                                },
                            },
                            right => list { '()',
                                data => leaf '$env',
                            },
                        },
                    ],
                },
            },
        },
        leaf '1',
    ]);
};

done_testing;

__DATA__
package Plack::Test::Suite;
use strict;
use warnings;
use Digest::MD5;
use File::ShareDir;
use HTTP::Request;
use HTTP::Request::Common;
use LWP::UserAgent;
use Test::More;
use Test::TCP;
use Plack::Loader;
use Plack::Middleware::Lint;
use Plack::Util;
use Plack::Request;
use Try::Tiny;

my $share_dir = try { File::ShareDir::dist_dir('Plack') } || 'share';

$ENV{PLACK_TEST_SCRIPT_NAME} = '';

# 0: test name
# 1: request generator coderef.
# 2: request handler
# 3: test case for response
our @TEST = (
    [
        'SCRIPT_NAME',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/");
            is $res->content, $ENV{PLACK_TEST_SCRIPT_NAME};
        },
        sub {
            my $env = shift;
            return [ 200, ["Content-Type", "text/plain"], [ $env->{SCRIPT_NAME} ] ];
        },
    ],
    [
        'GET',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa");
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'text/plain';
            is $res->content, 'Hello, name=miyagawa';
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [ 'Hello, ' . $env->{QUERY_STRING} ],
            ];
        },
    ],
    [
        'POST',
        sub {
            my $cb = shift;
            my $res = $cb->(POST "http://127.0.0.1/", [name => 'tatsuhiko']);
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('Client-Content-Length'), 14;
            is $res->header('Client-Content-Type'), 'application/x-www-form-urlencoded';
            is $res->header('content_type'), 'text/plain';
            is $res->content, 'Hello, name=tatsuhiko';
        },
        sub {
            my $env = shift;
            my $body;
            $env->{'psgi.input'}->read($body, $env->{CONTENT_LENGTH});
            return [
                200,
                [ 'Content-Type' => 'text/plain',