In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/84556172294db864f27a4b5df6dac9127e1e7205?hp=bee8aa44140bbc2d7566da206b8e0cbf146397d0>
- Log ----------------------------------------------------------------- commit 84556172294db864f27a4b5df6dac9127e1e7205 Author: Nicholas Clark <[email protected]> Date: Sun Oct 24 13:35:06 2010 +0200 B::perlstring can be implemented as an ALIAS of B::cstring. M ext/B/B.xs commit 47bf35fab2e1eb0d7c70b8443f83839a53f93fef Author: Nicholas Clark <[email protected]> Date: Sun Oct 24 12:26:43 2010 +0200 In cstring() in B.xs, use Perl_sv_catpvf(), instead of a temporary buffer. M ext/B/B.xs commit f9a209693b94995999347a76d83c45eb766f222c Author: Nicholas Clark <[email protected]> Date: Sun Oct 24 12:13:23 2010 +0200 More comprehensive tests for B::cstring() and B::perlstring(). M ext/B/t/b.t ----------------------------------------------------------------------- Summary of changes: ext/B/B.xs | 20 +++++--------------- ext/B/t/b.t | 31 ++++++++++++++++++++++++++++--- 2 files changed, 33 insertions(+), 18 deletions(-) diff --git a/ext/B/B.xs b/ext/B/B.xs index 004b5eb..92b45b4 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -377,9 +377,7 @@ cstring(pTHX_ SV *sv, bool perlstyle) sv_catpvs(sstr, "\\\\"); /* trigraphs - bleagh */ else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') { - char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */ - const STRLEN oct_len = my_sprintf(escbuff, "\\%03o", '?'); - sv_catpvn(sstr, escbuff, oct_len); + Perl_sv_catpvf(aTHX_ sstr, "\\%03o", '?'); } else if (perlstyle && *s == '$') sv_catpvs(sstr, "\\$"); @@ -408,10 +406,8 @@ cstring(pTHX_ SV *sv, bool perlstyle) else { /* Don't want promotion of a signed -1 char in sprintf args */ - char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */ const unsigned char c = (unsigned char) *s; - const STRLEN oct_len = my_sprintf(escbuff, "\\%03o", c); - sv_catpvn(sstr, escbuff, oct_len); + Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c); } /* XXX Add line breaks if string is long */ } @@ -815,16 +811,10 @@ save_BEGINs() SV * cstring(sv) SV * sv + ALIAS: + perlstring = 1 CODE: - RETVAL = cstring(aTHX_ sv, 0); - OUTPUT: - RETVAL - -SV * -perlstring(sv) - SV * sv - CODE: - RETVAL = cstring(aTHX_ sv, 1); + RETVAL = cstring(aTHX_ sv, ix); OUTPUT: RETVAL diff --git a/ext/B/t/b.t b/ext/B/t/b.t index f0211bd..7691e97 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -12,7 +12,7 @@ BEGIN { $| = 1; use warnings; use strict; -use Test::More tests => 57; +use Test::More; BEGIN { use_ok( 'B' ); } @@ -157,8 +157,31 @@ is(B::ppname(0), "pp_null", "Testing ppname (this might break if opnames.h is ch is(B::opnumber("null"), 0, "Testing opnumber with opname (null)"); is(B::opnumber("pp_null"), 0, "Testing opnumber with opname (pp_null)"); like(B::hash("wibble"), qr/0x[0-9a-f]*/, "Testing B::hash()"); -is(B::cstring("wibble"), '"wibble"', "Testing B::cstring()"); -is(B::perlstring("wibble"), '"wibble"', "Testing B::perlstring()"); +{ + is(B::cstring(undef), '0', "Testing B::cstring(undef)"); + is(B::perlstring(undef), '0', "Testing B::perlstring(undef)"); + + my @common = map {eval $_, $_} + '"wibble"', '"\""', '"\'"', '"\\\\"', '"\\n\\r\\t\\b\\a\\f"', '"\\177"'; + + my $oct = sprintf "\\%03o", ord '?'; + my @tests = (@common, '$_', '"$_"', '@_', '"@_"', '??N', qq{"$oct?N"}, + ord 'N' == 78 ? (chr 11, '"\v"'): ()); + while (my ($test, $expect) = splice @tests, 0, 2) { + is(B::cstring($test), $expect, "B::cstring($expect)"); + } + + @tests = (@common, '$_', '"\$_"', '@_', '"\...@_"', '??N', '"??N"', + chr 256, '"\x{100}"', chr 65536, '"\x{10000}"', + ord 'N' == 78 ? (chr 11, '"\013"'): ()); + while (my ($test, $expect) = splice @tests, 0, 2) { + is(B::perlstring($test), $expect, "B::perlstring($expect)"); + utf8::upgrade $test; + $expect =~ s/\\b/\\x\{8\}/g; + $expect =~ s/\\([0-7]{3})/sprintf "\\x\{%x\}", oct $1/eg; + is(B::perlstring($test), $expect, "B::perlstring($expect) (Unicode)"); + } +} is(B::class(bless {}, "Wibble::Bibble"), "Bibble", "Testing B::class()"); is(B::cast_I32(3.14), 3, "Testing B::cast_I32()"); is(B::opnumber("chop"), 38, "Testing opnumber with opname (chop)"); @@ -180,3 +203,5 @@ is(B::opnumber("chop"), 38, "Testing opnumber with opname (chop)"); } ok( $ag < B::amagic_generation, "amagic_generation increments" ); } + +done_testing(); -- Perl5 Master Repository
