From: Jarkko Hietaniemi Date: Wed, 3 Sep 2003 08:22:48 +0000 (+0000) Subject: Add, document, and test bytes::substr, index, rindex, chr, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=579f6b362c1dba5aba4049a91c9b6ef08e1b2c6d;p=p5sagit%2Fp5-mst-13.2.git Add, document, and test bytes::substr, index, rindex, chr, document bytes::ord. p4raw-id: //depot/perl@21016 --- diff --git a/lib/bytes.pm b/lib/bytes.pm index cd82abc..775b2cd 100644 --- a/lib/bytes.pm +++ b/lib/bytes.pm @@ -18,6 +18,11 @@ sub AUTOLOAD { } sub length ($); +sub chr ($); +sub ord ($); +sub substr ($$;$$); +sub index ($$;$); +sub rindex ($$;$); 1; __END__ @@ -29,8 +34,15 @@ bytes - Perl pragma to force byte semantics rather than character semantics =head1 SYNOPSIS use bytes; + ... chr(...); # or bytes::chr + ... index(...); # or bytes::index + ... length(...); # or bytes::length + ... ord(...); # or bytes::ord + ... rindex(...); # or bytes::rindex + ... substr(...); # or bytes::substr no bytes; + =head1 DESCRIPTION The C pragma disables character semantics for the rest of the @@ -53,16 +65,22 @@ up the UTF8 encoding - and C returns C<2>: print "Length is ", length $x, "\n"; # "Length is 1" printf "Contents are %vd\n", $x; # "Contents are 400" { - use bytes; + use bytes; # or "require bytes; bytes::length()" print "Length is ", length $x, "\n"; # "Length is 2" printf "Contents are %vd\n", $x; # "Contents are 198.144" } +chr(), ord(), substr(), index() and rindex() behave similarly. + For more on the implications and differences between character -semantics and byte semantics, see L. +semantics and byte semantics, see L and L. + +=head1 LIMITATIONS + +bytes::substr() does not work as an lvalue(). =head1 SEE ALSO -L, L +L, L, L =cut diff --git a/lib/bytes.t b/lib/bytes.t index 28043ca..6b66a55 100644 --- a/lib/bytes.t +++ b/lib/bytes.t @@ -4,20 +4,26 @@ BEGIN { require './test.pl'; } -plan tests => 9; +plan tests => 19; my $a = chr(0x100); is(ord($a), 0x100, "ord sanity check"); is(length($a), 1, "length sanity check"); +is(substr($a, 0, 1), "\x{100}", "substr sanity check"); +is(index($a, "\x{100}"), 0, "index sanity check"); +is(rindex($a, "\x{100}"), 0, "rindex sanity check"); is(bytes::length($a), 2, "bytes::length sanity check"); +is(bytes::chr(0x100), chr(0), "bytes::chr sanity check"); { use bytes; my $b = chr(0x100); # affected by 'use bytes' is(ord($b), 0, "chr truncates under use bytes"); is(length($b), 1, "length truncated under use bytes"); + is(bytes::ord($b), 0, "bytes::ord truncated under use bytes"); is(bytes::length($b), 1, "bytes::length truncated under use bytes"); + is(bytes::substr($b, 0, 1), "\0", "bytes::substr truncated under use bytes"); } my $c = chr(0x100); @@ -31,4 +37,12 @@ my $c = chr(0x100); } is(length($c), 2, "length under use bytes looks at bytes"); is(bytes::length($c), 2, "bytes::length under use bytes looks at bytes"); + if (ord('A') == 193) { # EBCDIC? + is(bytes::ord($c), 0x8c, "bytes::ord under use bytes looks at the 1st byte"); + } else { + is(bytes::ord($c), 0xc4, "bytes::ord under use bytes looks at the 1st byte"); + } + is(bytes::substr($c, 0, 1), "\xc4", "bytes::substr under use bytes looks at bytes"); + is(bytes::index($c, "\x80"), 1, "bytes::index under use bytes looks at bytes"); + is(bytes::rindex($c, "\xc4"), 0, "bytes::rindex under use bytes looks at bytes"); } diff --git a/lib/bytes_heavy.pl b/lib/bytes_heavy.pl index 47bdbf9..923381d 100644 --- a/lib/bytes_heavy.pl +++ b/lib/bytes_heavy.pl @@ -5,4 +5,36 @@ sub length ($) { return CORE::length($_[0]); } +sub substr ($$;$$) { + BEGIN { bytes::import() } + return + @_ == 2 ? CORE::substr($_[0], $_[1]) : + @_ == 3 ? CORE::substr($_[0], $_[1], $_[2]) : + CORE::substr($_[0], $_[1], $_[2], $_[3]) ; +} + +sub ord ($) { + BEGIN { bytes::import() } + return CORE::ord($_[0]); +} + +sub chr ($) { + BEGIN { bytes::import() } + return CORE::chr($_[0]); +} + +sub index ($$;$) { + BEGIN { bytes::import() } + return + @_ == 2 ? CORE::index($_[0], $_[1]) : + CORE::index($_[0], $_[1], $_[2]) ; +} + +sub rindex ($$;$) { + BEGIN { bytes::import() } + return + @_ == 2 ? CORE::rindex($_[0], $_[1]) : + CORE::rindex($_[0], $_[1], $_[2]) ; +} + 1;