p |bool |do_exec3 |NN const char* cmd|int fd|int do_report
#endif
p |void |do_execfree
+#ifdef PERL_IN_DOIO_C
+s |void |exec_failed |NN const char *cmd|int fd|int do_report
+#endif
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
p |I32 |do_ipcctl |I32 optype|NN SV** mark|NN SV** sp
p |I32 |do_ipcget |I32 optype|NN SV** mark|NN SV** sp
Ap |GV* |gv_HVadd |NN GV* gv
Ap |GV* |gv_IOadd |NN GV* gv
ApR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name|STRLEN len|I32 method
-Ap |void |gv_check |NN HV* stash
+Ap |void |gv_check |NN const HV* stash
Ap |void |gv_efullname |NN SV* sv|NN const GV* gv
Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix
Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain
dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg
p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg
p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg
-p |int |magic_existspack|NN SV* sv|NN MAGIC* mg
+p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg
p |int |magic_freeregexp|NN SV* sv|NN MAGIC* mg
p |int |magic_freeovrld|NN SV* sv|NN MAGIC* mg
p |int |magic_get |NN SV* sv|NN MAGIC* mg
Apd |void |sv_dec |NN SV* sv
Ap |void |sv_dump |NN SV* sv
ApdR |bool |sv_derived_from|NN SV* sv|NN const char* name
+ApdR |bool |sv_does |NN SV* sv|NN const char* name
Apd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2
Apd |void |sv_free |NULLOK SV* sv
poMX |void |sv_free2 |NN SV* sv
Apdmb |void |sv_unref |NN SV* sv
Apd |void |sv_unref_flags |NN SV* sv|U32 flags
Apd |void |sv_untaint |NN SV* sv
-Apd |void |sv_upgrade |NN SV* sv|U32 mt
+Apd |void |sv_upgrade |NN SV* sv|svtype new_type
Apdmb |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len
Apd |void |sv_usepvn_flags|NN SV* sv|NULLOK char* ptr|STRLEN len\
|U32 flags
Apd |void |sv_setsv_mg |NN SV *dstr|NULLOK SV *sstr
Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len
ApR |MGVTBL*|get_vtbl |int vtbl_id
-Ap |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \
+Apd |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \
|STRLEN pvlim
+Apd |char* |pv_escape |NN SV *dsv|NN const char *pv|const STRLEN count \
+ |const STRLEN max|const U32 flags
Afp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|...
Ap |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \
|NULLOK va_list *args
sn |void |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store
s |void |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash
sR |HEK* |share_hek_flags|NN const char* sv|I32 len|U32 hash|int flags
+sR |SV* |hv_magic_uvar_xkey|NN HV* hv|NN SV* keysv|int action
rs |void |hv_notallowed |int flags|NN const char *key|I32 klen|NN const char *msg
sn |struct xpvhv_aux*|hv_auxinit|NN HV *hv
sM |SV* |hv_delete_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key \
s |I32 |sortcv |NN SV *a|NN SV *b
s |I32 |sortcv_xsub |NN SV *a|NN SV *b
s |I32 |sortcv_stacked |NN SV *a|NN SV *b
+s |void |qsortsvu |NN SV** array|size_t num_elts|NN SVCOMPARE_t compare
#endif
#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
#endif
#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
-Es |regnode*|reg |NN struct RExC_state_t *state|I32 paren|NN I32 *flagp
+Es |regnode*|reg |NN struct RExC_state_t *state|I32 paren|NN I32 *flagp|U32 depth
Es |regnode*|reganode |NN struct RExC_state_t *state|U8 op|U32 arg
-Es |regnode*|regatom |NN struct RExC_state_t *state|NN I32 *flagp
-Es |regnode*|regbranch |NN struct RExC_state_t *state|NN I32 *flagp|I32 first
+Es |regnode*|regatom |NN struct RExC_state_t *state|NN I32 *flagp|U32 depth
+Es |regnode*|regbranch |NN struct RExC_state_t *state|NN I32 *flagp|I32 first|U32 depth
Es |STRLEN |reguni |NN const struct RExC_state_t *state|UV uv|NN char *s
-Es |regnode*|regclass |NN struct RExC_state_t *state
+Es |regnode*|regclass |NN struct RExC_state_t *state|U32 depth
ERsn |I32 |regcurly |NN const char *
Es |regnode*|reg_node |NN struct RExC_state_t *state|U8 op
-Es |regnode*|regpiece |NN struct RExC_state_t *state|NN I32 *flagp
+Es |regnode*|regpiece |NN struct RExC_state_t *state|NN I32 *flagp|U32 depth
Es |void |reginsert |NN struct RExC_state_t *state|U8 op|NN regnode *opnd
-Es |void |regtail |NN const struct RExC_state_t *state|NN regnode *p|NN const regnode *val
+Es |void |regtail |NN struct RExC_state_t *state|NN regnode *p|NN const regnode *val|U32 depth
+Es |U32 |join_exact |NN struct RExC_state_t *state|NN regnode *scan|NN I32 *min|U32 flags|NULLOK regnode *val|U32 depth
EsRn |char* |regwhite |NN char *p|NN const char *e
Es |char* |nextchar |NN struct RExC_state_t *state
-# ifdef DEBUGGING
-Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \
- |NN const regnode *node \
- |NULLOK const regnode *last|NN SV* sv|I32 l
-Es |void |put_byte |NN SV* sv|int c
-# endif
Es |void |scan_commit |NN const struct RExC_state_t* state|NN struct scan_data_t *data
Esn |void |cl_anything |NN const struct RExC_state_t* state|NN struct regnode_charclass_class *cl
EsRn |int |cl_is_anything |NN const struct regnode_charclass_class *cl
rs |void |re_croak2 |NN const char* pat1|NN const char* pat2|...
Es |I32 |regpposixcc |NN struct RExC_state_t* state|I32 value
Es |void |checkposixcc |NN struct RExC_state_t* state
-
Es |I32 |make_trie |NN struct RExC_state_t* state|NN regnode *startbranch \
|NN regnode *first|NN regnode *last|NN regnode *tail \
- |U32 flags
+ |U32 flags|U32 depth
+Es |void |make_trie_failtable |NN struct RExC_state_t* state \
+ |NN regnode *source|NN regnode *node|U32 depth
+# ifdef DEBUGGING
+Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \
+ |NN const regnode *node \
+ |NULLOK const regnode *last|NN SV* sv|I32 l
+Es |void |put_byte |NN SV* sv|int c
+Es |void |dump_trie |NN const struct _reg_trie_data *trie|U32 depth
+Es |void |dump_trie_interim_list|NN const struct _reg_trie_data *trie|U32 next_alloc|U32 depth
+Es |void |dump_trie_interim_table|NN const struct _reg_trie_data *trie|U32 next_alloc|U32 depth
+Es |U8 |regtail_study |NN struct RExC_state_t *state|NN regnode *p|NN const regnode *val|U32 depth
+# endif
#endif
#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK const regmatch_info *reginfo
Es |void |to_utf8_substr |NN regexp * prog
Es |void |to_byte_substr |NN regexp * prog
+# ifdef DEBUGGING
+Es |void |dump_exec_pos |NN const char *locinput|NN const regnode *scan|const bool do_utf8
+# endif
#endif
#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT)
#endif
#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
-s |bool|isa_lookup |NULLOK HV *stash|NN const char *name|NULLOK HV *name_stash|int len|int level
+s |bool|isa_lookup |NULLOK HV *stash|NN const char *name|NULLOK const HV * const name_stash|int len|int level
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
#
################################################################################
#
-# $Revision: 12 $
+# $Revision: 13 $
# $Author: mhx $
-# $Date: 2006/05/22 20:26:02 +0200 $
+# $Date: 2006/07/08 16:58:56 +0200 $
#
################################################################################
#
use List::Util qw(max);
use Config;
-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_07 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.09 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
$| = 1;
-my $verbose = 0;
-my $MAKE = $Config{make} || 'make';
my %OPT = (
verbose => 0,
make => $Config{make} || 'make',
min => '5.000',
+ color => 1,
);
-GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@)) or pod2usage(2);
+GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2);
$OPT{mmargs} = [''] unless exists $OPT{mmargs};
$OPT{min} = parse_version($OPT{min}) - 1e-10;
+sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
+
my @GoodPerls = map { $_->[0] }
sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
grep { $_->[1] >= $OPT{min} }
my $mmalen = max(map length, @{$OPT{mmargs}});
$maxlen += $mmalen+3 if $mmalen > 0;
-# run each through the test harness
-my(@good, @bad, $total);
+my $rep = Soak::Reporter->new( verbose => $OPT{verbose}
+ , color => $OPT{color}
+ , width => $maxlen
+ );
+
+$SIG{__WARN__} = sub { $rep->warn(@_) };
+$SIG{__DIE__} = sub { $rep->die(@_) };
# prime the pump, so the first "make realclean" will work.
-runit("$^X Makefile.PL") && runit("$MAKE realclean")
- or die "Cannot run $^X Makefile.PL && $MAKE realclean\n";
+runit("$^X Makefile.PL") && runit("$OPT{make} realclean")
+ or $rep->die("Cannot run $^X Makefile.PL && $OPT{make} realclean\n");
-print "Testing ", scalar @GoodPerls, " versions/configurations...\n\n";
+$rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n",
+ cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs(@GoodPerls*@{$OPT{mmargs}})));
for my $perl (@GoodPerls) {
for my $mm (@{$OPT{mmargs}}) {
- my $config = $mm =~ /\S+/ ? " ($mm)" : '';
- my $prefix = $verbose ? "$perl$config -- " : '';
- print "Testing $perl$config " . ('.' x ($maxlen - length($perl.$config)));
+ $rep->set(perl => $perl, config => $mm);
+
+ $rep->test;
+
+ my @warn_mfpl;
+ my @warn_make;
+ my @warn_test;
+
+ my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) &&
+ runit("$OPT{make}", \@warn_make) &&
+ runit("$OPT{make} test", \@warn_test);
- my $ok = runit("$perl Makefile.PL $mm") &&
- # runit("$perl Makefile.PL --with-apicheck") &&
- runit("$MAKE test");
+ $rep->warnings(['Makefile.PL' => \@warn_mfpl],
+ ['make' => \@warn_make],
+ ['make test' => \@warn_test]);
- $total++;
if ($ok) {
- push @good, [$perl, $mm];
- print "${prefix}ok\n";
+ $rep->passed;
}
else {
- push @bad, [$perl, $mm];
- print "${prefix}not ok\n";
+ $rep->failed;
}
- runit("$MAKE realclean");
+ runit("$OPT{make} realclean");
}
}
-if (@bad) {
- print "\nFailed with:\n";
- for my $fail (@bad) {
- my($perl, $mm) = @$fail;
- my $config = $mm =~ /\S+/ ? " ($mm)" : '';
- print " $perl$config\n";
- }
-}
-
-print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n";
-exit scalar @bad;
+exit $rep->finish;
sub runit
{
# TODO -- portability alert!!
- my $cmd = shift;
- print "\n Running [$cmd]\n" if $verbose;
+ my($cmd, $warn) = @_;
+ $rep->vsay("\n Running [$cmd]");
my $output = `$cmd 2>&1`;
$output = "\n" unless defined $output;
- $output =~ s/^/ /gm;
- print "\n Output\n$output\n" if $verbose || $?;
+ $output =~ s/^/ > /gm;
+ $rep->say("\n Output:\n$output") if $OPT{verbose} || $?;
if ($?) {
- warn " Running '$cmd' failed: $?\n";
+ $rep->warn(" Running '$cmd' failed: $?\n");
return 0;
}
+ push @$warn, $output =~ /(warning: .*)/ig;
return 1;
}
5.005 5.00501 5.00502 5.00503 5.00504
5.6.0 5.6.1 5.6.2
5.7.0 5.7.1 5.7.2 5.7.3
- 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6
- 5.9.0 5.9.1
+ 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 5.8.7 5.8.8
+ 5.9.0 5.9.1 5.9.2 5.9.3
);
print "Searching for Perl binaries...\n";
- my $mm = MM->new( { NAME => 'dummy' });
- my @path = $mm->path;
- my @GoodPerls;
# find_perl will send a warning to STDOUT if it can't find
# the requested perl, so need to temporarily silence STDOUT.
tie *STDOUT, 'NoSTDOUT';
+ my $mm = MM->new( { NAME => 'dummy' });
+ my @path = $mm->path;
+ my @GoodPerls;
+
for my $perl (@PerlBinaries) {
if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) {
push @GoodPerls, $abs;
and perl_version($File::Find::name)
and push @found, $File::Find::name;
}, $arg);
- printf "Found %d Perl binar%s in '%s'.\n\n", scalar @found, @found == 1 ? 'y' : 'ies', $arg;
+ printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg;
push @perls, @found;
}
else {
sub PRINT {}
sub WRITE {}
+package Soak::Reporter;
+
+use strict;
+
+sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
+
+sub new
+{
+ my $class = shift;
+ bless {
+ color => 1,
+ verbose => 0,
+ @_,
+ _atbol => 1,
+ _total => 0,
+ _good => [],
+ _bad => [],
+ }, $class;
+}
+
+sub colored
+{
+ my $self = shift;
+
+ if ($self->{color}) {
+ my $c = eval {
+ require Term::ANSIColor;
+ Term::ANSIColor::colored(@_);
+ };
+
+ if ($@) {
+ $self->{color} = 0;
+ }
+ else {
+ return $c;
+ }
+ }
+
+ return $_[0];
+}
+
+sub _config
+{
+ my $self = shift;
+ return $self->{config} =~ /\S+/ ? " ($self->{config})" : '';
+}
+
+sub _test
+{
+ my $self = shift;
+ return "Testing "
+ . $self->colored($self->{perl}, 'blue')
+ . $self->colored($self->_config, 'green');
+}
+
+sub _testlen
+{
+ my $self = shift;
+ return length("Testing " . $self->{perl} . $self->_config);
+}
+
+sub _dots
+{
+ my $self = shift;
+ return '.' x $self->_dotslen;
+}
+
+sub _dotslen
+{
+ my $self = shift;
+ return $self->{width} - length($self->{perl} . $self->_config);
+}
+
+sub _sep
+{
+ my $self = shift;
+ my $width = shift;
+ $self->print($self->colored('-'x$width, 'bold'), "\n");
+}
+
+sub _vsep
+{
+ goto &_sep if $_[0]->{verbose};
+}
+
+sub set
+{
+ my $self = shift;
+ while (@_) {
+ my($k, $v) = splice @_, 0, 2;
+ $self->{$k} = $v;
+ }
+}
+
+sub test
+{
+ my $self = shift;
+ $self->_vsep($self->_testlen);
+ $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' ');
+ $self->_vsep($self->_testlen);
+}
+
+sub _warnings
+{
+ my($self, $mode) = @_;
+
+ my $warnings = 0;
+ my $differ = 0;
+
+ for my $w (@{$self->{_warnings}}) {
+ if (@{$w->[1]}) {
+ $warnings += @{$w->[1]};
+ $differ++;
+ }
+ }
+
+ my $rv = '';
+
+ if ($warnings) {
+ if ($mode eq 'summary') {
+ $rv .= sprintf " (%d warning%s", cs($warnings);
+ }
+ else {
+ $rv .= "\n";
+ }
+
+ for my $w (@{$self->{_warnings}}) {
+ if (@{$w->[1]}) {
+ if ($mode eq 'detail') {
+ $rv .= " Warnings during '$w->[0]':\n";
+ my $cnt = 1;
+ for my $msg (@{$w->[1]}) {
+ $rv .= sprintf " [%d] %s", $cnt++, $msg;
+ }
+ $rv .= "\n";
+ }
+ else {
+ unless ($self->{verbose}) {
+ $rv .= $differ == 1 ? " during " . $w->[0]
+ : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]);
+ }
+ }
+ }
+ }
+
+ if ($mode eq 'summary') {
+ $rv .= ')';
+ }
+ }
+
+ return $rv;
+}
+
+sub _result
+{
+ my($self, $text, $color) = @_;
+ my $sum = $self->_warnings('summary');
+ my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2;
+
+ $self->_vsep($len);
+ $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol};
+ $self->print($self->colored($text, $color));
+ $self->print($self->colored($sum, 'red'));
+ $self->print("\n");
+ $self->_vsep($len);
+ $self->print($self->_warnings('detail')) if $self->{verbose};
+ $self->{_total}++;
+}
+
+sub passed
+{
+ my $self = shift;
+ $self->_result(@_, 'ok', 'bold green');
+ push @{$self->{_good}}, [$self->{perl}, $self->{config}];
+}
+
+sub failed
+{
+ my $self = shift;
+ $self->_result(@_, 'not ok', 'bold red');
+ push @{$self->{_bad}}, [$self->{perl}, $self->{config}];
+}
+
+sub warnings
+{
+ my $self = shift;
+ $self->{_warnings} = \@_;
+}
+
+sub _tobol
+{
+ my $self = shift;
+ print "\n" unless $self->{_atbol};
+ $self->{_atbol} = 1;
+}
+
+sub print
+{
+ my $self = shift;
+ my $text = join '', @_;
+ print $text;
+ $self->{_atbol} = $text =~ /[\r\n]$/;
+}
+
+sub say
+{
+ my $self = shift;
+ $self->_tobol;
+ $self->print(@_, "\n");
+}
+
+sub vsay
+{
+ goto &say if $_[0]->{verbose};
+}
+
+sub warn
+{
+ my $self = shift;
+ $self->say($self->colored(join('', @_), 'red'));
+}
+
+sub die
+{
+ my $self = shift;
+ $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red'));
+ exit -1;
+}
+
+sub status
+{
+ my($self, $text) = @_;
+ $self->_tobol;
+ $self->print($self->colored($text, 'bold'), "\n");
+}
+
+sub finish
+{
+ my $self = shift;
+
+ if (@{$self->{_bad}}) {
+ $self->status("\nFailed with:");
+ for my $fail (@{$self->{_bad}}) {
+ my($perl, $cfg) = @$fail;
+ $self->set(config => $cfg);
+ $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green'));
+ }
+ }
+
+ $self->status(sprintf("\nPassed with %d of %d combination%s.\n",
+ scalar @{$self->{_good}}, cs($self->{_total})));
+
+ return scalar @{$self->{_bad}};
+}
+
__END__
=head1 NAME
--min=version use at least this version of perl
--mmargs=options pass options to Makefile.PL (multiple --mmargs possible)
--verbose be verbose
+ --nocolor don't use colored output
+
+=head1 DESCRIPTION
+
+The F<soak> utility can be used to test Perl modules with
+multiple Perl releases or build options. It automates the
+task of running F<Makefile.PL> and the modules test suite.
+
+It is not primarily intended for cross-platform checking,
+so don't expect it to work on all platforms.
+
+=head1 EXAMPLES
+
+To test your favourite module, just change to its root
+directory (where the F<Makefile.PL> is located) and run:
+
+ soak
+
+This will automatically look for Perl binaries installed
+on your system.
+
+Alternatively, you can explicitly pass F<soak> a list of
+Perl binaries:
+
+ soak perl5.8.6 perl5.9.2
+
+Last but not least, you can pass it a list of directories
+to recursively search for Perl binaries, for example:
+
+ soak /tmp/perl/install /usr/bin
+
+All of the above examples will run
+
+ perl Makefile.PL
+ make
+ make test
+
+for your module and report success or failure.
+
+If your F<Makefile.PL> can take arguments, you may also
+want to test different configurations for your module.
+You can do so with the I<--mmargs> option:
+
+ soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug'
+
+This will run
+
+ perl Makefile.PL
+ make
+ make test
+ perl Makefile.PL CCFLAGS=-Wextra
+ make
+ make test
+ perl Makefile.PL enable-debug
+ make
+ make test
+
+for each Perl binary.
+
+If you have a directory full of different Perl binaries,
+but your module isn't expected to work with ancient perls,
+you can use the I<--min> option to specify the minimum
+version a Perl binary must have to be chosen for testing:
+
+ soak --min=5.8.1
+
+Usually, the output of F<soak> is rather terse, to give
+you a good overview. If you'd like to see more of what's
+going on, use the I<--verbose> option:
+
+ soak --verbose
=head1 COPYRIGHT
projects / p5sagit/p5-mst-13.2.git / commitdiff