Change 34417: New XS::APItest's for sv_peek based on my DDumper work
Change 34417 by [EMAIL PROTECTED] on 2008/09/25 12:54:16
New XS::APItest's for sv_peek based on my DDumper work
Affected files ...
... //depot/perl/ext/XS/APItest/APItest.pm#23 edit
... //depot/perl/ext/XS/APItest/APItest.xs#45 edit
... //depot/perl/ext/XS/APItest/t/svpeek.t#1 add
Differences ...
//depot/perl/ext/XS/APItest/APItest.pm#23 (text)
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#22~33458~2008-03-10 05:56:41.0
-0700
+++ perl/ext/XS/APItest/APItest.pm 2008-09-25 05:54:16.0 -0700
@@ -23,9 +23,10 @@
my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
rmagical_cast rmagical_flags
+ DPeek
);
-our $VERSION = '0.14';
+our $VERSION = '0.15';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
//depot/perl/ext/XS/APItest/APItest.xs#45 (text)
Index: perl/ext/XS/APItest/APItest.xs
--- perl/ext/XS/APItest/APItest.xs#44~33458~2008-03-10 05:56:41.0
-0700
+++ perl/ext/XS/APItest/APItest.xs 2008-09-25 05:54:16.0 -0700
@@ -852,6 +852,14 @@
XSRETURN(3);
void
+DPeek (sv)
+SV *sv
+
+ PPCODE:
+ST (0) = newSVpv (Perl_sv_peek (sv), 0);
+XSRETURN (1);
+
+void
BEGIN()
CODE:
sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
//depot/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-25 05:54:16.0 -0700
@@ -0,0 +1,96 @@
+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 => 49;
+
+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()', '$-');
+ is (DPeek ($!),'PVMG(""\0)', '$!');
+ is (DPeek ($?),'PVMG()', '$?');
+ is (DPeek ($|),'PVMG(1)','$|');
+
+ "abc" =~ m/(b)/; # Don't know why these magic vars have this content
+# is (DPeek ($1),'PVMG("$"\0)',' $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" }');
+
Change 34417: New XS::APItest's for sv_peek based on my DDumper work
Change 34417 by [EMAIL PROTECTED] on 2008/09/25 12:54:16
New XS::APItest's for sv_peek based on my DDumper work
Affected files ...
... //depot/perl/ext/XS/APItest/APItest.pm#23 edit
... //depot/perl/ext/XS/APItest/APItest.xs#45 edit
... //depot/perl/ext/XS/APItest/t/svpeek.t#1 add
Differences ...
//depot/perl/ext/XS/APItest/APItest.pm#23 (text)
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#22~33458~2008-03-10 05:56:41.0
-0700
+++ perl/ext/XS/APItest/APItest.pm 2008-09-25 05:54:16.0 -0700
@@ -23,9 +23,10 @@
my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
rmagical_cast rmagical_flags
+ DPeek
);
-our $VERSION = '0.14';
+our $VERSION = '0.15';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
//depot/perl/ext/XS/APItest/APItest.xs#45 (text)
Index: perl/ext/XS/APItest/APItest.xs
--- perl/ext/XS/APItest/APItest.xs#44~33458~2008-03-10 05:56:41.0
-0700
+++ perl/ext/XS/APItest/APItest.xs 2008-09-25 05:54:16.0 -0700
@@ -852,6 +852,14 @@
XSRETURN(3);
void
+DPeek (sv)
+SV *sv
+
+ PPCODE:
+ST (0) = newSVpv (Perl_sv_peek (sv), 0);
+XSRETURN (1);
+
+void
BEGIN()
CODE:
sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
//depot/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-25 05:54:16.0 -0700
@@ -0,0 +1,96 @@
+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 => 49;
+
+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()', '$-');
+ is (DPeek ($!),'PVMG(""\0)', '$!');
+ is (DPeek ($?),'PVMG()', '$?');
+ is (DPeek ($|),'PVMG(1)','$|');
+
+ "abc" =~ m/(b)/; # Don't know why these magic vars have this content
+# is (DPeek ($1),'PVMG("$"\0)',' $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" }');
+
