view release on metacpan or  search on metacpan

t/12cpan.t  view on Meta::CPAN

        }
    }
    $CPAN::Frontend = $CPAN::Frontend = "S";
    $_ = "Fcntl";
    my $m = CPAN::Shell->expand(Module => $_);
    $m->uptodate;
    is($_,"Fcntl","\$_ is properly localized");
    BEGIN{$count++}
}
{
    my @s;
    BEGIN{
        @s=(
            '"a"',
            '["a"]',
            '{a=>"b"}',
            '{"a;"=>"b"}',
            '"\\\\"',
           );
        $count+=@s;
    }
    for (0..$#s) {
        my $x = eval $s[$_];
        my $y = CPAN::HandleConfig->neatvalue($x);
        my $z = eval $y;
        is_deeply($z,$x,"s[$_]");
    }
}
{
    my $this_block_count;
    BEGIN { $count += $this_block_count = 2; }
    eval { require Kwalify; require YAML; }; # most of the kwalify
                                             # stuff does not work
                                             # without yaml
    if ($@ || (($YAML::VERSION||$YAML::VERSION||0) < 0.62)) { # silence 5.005_04
        for (1..$this_block_count) {
            ok(1, "dummy Kwalify/YAML $_");
        }
    } else {
        my $data = {
                    "match" => {
                                "distribution" => "^(ABW|ADAMK)/Template-Toolkit-2.16"
                               },
                    "pl" => {
                             "args" => [
                                        "TT_EXTRAS=no"
                                       ],
                             "expect" => [
                                          "Do you want to build the XS Stash module",
                                          "n\n",
                                          "Do you want to install these components",
                                          "n\n",
                                          "Installation directory",
                                          "\n",
                                          "URL base for TT2 images",
                                          "\n",
                                         ],
                             barth => '1984',
                            },
                   };
        eval {CPAN::Kwalify::_validate("distroprefs",
                                       $data,
                                       _f("t/12cpan.t"),
                                       0)};
        ok($@,"no kwalify [$@]");
        delete $data->{pl}{barth};
        CPAN::Kwalify::_clear_cache();
        eval {CPAN::Kwalify::_validate("distroprefs",
                                       $data,
                                       _f("t/12cpan.t"),
                                       0)};
        ok(!$@,"kwalify ok");
    }
}

{
    my $this_block_count;
    BEGIN { $count += $this_block_count = 8; }

    eval { require YAML::Syck; };
    my $excuse;
    if ($@) {
        $excuse = "YAML::Syck not available";
    } elsif (($YAML::Syck::VERSION||$YAML::Syck::VERSION||0) < 0.97) { # silence 5.005_04
        $excuse = "YAML::Syck too old";
    } elsif ($] < 5.008) {
        $excuse = "Defered code segfaults on 5.6.x";
    }
    if ($excuse) {
        for (1..$this_block_count) {
            ok(1, "Skipping ($excuse) $_");
        }
    } else {
        my $yaml_file = _f('t/yaml_code.yml');

        local $CPAN::Config->{yaml_module} = 'YAML::Syck';

        {
            my $data = CPAN->_yaml_loadfile($yaml_file, {loadblessed => 1})->[0];

            local $::yaml_load_code_works = 0;

            my $code = $data->{code};
            is(ref $code, 'CODE', 'deserialisation returned CODE');
            $code->();
            is($::yaml_load_code_works, 0, 'running the code did the right thing');

            my $obj = $data->{object};
            isa_ok($obj, 'CPAN::DeferredCode');
            local $^W;
            my $dummy = "$obj";
            is($::yaml_load_code_works, 0, 'stringifying the obj does nothing');
        }

        {
            local $CPAN::Config->{yaml_load_code} = 1;

            my $data = CPAN->_yaml_loadfile($yaml_file)->[0];

            local $::yaml_load_code_works = 0;

            my $code = $data->{code};
            is(ref $code, 'CODE', 'deserialisation returned CODE');
            $code->();
            is($::yaml_load_code_works, 1, 'running the code did the right thing');

            my $obj = $data->{object};
            isa_ok($obj, 'CPAN::DeferredCode');