From d06445298904613950b0410a2f3b1125ab58c7b5 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sat, 12 Jan 2008 21:57:06 +0000 Subject: Fix bug whereby length on a tied scalar that returned a UTF-8 value would not be correct the first time. (And for the more pathological case, would be incorrect if the UTF-8-ness of the returned value changed.) p4raw-id: //depot/perl@32968 --- t/uni/tie.t | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 t/uni/tie.t (limited to 't/uni') diff --git a/t/uni/tie.t b/t/uni/tie.t new file mode 100644 index 0000000000..fa9f268bbf --- /dev/null +++ b/t/uni/tie.t @@ -0,0 +1,49 @@ +#!perl -w + +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More tests => 9; +use strict; + +{ + package UTF8Toggle; + + sub TIESCALAR { + my $class = shift; + my $value = shift; + my $state = shift||0; + return bless [$value, $state], $class; + } + + sub FETCH { + my $self = shift; + $self->[1] = ! $self->[1]; + if ($self->[1]) { + utf8::downgrade($self->[0]); + } else { + utf8::upgrade($self->[0]); + } + $self->[0]; + } +} + +foreach my $t ("ASCII", "B\366se") { + my $length = length $t; + + my $u; + tie $u, 'UTF8Toggle', $t; + is (length $u, $length, "length of '$t'"); + is (length $u, $length, "length of '$t'"); + is (length $u, $length, "length of '$t'"); + is (length $u, $length, "length of '$t'"); +} + +{ + local $TODO = "Need more tests!"; + fail(); +} -- cgit v1.2.1