BEGIN {
chdir 't' if -d 't';
- @INC = qw(. ../lib); # ../lib needed for test.deparse
- require "test.pl";
+ require "./test.pl";
+ set_up_inc(qw(. ../lib)); # ../lib needed for test.deparse
}
-plan tests => 34;
+plan tests => 45;
# Note that t/op/ord.t already tests for chr() <-> ord() rountripping.
is(chr(-3.0), "\xFD");
}
+# Make sure -1 is treated the same way when coming from a tied variable
+sub TIESCALAR {bless[]}
+sub STORE { $_[0][0] = $_[1] }
+sub FETCH { $_[0][0] }
+tie $t, "";
+$t = -1; is chr $t, chr -1, 'chr $tied when $tied is -1';
+$t = -2; is chr $t, chr -2, 'chr $tied when $tied is -2';
+$t = -1.1; is chr $t, chr -1.1, 'chr $tied when $tied is -1.1';
+$t = -2.2; is chr $t, chr -2.2, 'chr $tied when $tied is -2.2';
+
+# And that stringy scalars are treated likewise
+is chr "-1", chr -1, 'chr "-1" eq chr -1';
+is chr "-2", chr -2, 'chr "-2" eq chr -2';
+is chr "-1.1", chr -1.1, 'chr "-1.1" eq chr -1.1';
+is chr "-2.2", chr -2.2, 'chr "-2.2" eq chr -2.2';
+
# Check UTF-8 (not UTF-EBCDIC).
SKIP: {
- skip "no UTF-8 on EBCDIC", 21 if chr(193) eq 'A';
+ skip "UTF-8 ASCII centric tests", 21 if $::IS_EBCDIC;
+ # Too hard to convert these tests generically to EBCDIC code pages without
+ # using chr(), which is what we're testing.
sub hexes {
no warnings 'utf8'; # avoid surrogate and beyond Unicode warnings
- join(" ",map{sprintf"%02x",$_}unpack("C*",chr($_[0])));
+ join(" ",unpack "U0 (H2)*", chr $_[0]);
}
# The following code points are some interesting steps in UTF-8.
is(hexes(0x1FFFFF), "f7 bf bf bf"); # last four byte encoding
is(hexes(0x200000), "f8 88 80 80 80");
}
+
+package o {
+ use overload
+ '""' => sub { ++$o::str; "42" },
+ '0+' => sub { ++$o::num; 42 };
+}
+is chr(bless [], "o"), chr(42), 'overloading called';
+is $o::str, undef, 'chr does not call string overloading';
+is $o::num, 1, 'chr does call num overloading';