From: Jarkko Hietaniemi Date: Sat, 30 Dec 2000 06:19:18 +0000 (+0000) Subject: Undo all the join-related changes since #8248: relevant X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0c981600188aac3b6bf2ea127df9e7da5bd4b1a3;p=p5sagit%2Fp5-mst-13.2.git Undo all the join-related changes since #8248: relevant portions of 8248, 8249, 8250, 8251, 8260, 8263 must go. The new sv_catsv() doesn't fly so it must go back to the drawing board. p4raw-id: //depot/perl@8264 --- diff --git a/sv.c b/sv.c index 208cc10..4794596 100644 --- a/sv.c +++ b/sv.c @@ -2934,7 +2934,7 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv) char *s, *t, *e; int hibit = 0; - if (!sv || !SvPOK(sv) || !SvCUR(sv) || SvUTF8(sv)) + if (!sv || !SvPOK(sv) || SvUTF8(sv)) return; /* This function could be much more efficient if we had a FLAG in SVs @@ -3755,55 +3755,20 @@ C. Handles 'get' magic, but not 'set' magic. See C. */ void -Perl_sv_catsv(pTHX_ SV *dsv, register SV *ssv) +Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) { - if (!ssv) + char *s; + STRLEN len; + if (!sstr) return; - else { - STRLEN slen; - char *spv; - - if ((spv = SvPV(ssv, slen))) { - bool dutf8 = DO_UTF8(dsv); - bool sutf8 = DO_UTF8(ssv); - - if (dutf8 != sutf8) { - STRLEN dlen; - char *dpv; - - /* We may modify dsv but not ssv. */ - - if (!dutf8) - sv_utf8_upgrade(dsv); - dpv = SvPV(dsv, dlen); - SvGROW(dsv, dlen + 2 * slen + 1); - if (dutf8) /* && !sutf8 */ { - char *s = spv; - char *e = s + slen; - char *d = dpv + dlen; - char *dorig = d; - - while (s < e) { - U8 c = *s++; - - if (UTF8_IS_ASCII(c)) - *d++ = c; - else { - *d++ = UTF8_EIGHT_BIT_HI(c); - *d++ = UTF8_EIGHT_BIT_LO(c); - } - } - SvCUR(dsv) += d - dorig; - *d = 0; - } - else /* !dutf8 (was) && sutf8 */ { - sv_catpvn(dsv, spv, slen); - SvUTF8_on(dsv); - } - } - else - sv_catpvn(dsv, spv, slen); + if ((s = SvPV(sstr, len))) { + if (DO_UTF8(sstr)) { + sv_utf8_upgrade(dstr); + sv_catpvn(dstr,s,len); + SvUTF8_on(dstr); } + else + sv_catpvn(dstr,s,len); } } @@ -3816,10 +3781,10 @@ Like C, but also handles 'set' magic. */ void -Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv) +Perl_sv_catsv_mg(pTHX_ SV *dstr, register SV *sstr) { - sv_catsv(dsv,ssv); - SvSETMAGIC(dsv); + sv_catsv(dstr,sstr); + SvSETMAGIC(dstr); } /* @@ -3832,20 +3797,20 @@ Handles 'get' magic, but not 'set' magic. See C. */ void -Perl_sv_catpv(pTHX_ register SV *sv, register const char *pv) +Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr) { register STRLEN len; STRLEN tlen; char *junk; - if (!pv) + if (!ptr) return; junk = SvPV_force(sv, tlen); - len = strlen(pv); + len = strlen(ptr); SvGROW(sv, tlen + len + 1); - if (pv == junk) - pv = SvPVX(sv); - Move(pv,SvPVX(sv)+tlen,len+1,char); + if (ptr == junk) + ptr = SvPVX(sv); + Move(ptr,SvPVX(sv)+tlen,len+1,char); SvCUR(sv) += len; (void)SvPOK_only_UTF8(sv); /* validate pointer */ SvTAINT(sv); @@ -3860,9 +3825,9 @@ Like C, but also handles 'set' magic. */ void -Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *pv) +Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *ptr) { - sv_catpv(sv,pv); + sv_catpv(sv,ptr); SvSETMAGIC(sv); } diff --git a/t/op/join.t b/t/op/join.t index 4cbe692..b50878e 100755 --- a/t/op/join.t +++ b/t/op/join.t @@ -1,6 +1,6 @@ #!./perl -print "1..14\n"; +print "1..10\n"; @x = (1, 2, 3); if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} @@ -44,34 +44,3 @@ if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";} print "# expected 'a17b21c' got '$r'\nnot " if $r ne 'a17b21c'; print "ok 10\n"; }; - -{ my $s = join("", chr(1234),chr(255)); - print "not " unless length($s) == 2 && - ord(substr($s,0,1)) == 1234 && - ord(substr($s,1,1)) == 255; - print "ok 11\n"; -} - -{ my $s = join(chr(2345), chr(1234),chr(255)); - print "not " unless length($s) == 3 && - ord(substr($s,0,1)) == 1234 && - ord(substr($s,1,1)) == 2345 && - ord(substr($s,2,1)) == 255; - print "ok 12\n"; -} - -{ my $s = join(chr(2345), chr(1234),chr(3456)); - print "not " unless length($s) == 3 && - ord(substr($s,0,1)) == 1234 && - ord(substr($s,1,1)) == 2345 && - ord(substr($s,2,1)) == 3456; - print "ok 13\n"; -} - -{ my $s = join(chr(255), chr(1234),chr(2345)); - print "not " unless length($s) == 3 && - ord(substr($s,0,1)) == 1234 && - ord(substr($s,1,1)) == 255 && - ord(substr($s,2,1)) == 2345; - print "ok 14\n"; -} diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t index e55637e..8e4d296 100755 --- a/t/pragma/utf8.t +++ b/t/pragma/utf8.t @@ -10,7 +10,7 @@ BEGIN { } } -print "1..109\n"; +print "1..105\n"; my $test = 1; @@ -554,48 +554,3 @@ sub nok_bytes { print "ok $test\n"; $test++; # 105 } - -{ - use utf8; - my @a = map ord, split(/\x{123}/, - join("", map chr, (1234, 0x123, - 0x123, - 23, 0x123, - 123, 0x123, - 128, 0x123, - 255, 0x123, - 2345))); - ok "@a", "1234 0 23 123 128 255 2345"; - $test++; # 106 -} - -{ - use utf8; - my @a = map ord, split(/(\x{123})/, - join("", map chr, (1234, 0x123, - 0x123, - 23, 0x123, - 123, 0x123, - 128, 0x123, - 255, 0x123, - 2345))); - # 291 is 0x123 - ok "@a", "1234 291 0 291 23 291 123 291 128 291 255 291 2345"; - $test++; # 107 (variant of test 106) -} - -{ - use utf8; - my @a = map ord, split(//, join("", map chr, (1234, 0xff, 2345))); - ok "@a", "1234 255 2345"; - $test++; # 108 (variant of test 66) -} - -{ - use utf8; - my $x = chr(0xff); - my @a = map ord, split(/$x/, join("", map chr, (1234, 0xff, 2345))); - ok "@a", "1234 2345"; - $test++; # 109 (variant of test 67) -} -