The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;

no warnings 'portable'; # suppress "v-string in use/require non-portable" warnings

use lib qw(t/lib);

use Test::More tests => 21;
use Devel::Pragma qw(hints);
use File::Spec;

# make sure use VERSION still works OK
use 5;
use 5.006;
use 5.006_000;
use 5.6.0;
use v5.6.0;

{
    BEGIN {
        hints();
        $^H{'Devel::Pragma::Test'} = 1;
    }

    BEGIN {
        require test_2;
    }

    BEGIN {
        is($^H{'Devel::Pragma::Test'}, 1, "compile-time require doesn't clobber %^H");
    }

    ok (test_2::test(), 'compile-time require');
}

{
    BEGIN {
        hints();
        $^H{'Devel::Pragma::Test'} = 1;
    }

    require test_3;

    ok (test_3::test(), 'runtime require');
}

{
    BEGIN {
        hints();
        $^H{'Devel::Pragma::Test'} = 1;
    }

    use test_4;

    BEGIN {
        is($^H{'Devel::Pragma::Test'}, 1, "use doesn't clobber %^H");
    }

    ok (test_4::test(), 'use');
}

{
    BEGIN {
        hints();
        $^H{'Devel::Pragma::Test'} = 1;
    }

    use test_4;

    BEGIN {
        is($^H{'Devel::Pragma::Test'}, 1, "reuse doesn't clobber %^H");
    }

    ok(test_4::test(), 'reuse');
}

eval {
    BEGIN {
        hints();
        $^H{'Devel::Pragma::Test'} = 1;
    }

    use test_7;

    BEGIN {
        is($^H{'Devel::Pragma::Test'}, 1, "eval block doesn't clobber %^H");
    }

    ok(test_7::test(), 'eval BLOCK');
};

ok(not($@), 'eval BLOCK OK');

eval q|
    {
        BEGIN {
            hints();
            $^H{'Devel::Pragma::Test'} = 1;
        }

        use test_8;

        BEGIN {
            is($^H{'Devel::Pragma::Test'}, 1, "eval EXPR doesn't clobber %^H");
        }

        ok(test_7::test(), 'eval EXPR');
    }
|;

ok(not($@), 'eval EXPR OK');

{
    BEGIN {
        hints();
        $^H{'Devel::Pragma::Test'} = 1;
    }

    use test_9;

    BEGIN {
        is($^H{'Devel::Pragma::Test'}, 1, "scope: %^H isn't clobbered");
    }

    ok (test_9::test(), 'scope');

    {
        use test_10;

        BEGIN {
            is($^H{'Devel::Pragma::Test'}, 1, "nested scope: %^H isn't clobbered");
        }

        ok (test_10::test(), 'nested scope');
    }

    use test_11;

    BEGIN {
        is($^H{'Devel::Pragma::Test'}, 1, "scope again: %^H isn't clobbered");
    }

    ok (test_11::test(), 'scope again');
}

{
    BEGIN {
        $^H{'Devel::Pragma::Test'} = 1;
        hints;
    }

    BEGIN {
        ok((($^H & 0x20000) == 0x20000), 'hints sets LOCALIZE_HH');
        is(hints->{'Devel::Pragma::Test'}, 1, 'hints returns a reference to %^H');
    }
}