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 (file)
--- 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<dsv>.  Handles 'get' magic, but not 'set' magic.  See C<sv_catsv_mg>.
 */
 
 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<sv_catsv>, 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<sv_catpv_mg>.
 */
 
 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<sv_catpv>, 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 (executable)
--- 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 (executable)
--- 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)
-}
-