File Coverage

blib/lib/Test/Smoke.pm
Criterion Covered Total %
statement 44 95 46.3
branch 10 50 20.0
condition 4 15 26.6
subroutine 13 16 81.2
pod 6 6 100.0
total 77 182 42.3


line stmt bran cond sub pod time code
1             package Test::Smoke;
2 10     10   115267 use strict;
  10         30  
  10         387  
3              
4 10     10   58 use vars qw($VERSION $conf @EXPORT);
  10         20  
  10         695  
5             $VERSION = '1.80';
6              
7 10     10   57 use base 'Exporter';
  10         19  
  10         1237  
8             @EXPORT = qw( $conf &read_config &run_smoke );
9              
10             my $ConfigError;
11              
12 10     10   78 use File::Spec;
  10         19  
  10         302  
13 10     10   5153 use Test::Smoke::Policy;
  10         26  
  10         318  
14 10     10   5284 use Test::Smoke::BuildCFG;
  10         27  
  10         346  
15 10     10   6290 use Test::Smoke::Smoker;
  10         36  
  10         538  
16 10     10   6113 use Test::Smoke::SourceTree qw( :mani_const );
  10         34  
  10         1702  
17 10         600 use Test::Smoke::Util qw( get_patch skip_config
18 10     10   137 get_local_patches set_local_patch );
  10         22  
19 10     10   59 use Config;
  10         20  
  10         11641  
20              
21             =head1 NAME
22              
23             Test::Smoke - The Perl core test smoke suite
24              
25             =head1 SYNOPSIS
26              
27             use Test::Smoke;
28              
29             use vars qw( $VERSION );
30             $VERSION = Test::Smoke->VERSION;
31              
32             read_config( $config_name ) or warn Test::Smoke->config_error;
33              
34              
35             =head1 DESCRIPTION
36              
37             If you are looking to get started, start at the B!
38              
39             C exports C<$conf> and C by default.
40              
41             =head2 Test::Smoke::read_config( $config_name )
42              
43             Read (require) the configfile.
44              
45             =cut
46              
47             sub read_config {
48 2     2 1 1051 my( $config_name ) = @_;
49              
50 2 50 33     15 $config_name = 'smokecurrent_config'
51             unless defined $config_name && length $config_name;
52 2 100 66     39 $config_name .= '_config'
53             unless $config_name =~ /_config$/ || -f $config_name;
54              
55             # Enable reloading by hackery
56 2         22 local @INC = ( File::Spec->curdir, @INC );
57 2 100       9 delete $INC{ $config_name } if exists $INC{ $config_name };
58 2         4 eval { require $config_name };
  2         385  
59 2 50       31 $ConfigError = $@ ? $@ : undef;
60              
61 2 50       17 return defined $ConfigError ? undef : 1;
62             }
63              
64             =head2 Test::Smoke->config_error()
65              
66             Return the value of C<$ConfigError>
67              
68             =cut
69              
70             sub config_error {
71 2     2 1 9 return $ConfigError;
72             }
73              
74             =head2 is_win32( )
75              
76             C returns true if C<< $^O eq "MSWin32" >>.
77              
78             =cut
79              
80 0     0 1 0 sub is_win32() { $^O eq "MSWin32" }
81              
82             =head2 do_manifest_check( $ddir, $smoker )
83              
84             C uses B to do the
85             MANIFEST check.
86              
87             =cut
88              
89             sub do_manifest_check {
90 0     0 1 0 my( $ddir, $smoker ) = @_;
91              
92 0         0 my $tree = Test::Smoke::SourceTree->new( $ddir );
93 0         0 my $mani_check = $tree->check_MANIFEST( 'mktest.out', 'mktest.rpt' );
94 0         0 foreach my $file ( sort keys %$mani_check ) {
95 0 0       0 if ( $mani_check->{ $file } == ST_MISSING ) {
    0          
96 0         0 $smoker->log( "MANIFEST declared '$file' but it is missing\n" );
97             } elsif ( $mani_check->{ $file } == ST_UNDECLARED ) {
98 0         0 $smoker->log( "MANIFEST did not declare '$file'\n" );
99             }
100             }
101             }
102              
103             =head2 set_smoke_patchlevel( $ddir, $patch[, $verbose] )
104              
105             Set the current patchlevel as a registered patch like "SMOKE$patch"
106              
107             =cut
108              
109             sub set_smoke_patchlevel {
110 6     6 1 2230 my( $ddir, $patch, $verbose ) = @_;
111 6 50 33     26 $ddir && $patch or return;
112              
113 6         16 my @smokereg = grep
114             /^SMOKE[a-fA-F0-9]+$/
115             , get_local_patches( $ddir, $verbose );
116 6 100       27 @smokereg or set_local_patch( $ddir, "SMOKE$patch" );
117             }
118              
119             =head2 run_smoke( [$continue[, @df_buildopts]] )
120              
121             C sets up de build environment and gets the private Policy
122             file and build configurations and then runs the smoke stuff for all
123             configurations.
124              
125             All arguments after the C<$continue> are taken as default buildoptions
126             and passed to C<./Configure>.
127              
128             =cut
129              
130             sub run_smoke {
131 0     0 1   my $continue = shift;
132 0 0         defined $continue or $continue = $conf->{continue};
133              
134 0 0         my @df_buildopts = @_ ? grep /^-[DUA]/ => @_ : ();
135             # We *always* want -Dusedevel!
136 0 0         push @df_buildopts, '-Dusedevel'
137             unless grep /^-Dusedevel$/ => @df_buildopts;
138 0           Test::Smoke::BuildCFG->config( dfopts => join " ", @df_buildopts );
139              
140 0           my $patch = Test::Smoke::Util::get_patch( $conf->{ddir} );
141              
142             { # I cannot find a better place to stick this (thanks Bram!)
143             # change 33961 introduced Test::Harness 3 for 5.10.x
144             # that needs different parsing, so set the config to do that
145             # 20081220; new patchlevels due to git; cannot test it like an int
146 0 0         if ( $conf->{perl_version} eq '5.10.x' ) {
  0            
147 0           $conf->{hasharness3} = 1;
148             }
149             }
150              
151 0           my $logfile = File::Spec->catfile( $conf->{ddir}, 'mktest.out' );
152             my $BuildCFG = $continue
153             ? Test::Smoke::BuildCFG->continue( $logfile, $conf->{cfg},
154             v => $conf->{v} )
155 0 0         : Test::Smoke::BuildCFG->new( $conf->{cfg}, v => $conf->{v} );
156              
157 0           local *LOG;
158 0 0         my $mode = $continue ? ">>" : ">";
159 0 0         open LOG, "$mode $logfile" or die "Cannot create 'mktest.out': $!";
160              
161             my $Policy = Test::Smoke::Policy->new( File::Spec->updir, $conf->{v},
162 0           $BuildCFG->policy_targets );
163              
164 0           my $smoker = Test::Smoke::Smoker->new( \*LOG, $conf );
165 0           $smoker->mark_in;
166              
167             $conf->{v} && $conf->{defaultenv} and
168 0 0 0       $smoker->tty( "Running smoke tests without \$ENV{PERLIO}\n" );
169              
170 0           my $harness_msg;
171 0 0         if ( $conf->{harnessonly} ) {
172 0           $harness_msg = "Running test suite only with 'harness'";
173             $conf->{harness3opts} and
174 0 0         $harness_msg .= " with HARNESS_OPTIONS=$conf->{harness3opts}";
175             }
176 0 0 0       $conf->{v} && $harness_msg and $smoker->tty( "$harness_msg.\n" );
177              
178 0 0         chdir $conf->{ddir} or die "Cannot chdir($conf->{ddir}): $!";
179 0 0         unless ( $continue ) {
180 0           $smoker->make_distclean( );
181 0           $smoker->ttylog("Smoking patch $patch->[0] $patch->[1]\n");
182 0 0         $smoker->ttylog("Smoking branch $patch->[2]\n") if $patch->[2];
183 0           do_manifest_check( $conf->{ddir}, $smoker );
184 0           set_smoke_patchlevel( $conf->{ddir}, $patch->[0] );
185             }
186              
187 0           foreach my $this_cfg ( $BuildCFG->configurations ) {
188 0           $smoker->mark_out; $smoker->mark_in;
  0            
189 0 0         if ( skip_config( $this_cfg ) ) {
190 0           $smoker->ttylog( "Skipping: '$this_cfg'\n" );
191 0           next;
192             }
193              
194 0           $smoker->ttylog( join "\n",
195             "", "Configuration: $this_cfg", "-" x 78, "" );
196 0           $smoker->smoke( $this_cfg, $Policy );
197             }
198              
199 0           $smoker->ttylog( "Finished smoking $patch->[0] $patch->[1] $patch->[2]\n" );
200 0           $smoker->mark_out;
201              
202 0 0         close LOG or do {
203 0           require Carp;
204 0           Carp::carp "Error on closing logfile: $!";
205             };
206             }
207              
208             1;
209              
210             =head1 COPYRIGHT
211              
212             (c) 2003, All rights reserved.
213              
214             * Abe Timmerman
215              
216             This library is free software; you can redistribute it and/or modify
217             it under the same terms as Perl itself.
218              
219             See:
220              
221             =over 4
222              
223             =item * L
224              
225             =item * L
226              
227             =back
228              
229             This program is distributed in the hope that it will be useful,
230             but WITHOUT ANY WARRANTY; without even the implied warranty of
231             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
232              
233             =cut