From: Marcus Holland-Moritz Date: Sat, 8 Jul 2006 16:27:10 +0000 (+0000) Subject: Upgrade to Devel::PPPort 3.09 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=56093a11cb59f21ab1aaab1c6cbb516a423086f9;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Devel::PPPort 3.09 p4raw-id: //depot/perl@28507 --- diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes index fa62091..db402e9 100755 --- a/ext/Devel/PPPort/Changes +++ b/ext/Devel/PPPort/Changes @@ -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 diff --git a/ext/Devel/PPPort/HACKERS b/ext/Devel/PPPort/HACKERS index 5ebd7f1..aed6e93 100644 --- a/ext/Devel/PPPort/HACKERS +++ b/ext/Devel/PPPort/HACKERS @@ -108,6 +108,12 @@ in F, so most of the tools take this as a default. =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 and F.) + +=item * + Remove all existing todo files in the F and F directories. @@ -288,6 +294,17 @@ and don't include the differences of the generated files. You can use the C 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. diff --git a/ext/Devel/PPPort/Makefile.PL b/ext/Devel/PPPort/Makefile.PL index a73ebcf..7c50c4f 100644 --- a/ext/Devel/PPPort/Makefile.PL +++ b/ext/Devel/PPPort/Makefile.PL @@ -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; - -@ARGV = map { /^--with-(.*)/ && ++$opt{$1} ? () : $_ } @ARGV; +@ARGV = map { /^--with-(apicheck)$/ && ++$opt{$1} ? () : $_ } @ARGV; WriteMakefile( NAME => 'Devel::PPPort', @@ -124,13 +125,17 @@ sub MY::c_o 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; } diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL index 15f9697..a74aa38 100644 --- a/ext/Devel/PPPort/PPPort_pm.PL +++ b/ext/Devel/PPPort/PPPort_pm.PL @@ -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 @@ for (keys %raw_todo) { # 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 @@ __DATA__ # ################################################################################ # -# $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 @@ package Devel::PPPort; 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 { diff --git a/ext/Devel/PPPort/parts/apidoc.fnc b/ext/Devel/PPPort/parts/apidoc.fnc index d5fefdd..5daf5c3 100644 --- a/ext/Devel/PPPort/parts/apidoc.fnc +++ b/ext/Devel/PPPort/parts/apidoc.fnc @@ -121,17 +121,11 @@ Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval 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|Renew|void* ptr|int nitems|type 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_only_UTF8|SV* sv 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 diff --git a/ext/Devel/PPPort/parts/base/5009004 b/ext/Devel/PPPort/parts/base/5009004 index a3ec54a..cb6baa8 100644 --- a/ext/Devel/PPPort/parts/base/5009004 +++ b/ext/Devel/PPPort/parts/base/5009004 @@ -19,8 +19,10 @@ my_snprintf # U 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 diff --git a/ext/Devel/PPPort/parts/embed.fnc b/ext/Devel/PPPort/parts/embed.fnc index bd4bd93..81127e0 100644 --- a/ext/Devel/PPPort/parts/embed.fnc +++ b/ext/Devel/PPPort/parts/embed.fnc @@ -206,6 +206,9 @@ Ap |int |do_spawn_nowait|NN char* cmd 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_AVadd |NN GV* gv 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 @@ p |int |magic_clear_all_env|NN SV* sv|NN MAGIC* mg 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 |int |getcwd_sv |NN SV* sv 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 @@ Apd |int |sv_unmagic |NN SV* sv|int type 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_setpvn_mg |NN SV *sv|NN const char *ptr|STRLEN len 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 @@ sanR |HEK* |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags 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 |amagic_cmp_locale|NN SV *a|NN SV *b 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 @@ s |SV * |space_join_names_mortal|NN char *const *array #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 @@ EsRn |I32 |add_data |NN struct RExC_state_t* state|I32 n|NN const char *s 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 @@ ERsn |U8* |reghopmaybe3 |NN U8 *pos|I32 off|NN const U8 *lim 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 @@ s |void |printbuf |NN const char* fmt|NN const char* s #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) diff --git a/ext/Devel/PPPort/parts/inc/podtest b/ext/Devel/PPPort/parts/inc/podtest index 3243c17..dd5668b 100644 --- a/ext/Devel/PPPort/parts/inc/podtest +++ b/ext/Devel/PPPort/parts/inc/podtest @@ -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 = ''; diff --git a/ext/Devel/PPPort/parts/todo/5009004 b/ext/Devel/PPPort/parts/todo/5009004 index d234bee..431f8c7 100644 --- a/ext/Devel/PPPort/parts/todo/5009004 +++ b/ext/Devel/PPPort/parts/todo/5009004 @@ -7,6 +7,8 @@ gv_name_set # U 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 diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak index 02c631b..99d41ec 100644 --- a/ext/Devel/PPPort/soak +++ b/ext/Devel/PPPort/soak @@ -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 File::Find; 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 $maxlen = max(map length, @GoodPerls) + 3; 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; } @@ -142,19 +145,20 @@ sub FindPerls 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; @@ -184,7 +188,7 @@ sub SearchPerls 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 TIEHANDLE { bless \(my $s = ''), shift } 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 @@ -240,6 +499,77 @@ soak - Test Perl modules with multiple Perl releases --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 utility can be used to test Perl modules with +multiple Perl releases or build options. It automates the +task of running F 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 is located) and run: + + soak + +This will automatically look for Perl binaries installed +on your system. + +Alternatively, you can explicitly pass F 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 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 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 diff --git a/ext/Devel/PPPort/t/podtest.t b/ext/Devel/PPPort/t/podtest.t index bf7ed53..2b2216b 100644 --- a/ext/Devel/PPPort/t/podtest.t +++ b/ext/Devel/PPPort/t/podtest.t @@ -44,7 +44,7 @@ bootstrap Devel::PPPort; 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 = '';