package Test::Smoke; use strict; use vars qw($VERSION $conf @EXPORT); $VERSION = '1.70'; use base 'Exporter'; @EXPORT = qw( $conf &read_config &run_smoke ); my $ConfigError; use Test::Smoke::Policy; use Test::Smoke::BuildCFG; use Test::Smoke::Smoker; use Test::Smoke::SourceTree qw( :mani_const ); use Test::Smoke::Util qw( get_patch skip_config get_local_patches set_local_patch ); use Config; =head1 NAME Test::Smoke - The Perl core test smoke suite =head1 SYNOPSIS use Test::Smoke; use vars qw( $VERSION ); $VERSION = Test::Smoke->VERSION; read_config( $config_name ) or warn Test::Smoke->config_error; =head1 DESCRIPTION If you are looking to get started, start at the B! C exports C<$conf> and C by default. =head2 Test::Smoke::read_config( $config_name ) Read (require) the configfile. =cut sub read_config { my( $config_name ) = @_; $config_name = 'smokecurrent_config' unless defined $config_name && length $config_name; $config_name .= '_config' unless $config_name =~ /_config$/ || -f $config_name; # Enable reloading by hackery delete $INC{ $config_name } if exists $INC{ $config_name }; eval { require $config_name }; $ConfigError = $@ ? $@ : undef; return defined $ConfigError ? undef : 1; } =head2 Test::Smoke->config_error() Return the value of C<$ConfigError> =cut sub config_error { return $ConfigError; } =head2 is_win32( ) C returns true if C<< $^O eq "MSWin32" >>. =cut sub is_win32() { $^O eq "MSWin32" } =head2 do_manifest_check( $ddir, $smoker ) C uses B to do the MANIFEST check. =cut sub do_manifest_check { my( $ddir, $smoker ) = @_; my $tree = Test::Smoke::SourceTree->new( $ddir ); my $mani_check = $tree->check_MANIFEST( 'mktest.out', 'mktest.rpt' ); foreach my $file ( sort keys %$mani_check ) { if ( $mani_check->{ $file } == ST_MISSING ) { $smoker->log( "MANIFEST declared '$file' but it is missing\n" ); } elsif ( $mani_check->{ $file } == ST_UNDECLARED ) { $smoker->log( "MANIFEST did not declare '$file'\n" ); } } } =head2 set_smoke_patchlevel( $ddir, $patch[, $verbose] ) Set the current patchlevel as a registered patch like "SMOKE$patch" =cut sub set_smoke_patchlevel { my( $ddir, $patch, $verbose ) = @_; $ddir && $patch or return; my @smokereg = grep /^SMOKE[a-fA-F0-9]+$/ , get_local_patches( $ddir, $verbose ); @smokereg or set_local_patch( $ddir, "SMOKE$patch" ); } =head2 run_smoke( [$continue[, @df_buildopts]] ) C sets up de build environment and gets the private Policy file and build configurations and then runs the smoke stuff for all configurations. All arguments after the C<$continue> are taken as default buildoptions and passed to C<./Configure>. =cut sub run_smoke { my $continue = shift; defined $continue or $continue = $conf->{continue}; my @df_buildopts = @_ ? grep /^-[DUA]/ => @_ : (); # We *always* want -Dusedevel! push @df_buildopts, '-Dusedevel' unless grep /^-Dusedevel$/ => @df_buildopts; Test::Smoke::BuildCFG->config( dfopts => join " ", @df_buildopts ); my $patch = Test::Smoke::Util::get_patch( $conf->{ddir} ); { # I cannot find a better place to stick this (thanks Bram!) # change 33961 introduced Test::Harness 3 for 5.10.x # that needs different parsing, so set the config to do that # 20081220; new patchlevels due to git; cannot test it like an int if ( $conf->{perl_version} eq '5.10.x' ) { $conf->{hasharness3} = 1; } } my $logfile = File::Spec->catfile( $conf->{ddir}, 'mktest.out' ); my $BuildCFG = $continue ? Test::Smoke::BuildCFG->continue( $logfile, $conf->{cfg}, v => $conf->{v} ) : Test::Smoke::BuildCFG->new( $conf->{cfg}, v => $conf->{v} ); local *LOG; my $mode = $continue ? ">>" : ">"; open LOG, "$mode $logfile" or die "Cannot create 'mktest.out': $!"; my $Policy = Test::Smoke::Policy->new( File::Spec->updir, $conf->{v}, $BuildCFG->policy_targets ); my $smoker = Test::Smoke::Smoker->new( \*LOG, $conf ); $smoker->mark_in; $conf->{v} && $conf->{defaultenv} and $smoker->tty( "Running smoke tests without \$ENV{PERLIO}\n" ); my $harness_msg; if ( $conf->{harnessonly} ) { $harness_msg = "Running test suite only with 'harness'"; $conf->{harness3opts} and $harness_msg .= " with HARNESS_OPTIONS=$conf->{harness3opts}"; } $conf->{v} && $harness_msg and $smoker->tty( "$harness_msg.\n" ); chdir $conf->{ddir} or die "Cannot chdir($conf->{ddir}): $!"; unless ( $continue ) { $smoker->make_distclean( ); $smoker->ttylog("Smoking patch $patch->[0] $patch->[1]\n"); $smoker->ttylog("Smoking branch $patch->[2]\n") if $patch->[2]; do_manifest_check( $conf->{ddir}, $smoker ); set_smoke_patchlevel( $conf->{ddir}, $patch->[0] ); } foreach my $this_cfg ( $BuildCFG->configurations ) { $smoker->mark_out; $smoker->mark_in; if ( skip_config( $this_cfg ) ) { $smoker->ttylog( "Skipping: '$this_cfg'\n" ); next; } $smoker->ttylog( join "\n", "", "Configuration: $this_cfg", "-" x 78, "" ); $smoker->smoke( $this_cfg, $Policy ); } $smoker->ttylog( "Finished smoking $patch->[0] $patch->[1] $patch->[2]\n" ); $smoker->mark_out; close LOG or do { require Carp; Carp::carp "Error on closing logfile: $!"; }; } 1; =head1 COPYRIGHT (c) 2003, All rights reserved. * Abe Timmerman This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See: =over 4 =item * L =item * L =back This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut