xref: /openbsd/gnu/usr.bin/perl/t/uni/tie.t (revision cecf84d4)
1#!perl -w
2
3BEGIN {
4    require './test.pl';
5}
6
7plan (tests => 10);
8use strict;
9
10{
11    package UTF8Toggle;
12
13    sub TIESCALAR {
14	my $class = shift;
15	my $value = shift;
16	my $state = shift||0;
17	return bless [$value, $state], $class;
18    }
19
20    sub FETCH {
21	my $self = shift;
22	$self->[1] = ! $self->[1];
23	if ($self->[1]) {
24	    utf8::downgrade($self->[0]);
25	} else {
26	    utf8::upgrade($self->[0]);
27	}
28	$self->[0];
29    }
30}
31
32foreach my $t ("ASCII", "B\366se") {
33    my $length = length $t;
34
35    my $u;
36    tie $u, 'UTF8Toggle',  $t;
37    is (length $u, $length, "length of '$t'");
38    is (length $u, $length, "length of '$t'");
39    is (length $u, $length, "length of '$t'");
40    is (length $u, $length, "length of '$t'");
41}
42
43{
44    use utf8;
45    use open qw( :utf8 :std );
46    package Tìè::UTF8 {
47        sub TIESCALAR {
48            return bless {}, shift;
49        }
50    }
51
52    my $t;
53    tie $t, 'Tìè::UTF8';
54    is ref(tied($t)), 'Tìè::UTF8', "Tie'ing to a UTF8 package works.";
55}
56{
57    local $::TODO = "Need more tests!";
58    fail();
59}
60