view release on metacpan or  search on metacpan

t/comp/require.t  view on Meta::CPAN

    # first thing in @INC, it will try to load t/op/; it should fail and
    # move onto the next path; however, the previous value of $! was
    # leaking into implementation if it was EACCES and we're accessing a
    # directory.

    $! = eval 'use Errno qw(EACCES); EACCES' || 0;
    eval q{require 'op'};
    $i++;
    print "not " if $@ =~ /Permission denied/;
    print "ok $i - require op\n";
}

# Test "require func()" with abs path when there is no .pmc file.
++$::i;
if (defined &DynaLoader::boot_DynaLoader) {
    require Cwd;
    require File::Spec::Functions;
    eval {
     CORE::require(File::Spec::Functions::catfile(Cwd::getcwd(),"bleah.pm"));
    };
    if ($@ =~ /^This is an expected error/) {
	print "ok $i - require(func())\n";
    } else {
	print "not ok $i - require(func())\n";
    }
} else {
    print "ok $i # SKIP Cwd may not be available in miniperl\n";
}

{
    BEGIN { ${^OPEN} = ":utf8\0"; }
    %INC = ();
    write_file('bleah.pm',"package F; \$x = '\xD1\x9E';\n");
    eval { require "bleah.pm" };
    $i++;
    my $not = $F::x eq "\xD1\x9E" ? "" : "not ";
    print "${not}ok $i - require ignores I/O layers\n";
}

{
    BEGIN { ${^OPEN} = ":utf8\0"; }
    %INC = ();
    write_file('bleah.pm',"require re; re->import('/x'); 1;\n");
    my $not = eval 'use bleah; "ab" =~ /a b/' ? "" : "not ";
    $i++;
    print "${not}ok $i - require does not localise %^H at run time\n";
}


BEGIN {
    # These are the test for feature 'module_true', which when in effect
    # avoids the requirement for a module to return a true value, and
    # in fact forces the return value to be a simple "true"
    # (eg, PL_sv_yes, aka 1).
    # we have a lot of permutations of how this code might trigger, and
    # etc. so we set up the test set here.

    my @params = (
            'use v5.37',
            'use feature ":5.38"',
            'use feature ":all"',
            'use feature "module_true"',
            'no feature "module_true"',
            '',
        );
    my @module_code = (
            '',
            'sub foo {};',
            'sub foo {}; 0;',
            'sub foo {}; return 0;',
            'sub foo {}; return (0,0,"some_true_value");',
            'sub foo {}; return ("some_true_value",1,1);',
            'sub foo {}; (0, return 0);',
            'sub foo {}; "some_true_value";',
            'sub foo {}; return "some_true_value";',
            'sub foo {}; (0, return "some_true_value");',
            'sub foo {}; (0, return "some_true_value");',
            undef,
        );
    my @eval_code = (
            'use PACK;',
            'require PACK;',
            '$return_val = require PACK;',
            '@return_val = require PACK;',
            'require "PACK.pm";',
            '$return_val = require "PACK.pm";',
            '@return_val = require "PACK.pm";',
    );

    # build a list of tuples. for now this just keeps the test
    # indent level reasonable for the main test loop, but we could
    # compute this at BEGIN time and then add the number of tests
    # to the total count
    my %seen;
    foreach my $debugger_state (0,0xA) {
        foreach my $param_str (@params) {
            foreach my $mod_code (@module_code) {
                foreach my $eval_code (@eval_code) {
                    my $pack_name= sprintf "mttest%d", 0+@module_true_tests;
                    my $eval_code_munged= $eval_code=~s/PACK/$pack_name/r;
                    # this asks the debugger to preserve lines from evals.
                    # it causes nextstate ops to convert to dbstate ops,
                    # and we need to check that we can handle both cases.
                    $eval_code_munged= '$^P = ' . $debugger_state .
                                       '; ' . $eval_code_munged
                        if $debugger_state;

                    my $param_str_munged = $param_str;
                    $param_str_munged .= ";\n" if $param_str;

                    my $this_code= defined($mod_code)
                        ? "package PACK;\n$param_str_munged$mod_code\n"
                        : "";

                    next if $seen{$eval_code_munged . "|" . $this_code}++;
                    $this_code=~s/PACK/$pack_name/g;

                    push @module_true_tests,
                        [$pack_name, $param_str, $this_code, $mod_code, $eval_code_munged];

                    if ($this_code!~/use/ and $this_code !~ /some_true_value/) {