view release on metacpan or  search on metacpan

inc/Test/Builder.pm  view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
our $VERSION = '0.94';
$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
BEGIN {
    if( $] < 5.008 ) {
        require Test::Builder::IO::Scalar;
    }
}
 
 
# Make Test::Builder thread-safe for ithreads.
BEGIN {
    use Config;
    # Load threads::shared when threads are turned on.
    # 5.8.0's threads are so busted we no longer support them.
    if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
        require threads::shared;
 
        # Hack around YET ANOTHER threads::shared bug.  It would
        # occassionally forget the contents of the variable when sharing it.
        # So we first copy the data, then share, then put our copy back.
        *share = sub (\[$@%]) {
            my $type = ref $_[0];
            my $data;
 
            if( $type eq 'HASH' ) {
                %$data = %{ $_[0] };
            }
            elsif( $type eq 'ARRAY' ) {
                @$data = @{ $_[0] };
            }
            elsif( $type eq 'SCALAR' ) {
                $$data = ${ $_[0] };
            }
            else {
                die( "Unknown type: " . $type );
            }
 
            $_[0] = &threads::shared::share( $_[0] );
 
            if( $type eq 'HASH' ) {
                %{ $_[0] } = %$data;
            }
            elsif( $type eq 'ARRAY' ) {
                @{ $_[0] } = @$data;
            }
            elsif( $type eq 'SCALAR' ) {
                ${ $_[0] } = $$data;
            }
            else {
                die( "Unknown type: " . $type );
            }
 
            return $_[0];
        };
    }
    # 5.8.0's threads::shared is busted when threads are off
    # and earlier Perls just don't have that module at all.
    else {
        *share = sub { return $_[0] };
        *lock  = sub { 0 };
    }
}
 
#line 117
 
our $Test = Test::Builder->new;

inc/Test/Builder.pm  view on Meta::CPAN

1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
my $test_results = $self->{Test_Results};
if(@$test_results) {
    # The plan?  We have no plan.
    if( $self->{No_Plan} ) {
        $self->_output_plan($self->{Curr_Test}) unless $self->no_header;
        $self->{Expected_Tests} = $self->{Curr_Test};
    }
 
    # Auto-extended arrays and elements which aren't explicitly
    # filled in with a shared reference will puke under 5.8.0
    # ithreads.  So we have to fill them in by hand. :(
    my $empty_result = &share( {} );
    for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) {
        $test_results->[$idx] = $empty_result
          unless defined $test_results->[$idx];
    }
 
    my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
 
    my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};

inc/Test/More.pm  view on Meta::CPAN

723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
    return 0 unless @$a1 == @$a2;
 
    no warnings 'uninitialized';
 
    # It really doesn't matter how we sort them, as long as both arrays are
    # sorted with the same algorithm.
    #
    # Ensure that references are not accidentally treated the same as a
    # string containing the reference.
    #
    # Have to inline the sort routine due to a threading/sort bug.
    # See [rt.cpan.org 6782]
    #
    # I don't know how references would be sorted so we just don't sort
    # them.  This means eq_set doesn't really work with refs.
    return eq_array(
        [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
        [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
    );
}