diff options
| -rw-r--r-- | ext/XS/APItest/APItest.pm | 3 | ||||
| -rw-r--r-- | ext/XS/APItest/APItest.xs | 8 | ||||
| -rw-r--r-- | ext/XS/APItest/t/svpeek.t | 96 |
3 files changed, 106 insertions, 1 deletions
diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm index 31d5628c09..12d0a03e01 100644 --- a/ext/XS/APItest/APItest.pm +++ b/ext/XS/APItest/APItest.pm @@ -23,9 +23,10 @@ our @EXPORT = qw( print_double print_int print_long 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); diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs index 99af4a0104..b81e86d6f6 100644 --- a/ext/XS/APItest/APItest.xs +++ b/ext/XS/APItest/APItest.xs @@ -852,6 +852,14 @@ rmagical_flags(sv) 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)); diff --git a/ext/XS/APItest/t/svpeek.t b/ext/XS/APItest/t/svpeek.t new file mode 100644 index 0000000000..cf66f657a0 --- /dev/null +++ b/ext/XS/APItest/t/svpeek.t @@ -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 (\@ARGV), '\AV()', '\@ARGV'); + is (DPeek (\@INC), '\AV()', '\@INC'); + 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; |