Change 34439 by [EMAIL PROTECTED] on 2008/09/29 07:38:35
Integrate:
[ 34426]
Integrate:
[ 34416]
pv_uni_display () omitted backslash in output string
[ 34417]
New XS::APItest's for sv_peek based on my DDumper work
[ 34418]
Add new test file to MANIFEST. Fix tests for threaded builds.
[ 34419]
Don't skip exporting Perl_sv_peek in non-DEBUGGING builds since it
is now used in XS::APItest (as of #34417)
[ 34420]
$! and $1 are PVMG(), but their content is undefined when peeking
[ 34437]
Integrate:
[ 34433]
$? is PVLV on VMS (and actually, anywhere else where COMPLEX_STATUS is
defined).
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#444 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/APItest.pm#17 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/APItest.xs#22 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/t/svpeek.t#1 branch
... //depot/maint-5.8/perl/makedef.pl#51 integrate
... //depot/maint-5.8/perl/utf8.c#84 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#444 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#443~34438~ 2008-09-28 11:17:03.000000000 -0700
+++ perl/MANIFEST 2008-09-29 00:38:35.000000000 -0700
@@ -1108,6 +1108,7 @@
ext/XS/APItest/t/op.t XS::APItest: tests for OP related APIs
ext/XS/APItest/t/printf.t XS::APItest extension
ext/XS/APItest/t/push.t XS::APItest extension
+ext/XS/APItest/t/svpeek.t XS::APItest extension
ext/XS/APItest/t/svsetsv.t Test behaviour of sv_setsv with/without
PERL_CORE
ext/XS/APItest/t/xs_special_subs_require.t for require too
ext/XS/APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work
==== //depot/maint-5.8/perl/ext/XS/APItest/APItest.pm#17 (text) ====
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#16~32510~ 2007-11-26 13:35:15.000000000
-0800
+++ perl/ext/XS/APItest/APItest.pm 2008-09-29 00:38:35.000000000 -0700
@@ -22,6 +22,7 @@
apitest_exception mycroak strtab
my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
+ DPeek
);
# from cop.h
@@ -35,7 +36,7 @@
sub G_NODEBUG() { 32 }
sub G_METHOD() { 64 }
-our $VERSION = '0.12';
+our $VERSION = '0.15';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
==== //depot/maint-5.8/perl/ext/XS/APItest/APItest.xs#22 (text) ====
Index: perl/ext/XS/APItest/APItest.xs
--- perl/ext/XS/APItest/APItest.xs#21~32510~ 2007-11-26 13:35:15.000000000
-0800
+++ perl/ext/XS/APItest/APItest.xs 2008-09-29 00:38:35.000000000 -0700
@@ -814,6 +814,14 @@
sv_setsv_cow_hashkey_notcore()
void
+DPeek (sv)
+ SV *sv
+
+ PPCODE:
+ ST (0) = newSVpv (Perl_sv_peek (aTHX_ sv), 0);
+ XSRETURN (1);
+
+void
BEGIN()
CODE:
sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
==== //depot/maint-5.8/perl/ext/XS/APItest/t/svpeek.t#1 (text) ====
Index: perl/ext/XS/APItest/t/svpeek.t
--- /dev/null 2008-09-17 12:36:34.330355001 -0700
+++ perl/ext/XS/APItest/t/svpeek.t 2008-09-29 00:38:35.000000000 -0700
@@ -0,0 +1,101 @@
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+ print "1..0 # Skip: XS::APItest was not built\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings;
+
+use Test::More tests => 50;
+
+BEGIN { use_ok('XS::APItest') };
+
+$| = 1;
+
+ is (DPeek ($/), 'PVMG("\n"\0)', '$/');
+ is (DPeek ($\), 'PVMG()', '$\\');
+ is (DPeek ($.), 'PVMG()', '$.');
+ is (DPeek ($,), 'PVMG()', '$,');
+ is (DPeek ($;), 'PV("\34"\0)', '$;');
+ is (DPeek ($"), 'PV(" "\0)', '$"');
+ is (DPeek ($:), 'PVMG(" \n-"\0)', '$:');
+ is (DPeek ($~), 'PVMG()', '$~');
+ is (DPeek ($^), 'PVMG()', '$^');
+ is (DPeek ($=), 'PVMG()', '$=');
+ is (DPeek ($-), 'PVMG()', '$-');
+like (DPeek ($!), qr'^PVMG\("', '$!');
+if ($^O eq 'VMS') {
+ # VMS defines COMPLEX_STATUS and upgrades $? to PVLV
+ is (DPeek ($?), 'PVLV()', '$?');
+} else {
+ is (DPeek ($?), 'PVMG()', '$?');
+}
+ is (DPeek ($|), 'PVMG(1)', '$|');
+
+ "abc" =~ m/(b)/; # Don't know why these magic vars have this content
+like (DPeek ($1), qr'^PVMG\("', ' $1');
+ is (DPeek ($`), 'PVMG()', ' $`');
+ is (DPeek ($&), 'PVMG()', ' $&');
+ is (DPeek ($'), 'PVMG()', " \$'");
+
+ is (DPeek (undef), 'SV_UNDEF', 'undef');
+ is (DPeek (1), 'IV(1)', 'constant 1');
+ is (DPeek (""), 'PV(""\0)', 'constant ""');
+ is (DPeek (1.), 'NV(1)', 'constant 1.');
+ is (DPeek (\1), '\IV(1)', 'constant \1');
+ is (DPeek (\\1), '\\\IV(1)', 'constant \\\1');
+
+ is (DPeek ([EMAIL PROTECTED]), '\AV()', '[EMAIL
PROTECTED]');
+ is (DPeek ([EMAIL PROTECTED]), '\AV()', '[EMAIL
PROTECTED]');
+ is (DPeek (\%INC), '\HV()', '\%INC');
+ is (DPeek (*STDOUT), 'GV()', '*STDOUT');
+ is (DPeek (sub {}), '\CV(__ANON__)', 'sub {}');
+
+{ our ($VAR, @VAR, %VAR);
+ open VAR, ">VAR.txt";
+ sub VAR {}
+ format VAR =
+.
+ END { unlink "VAR.txt" };
+
+ is (DPeek ( $VAR), 'UNDEF', ' $VAR undef');
+ is (DPeek (\$VAR), '\UNDEF', '\$VAR undef');
+ $VAR = 1;
+ is (DPeek ($VAR), 'IV(1)', ' $VAR 1');
+ is (DPeek (\$VAR), '\IV(1)', '\$VAR 1');
+ $VAR = "";
+ is (DPeek ($VAR), 'PVIV(""\0)', ' $VAR ""');
+ is (DPeek (\$VAR), '\PVIV(""\0)', '\$VAR ""');
+ $VAR = "\xa8";
+ is (DPeek ($VAR), 'PVIV("\250"\0)', ' $VAR "\xa8"');
+ is (DPeek (\$VAR), '\PVIV("\250"\0)', '\$VAR "\xa8"');
+ SKIP: {
+ $] <= 5.008001 and skip "UTF8 tests useless in this ancient perl
version", 1;
+ $VAR = "a\x0a\x{20ac}";
+ 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" }');
+ $VAR = 0;
+
+ 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{IO}), '\IO()', ' *VAR{IO}');
+ is (DPeek (*VAR{FORMAT}),$]<5.008?'SV_UNDEF':'\FM()',' *VAR{FORMAT}');
+ }
+
+1;
==== //depot/maint-5.8/perl/makedef.pl#51 (text) ====
Index: perl/makedef.pl
--- perl/makedef.pl#50~34407~ 2008-09-23 06:31:36.000000000 -0700
+++ perl/makedef.pl 2008-09-29 00:38:35.000000000 -0700
@@ -594,7 +594,6 @@
Perl_debprofdump
Perl_debstack
Perl_debstackptrs
- Perl_sv_peek
Perl_hv_assert
PL_block_type
PL_watchaddr
==== //depot/maint-5.8/perl/utf8.c#84 (text) ====
Index: perl/utf8.c
--- perl/utf8.c#83~33217~ 2008-02-02 14:47:50.000000000 -0800
+++ perl/utf8.c 2008-09-29 00:38:35.000000000 -0700
@@ -2151,6 +2151,7 @@
}
if (ok) {
const char string = ok;
+ sv_catpvn(dsv, "\\", 1);
sv_catpvn(dsv, &string, 1);
}
}
End of Patch.
