In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a431a7fe2125b48581508ba742bf38e571bef1e1?hp=dd73cf18925e32a75c77fd20b406e6bcea3fc198>
- Log ----------------------------------------------------------------- commit a431a7fe2125b48581508ba742bf38e571bef1e1 Author: David Mitchell <[email protected]> Date: Sat Mar 23 21:29:26 2013 +0000 regcomp.c: silence compiler warning add a cast before doing a printf "%x" on a pointer M regcomp.c commit b30080379bde57076b4824d43c0d7163af81ad3f Author: David Mitchell <[email protected]> Date: Sat Mar 23 21:17:01 2013 +0000 add descriptions to require.t test output This is particularly important as in several places, the ok or not ok message is generated in different ways depending on whether a require successfully executed and printed "ok" for example. M t/comp/require.t commit 2b656fcc48f28912136698c28b3bd916c42d74f8 Author: David Mitchell <[email protected]> Date: Sat Mar 23 20:32:00 2013 +0000 fix Peek.t to work with NEW COW M dump.c M ext/Devel-Peek/t/Peek.t M ext/XS-APItest/t/svpeek.t ----------------------------------------------------------------------- Summary of changes: dump.c | 67 ++++++++++++++++++++-------------- ext/Devel-Peek/t/Peek.t | 3 +- ext/XS-APItest/t/svpeek.t | 10 +++--- regcomp.c | 3 +- t/comp/require.t | 88 ++++++++++++++++++++++---------------------- 5 files changed, 92 insertions(+), 79 deletions(-) diff --git a/dump.c b/dump.c index fcc63fc..eab747c 100644 --- a/dump.c +++ b/dump.c @@ -85,8 +85,6 @@ S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start, #define append_flags(sv, f, flags) \ S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags)) - - void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) { @@ -533,7 +531,10 @@ Perl_sv_peek(pTHX_ SV *sv) } type = SvTYPE(sv); if (type == SVt_PVCV) { - Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : ""); + SV * const tmp = newSVpvs_flags("", SVs_TEMP); + Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? + pv_display(tmp, GvNAME_get(CvGV(sv)), GvNAMELEN_get(CvGV(sv)), 0, 127) + : ""); goto finish; } else if (type < SVt_LAST) { sv_catpv(t, svshorttypenames[type]); @@ -549,7 +550,7 @@ Perl_sv_peek(pTHX_ SV *sv) if (!SvPVX_const(sv)) sv_catpv(t, "(null)"); else { - SV * const tmp = newSVpvs(""); + SV * const tmp = newSVpvs_flags("", SVs_TEMP); sv_catpv(t, "("); if (SvOOK(sv)) { STRLEN delta; @@ -561,7 +562,6 @@ Perl_sv_peek(pTHX_ SV *sv) Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", sv_uni_display(tmp, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ)); - SvREFCNT_dec_NN(tmp); } } else if (SvNOKp(sv)) { @@ -839,7 +839,7 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) { #define DUMP_OP_FLAGS(o,xml,level,file) \ if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \ - SV * const tmpsv = newSVpvs(""); \ + SV * const tmpsv = newSVpvs_flags("", SVs_TEMP); \ switch (o->op_flags & OPf_WANT) { \ case OPf_WANT_VOID: \ sv_catpv(tmpsv, ",VOID"); \ @@ -878,7 +878,7 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) { if (o->op_private) { \ U32 optype = o->op_type; \ U32 oppriv = o->op_private; \ - SV * const tmpsv = newSVpvs(""); \ + SV * const tmpsv = newSVpvs_flags("", SVs_TEMP); \ if (PL_opargs[optype] & OA_TARGLEX) { \ if (oppriv & OPpTARGET_MY) \ sv_catpv(tmpsv, ",TARGET_MY"); \ @@ -1014,7 +1014,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #ifdef PERL_MAD if (PL_madskills && o->op_madprop) { - SV * const tmpsv = newSVpvs(""); + SV * const tmpsv = newSVpvs_flags("", SVs_TEMP); MADPROP* mp = o->op_madprop; Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n"); level++; @@ -1065,6 +1065,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */ if (cSVOPo->op_sv) { SV * const tmpsv = newSV(0); + SV * const tmp = newSVpvs_flags("", SVs_TEMP); ENTER; SAVEFREESV(tmpsv); #ifdef PERL_MAD @@ -1074,7 +1075,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #endif gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL); Perl_dump_indent(aTHX_ level, file, "GV = %s\n", - SvPV_nolen_const(tmpsv)); + pv_display(tmp, SvPVX_const(tmpsv), SvCUR(tmpsv), SvLEN(tmpsv), 127)); LEAVE; } else @@ -1168,7 +1169,7 @@ Perl_op_dump(pTHX_ const OP *o) void Perl_gv_dump(pTHX_ GV *gv) { - SV *sv; + SV *sv, *tmp; PERL_ARGS_ASSERT_GV_DUMP; @@ -1177,12 +1178,15 @@ Perl_gv_dump(pTHX_ GV *gv) return; } sv = sv_newmortal(); + tmp = newSVpvs_flags("", SVs_TEMP); PerlIO_printf(Perl_debug_log, "{\n"); gv_fullname3(sv, gv, NULL); - Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv)); + Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", + pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127)); if (gv != GvEGV(gv)) { gv_efullname3(sv, GvEGV(gv), NULL); - Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv)); + Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", + pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127)); } PerlIO_putc(Perl_debug_log, '\n'); Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n"); @@ -1284,9 +1288,8 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr)); if (mg->mg_len >= 0) { if (mg->mg_type != PERL_MAGIC_utf8) { - SV * const sv = newSVpvs(""); + SV * const sv = newSVpvs_flags("", SVs_TEMP); PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim)); - SvREFCNT_dec_NN(sv); } } else if (mg->mg_len == HEf_SVKEY) { @@ -1339,7 +1342,7 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv) name which quite legally could contain insane things like tabs, newlines, nulls or other scary crap - this should produce sane results - except maybe for unicode package names - but we will wait for someone to file a bug on that - demerphq */ - SV * const tmpsv = newSVpvs(""); + SV * const tmpsv = newSVpvs_flags("", SVs_TEMP); PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024)); } else @@ -1365,11 +1368,15 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv) Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) { + SV * const tmp = newSVpvs_flags("", SVs_TEMP); const char *hvname; - PerlIO_printf(file, "\t\""); - if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv)))) - PerlIO_printf(file, "%s\" :: \"", hvname); - PerlIO_printf(file, "%s\"\n", GvNAME(sv)); + HV * const stash = GvSTASH(sv); + PerlIO_printf(file, "\t"); + if (stash && (hvname = HvNAME_get(stash))) + PerlIO_printf(file, "%s :: ", + pv_display(tmp, hvname, HvNAMELEN_get(stash), 0, 127)); + PerlIO_printf(file, "%s\n", + pv_display(tmp, GvNAME(sv), GvNAMELEN_get(sv), 0, 127)); } else PerlIO_putc(file, '\n'); @@ -1810,9 +1817,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } } { + SV * const tmp = newSVpvs_flags("", SVs_TEMP); const char * const hvname = HvNAME_get(sv); - if (hvname) - Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname); + if (HvNAMELEN_get(sv)) + Perl_dump_indent(aTHX_ level, file, " NAME = %s\n", + pv_display(tmp, hvname, HvNAMELEN_get(sv), 0, 127)); } if (SvOOK(sv)) { AV * const backrefs @@ -1826,6 +1835,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) { const I32 count = HvAUX(sv)->xhv_name_count; if (count) { + SV * const tmp = newSVpvs_flags("", SVs_TEMP); SV * const names = newSVpvs_flags("", SVs_TEMP); /* The starting point is the first element if count is positive and the second element if count is negative. */ @@ -1834,10 +1844,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names + (count < 0 ? -count : count); while (hekp < endp) { - if (*hekp) { - sv_catpvs(names, ", \""); - sv_catpvn(names, HEK_KEY(*hekp), HEK_LEN(*hekp)); - sv_catpvs(names, "\""); + if (HEK_LEN(*hekp)) { + Perl_sv_catpvf(aTHX_ names, ", %s", + pv_display(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), 0, pvlim)); } else { /* This should never happen. */ sv_catpvs(names, ", (null)"); @@ -1848,10 +1857,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo level, file, " ENAME = %s\n", SvPV_nolen(names)+2 ); } - else + else { + SV * const tmp = newSVpvs_flags("", SVs_TEMP); Perl_dump_indent(aTHX_ - level, file, " ENAME = \"%s\"\n", HvENAME_get(sv) - ); + level, file, " ENAME = %s\n", + pv_display(tmp, HvENAME_get(sv), HvENAMELEN_get(sv), 0, pvlim)); + } } if (backrefs) { Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n", diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 116c204..912bf8c 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -969,7 +969,8 @@ do_test('UTF-8 in a regular expression', SUBSTRS = $ADDR PPRIVATE = $ADDR OFFS = $ADDR - QR_ANONCV = 0x0 + QR_ANONCV = 0x0(?: + SAVED_COPY = 0x0)? '); done_testing(); diff --git a/ext/XS-APItest/t/svpeek.t b/ext/XS-APItest/t/svpeek.t index 59851d3..c8792b5 100644 --- a/ext/XS-APItest/t/svpeek.t +++ b/ext/XS-APItest/t/svpeek.t @@ -44,7 +44,7 @@ like (DPeek ($1), qr'^PVMG\("', ' $1'); is (DPeek (\@INC), '\AV()', '\@INC'); is (DPeek (\%INC), '\HV()', '\%INC'); is (DPeek (*STDOUT), 'GV()', '*STDOUT'); - is (DPeek (sub {}), '\CV(__ANON__)', 'sub {}'); + is (DPeek (sub {}), '\CV("__ANON__")', 'sub {}'); { our ($VAR, @VAR, %VAR); open VAR, "<", $^X or die "Can't open $^X: $!"; @@ -67,18 +67,18 @@ like (DPeek ($1), qr'^PVMG\("', ' $1'); is (DPeek ($VAR), 'PVIV("a\n\342\202\254"\0) [UTF8 "a\n\x{20ac}"]', ' $VAR "a\x0a\x{20ac}"'); $VAR = sub { "VAR" }; - is (DPeek ($VAR), '\CV(__ANON__)', ' $VAR sub { "VAR" }'); - is (DPeek (\$VAR), '\\\CV(__ANON__)', '\$VAR sub { "VAR" }'); + is (DPeek ($VAR), '\CV("__ANON__")', ' $VAR sub { "VAR" }'); + is (DPeek (\$VAR), '\\\CV("__ANON__")', '\$VAR sub { "VAR" }'); $VAR = 0; - is (DPeek (\&VAR), '\CV(VAR)', '\&VAR'); + is (DPeek (\&VAR), '\CV("VAR")', '\&VAR'); is (DPeek ( *VAR), 'GV()', ' *VAR'); is (DPeek (*VAR{GLOB}), '\GV()', ' *VAR{GLOB}'); like (DPeek (*VAR{SCALAR}), qr'\\PV(IV|MG)\(0\)',' *VAR{SCALAR}'); is (DPeek (*VAR{ARRAY}), '\AV()', ' *VAR{ARRAY}'); is (DPeek (*VAR{HASH}), '\HV()', ' *VAR{HASH}'); - is (DPeek (*VAR{CODE}), '\CV(VAR)', ' *VAR{CODE}'); + is (DPeek (*VAR{CODE}), '\CV("VAR")', ' *VAR{CODE}'); is (DPeek (*VAR{IO}), '\IO()', ' *VAR{IO}'); is (DPeek (*VAR{FORMAT}),$]<5.008?'SV_UNDEF':'\FM()',' *VAR{FORMAT}'); } diff --git a/regcomp.c b/regcomp.c index 316c4ee..6686d8b 100644 --- a/regcomp.c +++ b/regcomp.c @@ -11947,7 +11947,8 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, I32 *f they're valid on this machine */ NULL); if (!node) - FAIL2("panic: regclass returned NULL to handle_sets, flags=%#X", flagp); + FAIL2("panic: regclass returned NULL to handle_sets, flags=%#"UVxf, + PTR2UV(flagp)); if (save_fold) { RExC_flags |= RXf_PMf_FOLD; } diff --git a/t/comp/require.t b/t/comp/require.t index e958fdd..cdf19fb 100644 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -36,27 +36,27 @@ sub write_file { eval {require 5.005}; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.005 try 1\n"; eval { require 5.005 }; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.005 try 2\n"; eval { require 5.005; }; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.005 try 3\n"; eval { require 5.005 }; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.005 try 4\n"; # new style version numbers eval { require v5.5.630; }; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.5.630\n"; sub v5 { die } eval { require v5; }; @@ -65,74 +65,74 @@ print "ok ",$i++," - require v5 ignores sub named v5\n"; eval { require 10.0.2; }; print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 10.0.2\n"; my $ver = 5.005_63; eval { require $ver; }; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.005_63\n"; # check inaccurate fp $ver = 10.2; eval { require $ver; }; print "# $@\nnot " unless $@ =~ /^Perl v10\.200.0 required/; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 10.2\n"; $ver = 10.000_02; eval { require $ver; }; print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 10.000_02\n"; print "not " unless 5.5.1 gt v5.5; -print "ok ",$i++,"\n"; +print "ok ",$i++," - 5.5.1 gt v5.5\n"; { print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}"; - print "ok ",$i++,"\n"; + print "ok ",$i++," - v5.5.640 eq \\x{5}\\x{5}\\x{280}\n"; print "not " unless v7.15 eq "\x{7}\x{f}"; - print "ok ",$i++,"\n"; + print "ok ",$i++," - v7.15 eq \\x{7}\\x{f}\n"; print "not " unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}"; - print "ok ",$i++,"\n"; + print "ok ",$i++," - v1.20.300.4000.50000.600000 eq ...\n"; } # "use 5.11.0" (and higher) loads strictures. # check that this doesn't happen with require eval 'require 5.11.0; ${"foo"} = "bar";'; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require 5.11.0\n"; eval 'BEGIN {require 5.11.0} ${"foo"} = "bar";'; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++,"\ - BEGIN { require 5.11.0}\n"; # interaction with pod (see the eof) -write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); +write_file('bleah.pm', "print 'ok $i - require bleah.pm\n'; 1;\n"); require "bleah.pm"; $i++; # run-time failure in require do_require "0;\n"; print "# $@\nnot " unless $@ =~ /did not return a true/; -print "ok ",$i++,"\n"; +print "ok ",$i++," - require returning 0\n"; print "not " if exists $INC{'bleah.pm'}; -print "ok ",$i++,"\n"; +print "ok ",$i++," - %INC not updated\n"; my $flag_file = 'bleah.flg'; # run-time error in require for my $expected_compile (1,0) { write_file($flag_file, 1); print "not " unless -e $flag_file; - print "ok ",$i++,"\n"; + print "ok ",$i++," - exp $expected_compile; bleah.flg\n"; write_file('bleah.pm', "unlink '$flag_file' or die; \$a=0; \$b=1/\$a; 1;\n"); print "# $@\nnot " if eval { require 'bleah.pm' }; - print "ok ",$i++,"\n"; + print "ok ",$i++," - exp $expected_compile; require bleah.pm with flag file\n"; print "not " unless -e $flag_file xor $expected_compile; - print "ok ",$i++,"\n"; + print "ok ",$i++," - exp $expected_compile; -e flag_file\n"; print "not " unless exists $INC{'bleah.pm'}; - print "ok ",$i++,"\n"; + print "ok ",$i++," - exp $expected_compile; exists \$INC{'bleah.pm}\n"; } # compile-time failure in require @@ -140,31 +140,31 @@ do_require "1)\n"; # bison says 'parse error' instead of 'syntax error', # various yaccs may or may not capitalize 'syntax'. print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi; -print "ok ",$i++,"\n"; +print "ok ",$i++," - syntax error\n"; # previous failure cached in %INC print "not " unless exists $INC{'bleah.pm'}; -print "ok ",$i++,"\n"; +print "ok ",$i++," - cached %INC\n"; write_file($flag_file, 1); write_file('bleah.pm', "unlink '$flag_file'; 1"); print "# $@\nnot " if eval { require 'bleah.pm' }; -print "ok ",$i++,"\n"; +print "ok ",$i++," - eval { require 'bleah.pm' }\n"; print "# $@\nnot " unless $@ =~ /Compilation failed/i; -print "ok ",$i++,"\n"; +print "ok ",$i++," - Compilation failed\n"; print "not " unless -e $flag_file; -print "ok ",$i++,"\n"; +print "ok ",$i++," - -e flag_file\n"; print "not " unless exists $INC{'bleah.pm'}; -print "ok ",$i++,"\n"; +print "ok ",$i++," - \$INC{'bleah.pm'}\n"; # successful require do_require "1"; print "# $@\nnot " if $@; -print "ok ",$i++,"\n"; +print "ok ",$i++," - do_require '1';\n"; # do FILE shouldn't see any outside lexicals -my $x = "ok $i\n"; +my $x = "ok $i - bleah.do\n"; write_file("bleah.do", <<EOT); -\$x = "not ok $i\\n"; +\$x = "not ok $i - bleah.do\\n"; EOT do "bleah.do" or die $@; dofile(); @@ -194,9 +194,9 @@ my $r = "threads"; eval { require $r }; $i++; if($@ =~ /Can't locate threads in \@INC/) { - print "ok $i\n"; + print "ok $i - RT #24404\n"; } else { - print "not ok $i\n"; + print "not ok - RT #24404$i\n"; } @@ -204,15 +204,15 @@ write_file('bleah.pm', qq(die "This is an expected error";\n)); delete $INC{"bleah.pm"}; ++$::i; eval { CORE::require bleah; }; if ($@ =~ /^This is an expected error/) { - print "ok $i\n"; + print "ok $i - expected error\n"; } else { - print "not ok $i\n"; + print "not ok $i - expected error\n"; } sub write_file_not_thing { my ($file, $thing, $test) = @_; write_file($file, <<"EOT"); - print "not ok $test\n"; + print "not ok $test - write_file_not_thing $file\n"; die "The $thing file should not be loaded"; EOT } @@ -231,18 +231,18 @@ EOT if ($ccflags =~ /(?:^|\s)-DPERL_DISABLE_PMC\b/) { print "# .pmc files are ignored, so test that\n"; write_file_not_thing('krunch.pmc', '.pmc', $pmc_older); - write_file('urkkk.pm', qq(print "ok $simple\n")); + write_file('urkkk.pm', qq(print "ok $simple - urkkk.pm branch A\n")); write_file('whap.pmc', qq(die "This is not an expected error")); print "# Sleeping for 2 seconds before creating some more files\n"; sleep 2; - write_file('krunch.pm', qq(print "ok $pmc_older\n")); + write_file('krunch.pm', qq(print "ok $pmc_older - krunch.pm branch A\n")); write_file_not_thing('urkkk.pmc', '.pmc', $simple); write_file('whap.pm', qq(die "This is an expected error")); } else { print "# .pmc files should be loaded, so test that\n"; - write_file('krunch.pmc', qq(print "ok $pmc_older\n";)); + write_file('krunch.pmc', qq(print "ok $pmc_older - krunch.pm branch B\n";)); write_file_not_thing('urkkk.pm', '.pm', $simple); write_file('whap.pmc', qq(die "This is an expected error")); @@ -250,7 +250,7 @@ EOT sleep 2; write_file_not_thing('krunch.pm', '.pm', $pmc_older); - write_file('urkkk.pmc', qq(print "ok $simple\n";)); + write_file('urkkk.pmc', qq(print "ok $simple - urkkk.pm branch B\n";)); write_file_not_thing('whap.pm', '.pm', $pmc_dies); } require urkkk; @@ -258,9 +258,9 @@ EOT eval {CORE::require whap; 1} and die; if ($@ =~ /^This is an expected error/) { - print "ok $pmc_dies\n"; + print "ok $pmc_dies - pmc_dies\n"; } else { - print "not ok $pmc_dies\n"; + print "not ok $pmc_dies - pmc_dies\n"; } } @@ -273,9 +273,9 @@ if (defined &DynaLoader::boot_DynaLoader) { CORE::require(File::Spec::Functions::catfile(Cwd::getcwd(),"bleah.pm")); }; if ($@ =~ /^This is an expected error/) { - print "ok $i\n"; + print "ok $i - require(func())\n"; } else { - print "not ok $i\n"; + print "not ok $i - require(func())\n"; } } else { print "ok $i # SKIP Cwd may not be available in miniperl\n"; -- Perl5 Master Repository
