XS-APItest/t/blockhooks.t

#!/usr/bin/perl

use warnings;
use strict;
use Test::More tests => 17;

use XS::APItest;
use t::BHK ();      # make sure it gets compiled early

BEGIN { package XS::APItest; *main::bhkav = \@XS::APItest::bhkav }

# 'use t::BHK' switches on recording hooks, and clears @bhkav.
# 'no t::BHK' switches recording off again.
# 'use t::BHK push => "foo"' pushes onto @bhkav

use t::BHK;
    1;
no t::BHK;

BEGIN { is_deeply \@bhkav, [], "no blocks" }

use t::BHK;
    {
        1;
    }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [[start => 1], qw/pre_end post_end/],
    "plain block";
}

use t::BHK;
    if (1) { 1 }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [start => 1],
        [start => 0],
        qw/pre_end post_end/,
        qw/pre_end post_end/,
    ],
    "if block";
}

use t::BHK;
    for (1) { 1 }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [start => 1],
        [start => 0],
        qw/pre_end post_end/,
        qw/pre_end post_end/,
    ],
    "for loop";
}

use t::BHK;
    {
        { 1; }
    }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [start => 1],
        [start => 1],
        qw/pre_end post_end/,
        qw/pre_end post_end/,
    ],
    "nested blocks";
}

use t::BHK;
    use t::BHK push => "before";
    {
        use t::BHK push => "inside";
    }
    use t::BHK push => "after";
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        "before",
        [start => 1],
        "inside",
        qw/pre_end post_end/,
        "after"
    ],
    "hooks called in the correct places";
}

use t::BHK;
    BEGIN { 1 }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [start => 1],
        qw/pre_end post_end/,
    ],
    "BEGIN block";
}

use t::BHK; t::BHK->import;
    eval "1";
no t::BHK; t::BHK->unimport;

BEGIN { is_deeply \@bhkav, [], "string eval (compile)" }
is_deeply \@bhkav,
    [
        [eval => "entereval"],
        [start => 1],
        qw/pre_end post_end/,
    ],
    "string eval (run)";

delete @INC{qw{t/Null.pm t/Block.pm}};

t::BHK->import;
    do "t/Null.pm";
t::BHK->unimport;

is_deeply \@bhkav,
    [
        [eval => "dofile"],
        [start => 1],
        qw/pre_end post_end/,
    ],
    "do file (null)";

t::BHK->import;
    do "t/Block.pm";
t::BHK->unimport;

is_deeply \@bhkav,
    [
        [eval => "dofile"],
        [start => 1],
        [start => 1],
        qw/pre_end post_end/,
        qw/pre_end post_end/,
    ],
    "do file (single block)";

delete @INC{qw{t/Null.pm t/Block.pm}};

t::BHK->import;
    require t::Null;
t::BHK->unimport;

is_deeply \@bhkav,
    [
        [eval => "require"],
        [start => 1],
        qw/pre_end post_end/,
    ],
    "require (null)";

t::BHK->import;
    require t::Block;
t::BHK->unimport;

is_deeply \@bhkav,
    [
        [eval => "require"],
        [start => 1],
        [start => 1],
        qw/pre_end post_end/,
        qw/pre_end post_end/,
    ],
    "require (single block)";

BEGIN { delete $INC{"t/Block.pm"} }

use t::BHK;
    use t::Block;
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [eval => "require"],
        [start => 1],
        [start => 1],
        qw/pre_end post_end/,
        qw/pre_end post_end/,
    ],
    "use (single block)";
}

BEGIN { delete $INC{"t/Markers.pm"} }

use t::BHK;
    use t::BHK push => "compile/main/before";
    use t::Markers;
    use t::BHK push => "compile/main/after";
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        "compile/main/before",
        [eval => "require"],
        [start => 1],
            "compile/pm/before",
            [start => 1],
                "compile/pm/inside",
            qw/pre_end post_end/,
            "compile/pm/after",
        qw/pre_end post_end/,
        "run/pm",
        "run/import",
        "compile/main/after",
    ],
    "use with markers";
}

# OK, now some *really* evil stuff...

BEGIN {
    package EvalDestroy;

    sub DESTROY { $_[0]->() }
}

use t::BHK;
    {
        BEGIN {
            # grumbleSCOPECHECKgrumble
            push @XS::APItest::COMPILE_SCOPE_CONTAINER,
                bless sub {
                    push @bhkav, "DESTROY";
                }, "EvalDestroy";
        }
        1;
    }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [start => 1],                   # block
            [start => 1],               # BEGIN
                [start => 1],           # sub
                qw/pre_end post_end/,
            qw/pre_end post_end/,
        "pre_end",
            "DESTROY",
        "post_end",
    ],
    "compile-time DESTROY comes between pre_ and post_end";
}

use t::BHK;
    {
        BEGIN {
            push @XS::APItest::COMPILE_SCOPE_CONTAINER,
                bless sub {
                    eval "{1}";
                }, "EvalDestroy";
        }
        1;
    }
no t::BHK;

BEGIN { is_deeply \@bhkav,
    [
        [start => 1],                   # block
            [start => 1],               # BEGIN
                [start => 1],           # sub
                qw/pre_end post_end/,
            qw/pre_end post_end/,
        "pre_end",
            [eval => "entereval"],
            [start => 1],               # eval
                [start => 1],           # block inside eval
                qw/pre_end post_end/,
            qw/pre_end post_end/,
        "post_end",
    ],
    "evil eval-in-DESTROY tricks";
}