Add t/op/lc.t to see if lc, uc, lcfirst, ucfirst, quotemeta work.

Smoked out bugs (well, the same bug twice) from ucfirst and lcfirst
in Unicode handling.

p4raw-id: //depot/perl@11637

diff --git a/MANIFEST b/MANIFEST
index f056363..991999b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2022,6 +2022,7 @@ t/op/inc.t                        See if inc/dec of integers near 32 bit limit work
 t/op/index.t                   See if index works
 t/op/int.t                     See if int works
 t/op/join.t                    See if join works
+t/op/lc.t                      See if lc, uc, lcfirst, ucfirst, quotemeta work
 t/op/length.t                  See if length works
 t/op/lex_assign.t              See if ops involving lexicals or pad temps work
 t/op/lfs.t                     See if large files work for perlio

diff --git a/pp.c b/pp.c
index a051268..65b1f17 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3015,8 +3015,10 @@ PP(pp_ucfirst)
            SvTAINTED_on(sv);
            uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
        }
-       else
-           uv = toTITLE_utf8(s);
+       else {
+           uv   = toTITLE_utf8(s);
+           ulen = UNISKIP(uv);
+       }
        
        tend = uvchr_to_utf8(tmpbuf, uv);
 
@@ -3074,8 +3076,10 @@ PP(pp_lcfirst)
            SvTAINTED_on(sv);
            uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
        }
-       else
-           uv = toLOWER_utf8(s);
+       else {
+           uv   = toLOWER_utf8(s);
+           ulen = UNISKIP(uv);
+       }
        
        tend = uvchr_to_utf8(tmpbuf, uv);
 

diff --git a/t/op/lc.t b/t/op/lc.t
new file mode 100644 (file)
index 0000000..2db3a8a
--- /dev/null
+++ b/t/op/lc.t
@@ -0,0 +1,59 @@
+#!./perl
+
+print "1..40\n";
+
+$a = "HELLO.* world";
+$b = "hello.* WORLD";
+
+print "ok 1\n"  if "\Q$a\E."      eq "HELLO\\.\\*\\ world.";
+print "ok 2\n"  if "\u$a"         eq "HELLO\.\* world";
+print "ok 3\n"  if "\l$a"         eq "hELLO\.\* world";
+print "ok 4\n"  if "\U$a"         eq "HELLO\.\* WORLD";
+print "ok 5\n"  if "\L$a"         eq "hello\.\* world";
+
+print "ok 6\n"  if quotemeta($a)  eq "HELLO\\.\\*\\ world";
+print "ok 7\n"  if ucfirst($a)    eq "HELLO\.\* world";
+print "ok 8\n"  if lcfirst($a)    eq "hELLO\.\* world";
+print "ok 9\n"  if uc($a)         eq "HELLO\.\* WORLD";
+print "ok 10\n" if lc($a)         eq "hello\.\* world";
+
+print "ok 11\n"  if "\Q$b\E."     eq "hello\\.\\*\\ WORLD.";
+print "ok 12\n"  if "\u$b"        eq "Hello\.\* WORLD";
+print "ok 13\n"  if "\l$b"        eq "hello\.\* WORLD";
+print "ok 14\n"  if "\U$b"        eq "HELLO\.\* WORLD";
+print "ok 15\n"  if "\L$b"        eq "hello\.\* world";
+
+print "ok 16\n"  if quotemeta($b) eq "hello\\.\\*\\ WORLD";
+print "ok 17\n"  if ucfirst($b)   eq "Hello\.\* WORLD";
+print "ok 18\n"  if lcfirst($b)   eq "hello\.\* WORLD";
+print "ok 19\n"  if uc($b)        eq "HELLO\.\* WORLD";
+print "ok 20\n"  if lc($b)        eq "hello\.\* world";
+
+$a = "\x{100}\x{101}\x{41}\x{61}";
+$b = "\x{101}\x{100}\x{61}\x{41}";
+
+print "ok 21\n" if "\Q$a\E."      eq "\x{100}\x{101}\x{41}\x{61}.";
+print "ok 22\n" if "\u$a"         eq "\x{100}\x{101}\x{41}\x{61}";
+print "ok 23\n" if "\l$a"         eq "\x{101}\x{101}\x{41}\x{61}";
+print "ok 24\n" if "\U$a"         eq "\x{100}\x{100}\x{41}\x{41}";
+print "ok 25\n" if "\L$a"         eq "\x{101}\x{101}\x{61}\x{61}";
+
+print "ok 26\n" if quotemeta($a)  eq "\x{100}\x{101}\x{41}\x{61}";
+print "ok 27\n" if ucfirst($a)    eq "\x{100}\x{101}\x{41}\x{61}";
+print "ok 28\n" if lcfirst($a)    eq "\x{101}\x{101}\x{41}\x{61}";
+print "ok 29\n" if uc($a)         eq "\x{100}\x{100}\x{41}\x{41}";
+print "ok 30\n" if lc($a)         eq "\x{101}\x{101}\x{61}\x{61}";
+
+print "ok 31\n" if "\Q$b\E."      eq "\x{101}\x{100}\x{61}\x{41}.";
+print "ok 32\n" if "\u$b"         eq "\x{100}\x{100}\x{61}\x{41}";
+print "ok 33\n" if "\l$b"         eq "\x{101}\x{100}\x{61}\x{41}";
+print "ok 34\n" if "\U$b"         eq "\x{100}\x{100}\x{41}\x{41}";
+print "ok 35\n" if "\L$b"         eq "\x{101}\x{101}\x{61}\x{61}";
+
+print "ok 36\n"  if quotemeta($b) eq "\x{101}\x{100}\x{61}\x{41}";
+print "ok 37\n"  if ucfirst($b)   eq "\x{100}\x{100}\x{61}\x{41}";
+print "ok 38\n"  if lcfirst($b)   eq "\x{101}\x{100}\x{61}\x{41}";
+print "ok 39\n"  if uc($b)        eq "\x{100}\x{100}\x{41}\x{41}";
+print "ok 40\n"  if lc($b)        eq "\x{101}\x{101}\x{61}\x{61}";
+
+

diff --git a/t/op/misc.t b/t/op/misc.t
index 86c8162..3869030 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -532,35 +532,8 @@ print "ok\n";
 EXPECT
 ok
 ########
-my @l = qw(hello.* world);
-my $x;
-
-foreach $x (@l) {
-    print "before - $x\n";
-    $x = "\Q$x\E";
-    print "quotemeta - $x\n";
-    $x = "\u$x";
-    print "ucfirst - $x\n";
-    $x = "\l$x";
-    print "lcfirst - $x\n";
-    $x = "\U$x\E";
-    print "uc - $x\n";
-    $x = "\L$x\E";
-    print "lc - $x\n";
-}
+# moved to op/lc.t
 EXPECT
-before - hello.*
-quotemeta - hello\.\*
-ucfirst - Hello\.\*
-lcfirst - hello\.\*
-uc - HELLO\.\*
-lc - hello\.\*
-before - world
-quotemeta - world
-ucfirst - World
-lcfirst - world
-uc - WORLD
-lc - world
 ########
 sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next }
 my $x = "foo";

diff --git a/t/op/readdir.t b/t/op/readdir.t
index 00199b0..39d4e4c 100755 (executable)
--- a/t/op/readdir.t
+++ b/t/op/readdir.t
@@ -24,7 +24,7 @@ closedir(OP);
 ## This range will have to adjust as the number of tests expands,
 ## as it's counting the number of .t files in src/t
 ##
-if (@D > 90 && @D < 110) { print "ok 2\n"; } else { print "not ok 2\n"; }
+if (@D > 100 && @D < 120) { print "ok 2\n"; } else { print "not ok 2\n"; }
 
 @R = sort @D;
 @G = sort <op/*.t>;