Change 28507 by [EMAIL PROTECTED] on 2006/07/08 16:27:10
Upgrade to Devel::PPPort 3.09
Affected files ...
... //depot/perl/ext/Devel/PPPort/Changes#28 edit
... //depot/perl/ext/Devel/PPPort/HACKERS#8 edit
... //depot/perl/ext/Devel/PPPort/Makefile.PL#22 edit
... //depot/perl/ext/Devel/PPPort/PPPort_pm.PL#21 edit
... //depot/perl/ext/Devel/PPPort/parts/apidoc.fnc#7 edit
... //depot/perl/ext/Devel/PPPort/parts/base/5009004#5 edit
... //depot/perl/ext/Devel/PPPort/parts/embed.fnc#9 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/podtest#4 edit
... //depot/perl/ext/Devel/PPPort/parts/todo/5009004#5 edit
... //depot/perl/ext/Devel/PPPort/soak#16 edit
... //depot/perl/ext/Devel/PPPort/t/podtest.t#5 edit
Differences ...
==== //depot/perl/ext/Devel/PPPort/Changes#28 (xtext) ====
Index: perl/ext/Devel/PPPort/Changes
--- perl/ext/Devel/PPPort/Changes#27~28474~ 2006-07-03 14:40:58.000000000
-0700
+++ perl/ext/Devel/PPPort/Changes 2006-07-08 09:27:10.000000000 -0700
@@ -1,3 +1,13 @@
+3.09 - 2006-07-08
+
+ * fix Makefile.PL's c_o override
+ * update API info
+ * improve soak script
+ - now counts warnings emitted during testing
+ - output is colored (can be turned off)
+ * add a section on integrating this module into
+ the core to the HACKERS file
+
3.08_07 - 2006-07-03
* fix cpan #20179: Licensing information for PPPort is
==== //depot/perl/ext/Devel/PPPort/HACKERS#8 (text) ====
Index: perl/ext/Devel/PPPort/HACKERS
--- perl/ext/Devel/PPPort/HACKERS#7~28332~ 2006-05-29 10:50:48.000000000
-0700
+++ perl/ext/Devel/PPPort/HACKERS 2006-07-08 09:27:10.000000000 -0700
@@ -108,6 +108,12 @@
=item *
+You also need a freshly built bleadperl that is in the path under
+exactly this name. (The name of the executable is currently hardcoded
+in F<devel/mktodo> and F<devel/scanprov>.)
+
+=item *
+
Remove all existing todo files in the F<parts/base> and
F<parts/todo> directories.
@@ -288,6 +294,17 @@
can use the C<purge_all> target to delete all autogenerated
files.
+=head2 Integrating into the Perl core
+
+When integrating this module into the Perl core, be sure to
+remove the following files from the distribution. They are
+either not needed or generated on the fly when building this
+module in the core:
+
+ MANIFEST
+ META.yml
+ PPPort.pm
+
=head1 COPYRIGHT
Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
==== //depot/perl/ext/Devel/PPPort/Makefile.PL#22 (text) ====
Index: perl/ext/Devel/PPPort/Makefile.PL
--- perl/ext/Devel/PPPort/Makefile.PL#21~28474~ 2006-07-03 14:40:58.000000000
-0700
+++ perl/ext/Devel/PPPort/Makefile.PL 2006-07-08 09:27:10.000000000 -0700
@@ -4,9 +4,9 @@
#
################################################################################
#
-# $Revision: 25 $
+# $Revision: 26 $
# $Author: mhx $
-# $Date: 2006/07/03 21:48:31 +0200 $
+# $Date: 2006/07/08 11:44:45 +0200 $
#
################################################################################
#
@@ -19,17 +19,18 @@
#
################################################################################
-use ExtUtils::MakeMaker;
-use strict;
require 5.003;
+use strict;
+use ExtUtils::MakeMaker;
+
+use vars '%opt'; # needs to be global, and we can't use 'our'
+
unless ($ENV{'PERL_CORE'}) {
$ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
}
-my %opt;
-
[EMAIL PROTECTED] = map { /^--with-(.*)/ && ++$opt{$1} ? () : $_ } @ARGV;
[EMAIL PROTECTED] = map { /^--with-(apicheck)$/ && ++$opt{$1} ? () : $_ } @ARGV;
WriteMakefile(
NAME => 'Devel::PPPort',
@@ -124,13 +125,17 @@
package MY;
my $co = shift->SUPER::c_o(@_);
- $co .= <<'CO' if $::opt{'apicheck'} && $co !~ /^\.c\.i:/m;
+ if ($::opt{'apicheck'} && $co !~ /^\.c\.i:/m) {
+ print "Adding custom rule for preprocessed apicheck file...\n";
+
+ $co .= <<'CO'
.SUFFIXES: .i
.c.i:
$(CCCMD) -E -I$(PERL_INC) $(DEFINE) $*.c > $*.i
CO
+ }
return $co;
}
==== //depot/perl/ext/Devel/PPPort/PPPort_pm.PL#21 (text) ====
Index: perl/ext/Devel/PPPort/PPPort_pm.PL
--- perl/ext/Devel/PPPort/PPPort_pm.PL#20~28474~ 2006-07-03
14:40:58.000000000 -0700
+++ perl/ext/Devel/PPPort/PPPort_pm.PL 2006-07-08 09:27:10.000000000 -0700
@@ -4,9 +4,9 @@
#
################################################################################
#
-# $Revision: 46 $
+# $Revision: 47 $
# $Author: mhx $
-# $Date: 2006/06/25 03:41:11 +0200 $
+# $Date: 2006/07/08 11:44:19 +0200 $
#
################################################################################
#
@@ -68,7 +68,7 @@
# check consistency
for (@api) {
- if (exists $raw_todo{$_}) {
+ if (exists $raw_todo{$_} and exists $raw_base{$_}) {
if ($raw_base{$_} eq $raw_todo{$_}) {
warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
. "todo for " . format_version($raw_todo{$_}) . "\n";
@@ -335,9 +335,9 @@
#
################################################################################
#
-# $Revision: 46 $
+# $Revision: 47 $
# $Author: mhx $
-# $Date: 2006/06/25 03:41:11 +0200 $
+# $Date: 2006/07/08 11:44:19 +0200 $
#
################################################################################
#
@@ -498,7 +498,7 @@
use strict;
use vars qw($VERSION $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_07 $' =~
/(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.09 $' =~
/(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
sub _init_data
{
==== //depot/perl/ext/Devel/PPPort/parts/apidoc.fnc#7 (text) ====
Index: perl/ext/Devel/PPPort/parts/apidoc.fnc
--- perl/ext/Devel/PPPort/parts/apidoc.fnc#6~28307~ 2006-05-25
08:52:02.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/apidoc.fnc 2006-07-08 09:27:10.000000000
-0700
@@ -121,17 +121,11 @@
Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val
Am|SV*|newRV_inc|SV* sv
Am|SV*|ST|int ix
-Am|void|sv_catpvs|SV* sv|const char* s
Am|SV*|SvREFCNT_inc_NN|SV* sv
Am|SV*|SvREFCNT_inc_simple_NN|SV* sv
Am|SV*|SvREFCNT_inc_simple|SV* sv
-Am|void|SvREFCNT_inc_simple_void_NN|SV* sv
-Am|void|SvREFCNT_inc_simple_void|SV* sv
Am|SV*|SvREFCNT_inc|SV* sv
-Am|void|SvREFCNT_inc_void_NN|SV* sv
-Am|void|SvREFCNT_inc_void|SV* sv
Am|SV*|SvRV|SV* sv
-Am|void|sv_setpvs|SV* sv|const char* s
Am|svtype|SvTYPE|SV* sv
Ams||XCPT_RETHROW
Ams||XSRETURN_EMPTY
@@ -208,6 +202,7 @@
Am|void|Safefree|void* ptr
Am|void|StructCopy|type src|type dest|type
Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len
+Am|void|sv_catpvs|SV* sv|const char* s
Am|void|sv_catsv_nomg|SV* dsv|SV* ssv
Am|void|SvCUR_set|SV* sv|STRLEN len
Am|void|SvGETMAGIC|SV* sv
@@ -230,12 +225,17 @@
Am|void|SvPOK_on|SV* sv
Am|void|SvPV_set|SV* sv|char* val
Am|void|SvREFCNT_dec|SV* sv
+Am|void|SvREFCNT_inc_simple_void_NN|SV* sv
+Am|void|SvREFCNT_inc_simple_void|SV* sv
+Am|void|SvREFCNT_inc_void_NN|SV* sv
+Am|void|SvREFCNT_inc_void|SV* sv
Am|void|SvROK_off|SV* sv
Am|void|SvROK_on|SV* sv
Am|void|SvRV_set|SV* sv|SV* val
Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv
Am|void|SvSETMAGIC|SV* sv
Am|void|SvSetMagicSV|SV* dsb|SV* ssv
+Am|void|sv_setpvs|SV* sv|const char* s
Am|void|sv_setsv_nomg|SV* dsv|SV* ssv
Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv
Am|void|SvSetSV|SV* dsb|SV* ssv
==== //depot/perl/ext/Devel/PPPort/parts/base/5009004#5 (text) ====
Index: perl/ext/Devel/PPPort/parts/base/5009004
--- perl/ext/Devel/PPPort/parts/base/5009004#4~28332~ 2006-05-29
10:50:48.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/base/5009004 2006-07-08 09:27:10.000000000
-0700
@@ -19,8 +19,10 @@
my_vsnprintf # U
newXS_flags # U
pad_sv # U
+pv_escape # U
regclass_swash # E (Perl_regclass_swash)
stashpv_hvname_match # U
+sv_does # U
sv_setpvs # U
sv_usepvn_flags # U
PERL_BCDVERSION # added by devel/scanprov
==== //depot/perl/ext/Devel/PPPort/parts/embed.fnc#9 (text) ====
Index: perl/ext/Devel/PPPort/parts/embed.fnc
--- perl/ext/Devel/PPPort/parts/embed.fnc#8~28307~ 2006-05-25
08:52:02.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/embed.fnc 2006-07-08 09:27:10.000000000
-0700
@@ -206,6 +206,9 @@
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
@@ -269,7 +272,7 @@
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
@@ -417,7 +420,7 @@
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
@@ -806,6 +809,7 @@
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
@@ -859,7 +863,7 @@
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
@@ -976,8 +980,10 @@
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
@@ -1090,6 +1096,7 @@
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 \
@@ -1272,6 +1279,7 @@
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)
@@ -1284,25 +1292,20 @@
#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
@@ -1319,10 +1322,21 @@
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)
@@ -1338,6 +1352,9 @@
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)
@@ -1461,7 +1478,7 @@
#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)
==== //depot/perl/ext/Devel/PPPort/parts/inc/podtest#4 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/podtest
--- perl/ext/Devel/PPPort/parts/inc/podtest#3~28332~ 2006-05-29
10:50:48.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/podtest 2006-07-08 09:27:10.000000000
-0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 5 $
+## $Revision: 6 $
## $Author: mhx $
-## $Date: 2006/05/28 20:43:18 +0200 $
+## $Date: 2006/07/08 17:55:14 +0200 $
##
################################################################################
##
@@ -17,7 +17,7 @@
=tests plan => 0
-my @pods = qw( HACKERS PPPort.pm ppport.h devel/regenerate devel/buildperl.pl
);
+my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate
devel/buildperl.pl );
my $reason = '';
==== //depot/perl/ext/Devel/PPPort/parts/todo/5009004#5 (text) ====
Index: perl/ext/Devel/PPPort/parts/todo/5009004
--- perl/ext/Devel/PPPort/parts/todo/5009004#4~28332~ 2006-05-29
10:50:48.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/todo/5009004 2006-07-08 09:27:10.000000000
-0700
@@ -7,6 +7,8 @@
my_vsnprintf # U
newXS_flags # U
pad_sv # U
+pv_escape # U
regclass_swash # E (Perl_regclass_swash)
stashpv_hvname_match # U
+sv_does # U
sv_usepvn_flags # U
==== //depot/perl/ext/Devel/PPPort/soak#16 (text) ====
Index: perl/ext/Devel/PPPort/soak
--- perl/ext/Devel/PPPort/soak#15~28474~ 2006-07-03 14:40:58.000000000
-0700
+++ perl/ext/Devel/PPPort/soak 2006-07-08 09:27:10.000000000 -0700
@@ -7,9 +7,9 @@
#
################################################################################
#
-# $Revision: 12 $
+# $Revision: 13 $
# $Author: mhx $
-# $Date: 2006/05/22 20:26:02 +0200 $
+# $Date: 2006/07/08 16:58:56 +0200 $
#
################################################################################
#
@@ -33,22 +33,23 @@
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} }
@@ -64,65 +65,67 @@
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(@[EMAIL
PROTECTED])));
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)));
-
- my $ok = runit("$perl Makefile.PL $mm") &&
- # runit("$perl Makefile.PL --with-apicheck") &&
- runit("$MAKE test");
+ $rep->set(perl => $perl, config => $mm);
+
+ $rep->test;
+
+ my @warn_mfpl;
+ my @warn_make;
+ my @warn_test;
+
+ my $ok = runit("$perl Makefile.PL $mm", [EMAIL PROTECTED]) &&
+ runit("$OPT{make}", [EMAIL PROTECTED]) &&
+ runit("$OPT{make} test", [EMAIL PROTECTED]);
+
+ $rep->warnings(['Makefile.PL' => [EMAIL PROTECTED],
+ ['make' => [EMAIL PROTECTED],
+ ['make test' => [EMAIL PROTECTED]);
- $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");
- }
-}
-
-if (@bad) {
- print "\nFailed with:\n";
- for my $fail (@bad) {
- my($perl, $mm) = @$fail;
- my $config = $mm =~ /\S+/ ? " ($mm)" : '';
- print " $perl$config\n";
+ runit("$OPT{make} realclean");
}
}
-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;
}
@@ -142,19 +145,20 @@
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"], [EMAIL PROTECTED], 0)) {
push @GoodPerls, $abs;
@@ -184,7 +188,7 @@
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 {
@@ -226,6 +230,261 @@
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} = [EMAIL PROTECTED];
+}
+
+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
@@ -240,6 +499,77 @@
--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
==== //depot/perl/ext/Devel/PPPort/t/podtest.t#5 (text) ====
Index: perl/ext/Devel/PPPort/t/podtest.t
--- perl/ext/Devel/PPPort/t/podtest.t#4~28424~ 2006-06-25 01:13:33.000000000
-0700
+++ perl/ext/Devel/PPPort/t/podtest.t 2006-07-08 09:27:10.000000000 -0700
@@ -44,7 +44,7 @@
package main;
-my @pods = qw( HACKERS PPPort.pm ppport.h devel/regenerate devel/buildperl.pl
);
+my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate
devel/buildperl.pl );
my $reason = '';
End of Patch.
