This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add perldelta entry try/catch deparsing fix - 846e32ebef
[perl5.git] / t / uni / tie.t
1 #!perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6 }
7
8 plan (tests => 10);
9 use strict;
10
11 {
12     package UTF8Toggle;
13
14     sub TIESCALAR {
15         my $class = shift;
16         my $value = shift;
17         my $state = shift||0;
18         return bless [$value, $state], $class;
19     }
20
21     sub FETCH {
22         my $self = shift;
23         $self->[1] = ! $self->[1];
24         if ($self->[1]) {
25             utf8::downgrade($self->[0]);
26         } else {
27             utf8::upgrade($self->[0]);
28         }
29         $self->[0];
30     }
31 }
32
33 foreach my $t ("ASCII", "B\366se") {
34     my $length = length $t;
35
36     my $u;
37     tie $u, 'UTF8Toggle',  $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     is (length $u, $length, "length of '$t'");
42 }
43
44 {
45     use utf8;
46     use open qw( :utf8 :std );
47     package Tìè::UTF8 {
48         sub TIESCALAR {
49             return bless {}, shift;
50         }
51     }
52     
53     my $t;
54     tie $t, 'Tìè::UTF8';
55     is ref(tied($t)), 'Tìè::UTF8', "Tie'ing to a UTF8 package works.";
56 }
57 {
58     local $::TODO = "Need more tests!";
59     fail();
60 }