From: Jarkko Hietaniemi Date: Sat, 11 Aug 2001 17:55:36 +0000 (+0000) Subject: Add t/op/lc.t to see if lc, uc, lcfirst, ucfirst, quotemeta work. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b0f2b690b4ba59b02c372a35658748cb0f31c38e;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 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 --- 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 --- 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 ;