view release on metacpan or  search on metacpan

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

1
2
3
4
5
6
7
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
#line 1
package Test::Builder;
 
use 5.006;
use strict;
 
our $VERSION = '0.80';
$VERSION = eval { $VERSION }; # make the alpha version come out as a number
 
# 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 110

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

1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
my $test_results = $self->{Test_Results};
if( @$test_results ) {
    # The plan?  We have no plan.
    if( $self->{No_Plan} ) {
        $self->_print("1..$self->{Curr_Test}\n") 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

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
 
    # There's faster ways to do this, but this is easiest.
    local $^W = 0;
 
    # 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) )],
    );
}